File Coverage

blib/lib/Math/GrahamFunction/SqFacts.pm
Criterion Covered Total %
statement 78 80 97.5
branch 14 16 87.5
condition 7 7 100.0
subroutine 18 18 100.0
pod 8 8 100.0
total 125 129 96.9


line stmt bran cond sub pod time code
1             package Math::GrahamFunction::SqFacts;
2             $Math::GrahamFunction::SqFacts::VERSION = '0.02004';
3 1     1   7 use strict;
  1         2  
  1         31  
4 1     1   39 use warnings;
  1         5  
  1         39  
5              
6              
7 1     1   6 use parent qw(Math::GrahamFunction::Object);
  1         3  
  1         5  
8              
9 1     1   55 use List::Util ();
  1         12  
  1         751  
10             __PACKAGE__->mk_accessors(qw(n factors));
11              
12             sub _initialize
13             {
14 1771     1771   2743 my $self = shift;
15 1771         2562 my $args = shift;
16              
17 1771 100       3577 if ( $args->{n} )
    50          
18             {
19 844         2243 $self->n( $args->{n} );
20              
21 844         8324 $self->_calc_sq_factors();
22             }
23             elsif ( $args->{factors} )
24             {
25 927         1931 $self->factors( $args->{factors} );
26             }
27             else
28             {
29 0         0 die "factors or n must be supplied.";
30             }
31              
32 1771         10758 return 0;
33             }
34              
35              
36             sub clone
37             {
38 182     182 1 920 my $self = shift;
39 182         292 return __PACKAGE__->new( { 'factors' => [ @{ $self->factors() } ] } );
  182         319  
40             }
41              
42             sub _calc_sq_factors
43             {
44 844     844   1223 my $self = shift;
45              
46 844         1650 $self->factors( $self->_get_sq_facts( $self->n() ) );
47              
48 844         7812 return 0;
49             }
50              
51             my %gsf_cache = ( 1 => [] );
52              
53             sub _get_sq_facts
54             {
55 973     973   7661 my $self = shift;
56 973         1389 my $n = shift;
57              
58 973 100       2611 if ( exists( $gsf_cache{$n} ) )
59             {
60 844         2433 return $gsf_cache{$n};
61             }
62              
63 129   100     444 my $start_from = shift || 2;
64              
65 129         259 for ( my $p = $start_from ; ; ++$p )
66             {
67 1720 100       3108 if ( $n % $p == 0 )
68             {
69             # This function is recursive to make better use of the Memoization
70             # feature.
71 129         392 my $division_factors = $self->_get_sq_facts( ( $n / $p ), $p );
72 129 100 100     507 if ( @$division_factors && ( $division_factors->[0] == $p ) )
73             {
74             return ( $gsf_cache{$n} =
75 29         99 [ @{$division_factors}[ 1 .. $#$division_factors ] ] );
  29         186  
76             }
77             else
78             {
79 100         582 return ( $gsf_cache{$n} = [ $p, @$division_factors ] );
80             }
81             }
82             }
83             }
84              
85             # Removed because it is too slow - we now use our own custom memoization (
86             # or perhaps it is just called caching)
87             # memoize('get_squaring_factors', 'NORMALIZER' => sub { return $_[0]; });
88              
89             # This function multiplies the squaring factors of $n and $m to receive
90             # the squaring factors of ($n*$m)
91              
92             # OOP-Wise, it should be a multi-method, but since we don't inherit this
93             # object it's all-right.
94              
95              
96             sub mult_by
97             {
98 2042     2042 1 30306 my $n_ref = shift;
99 2042         2849 my $m_ref = shift;
100              
101 2042         2862 my @n = @{ $n_ref->factors() };
  2042         3478  
102 2042         18436 my @m = eval { @{ $m_ref->factors() }; };
  2042         2875  
  2042         3666  
103 2042 50       19687 if ($@)
104             {
105 0         0 print "Hello\n";
106             }
107              
108 2042         3028 my @ret = ();
109              
110 2042   100     6338 while ( scalar(@n) && scalar(@m) )
111             {
112 4255 100       8336 if ( $n[0] == $m[0] )
    100          
113             {
114 1836         2412 shift(@n);
115 1836         4313 shift(@m);
116             }
117             elsif ( $n[0] < $m[0] )
118             {
119 1315         3924 push @ret, shift(@n);
120             }
121             else
122             {
123 1104         3494 push @ret, shift(@m);
124             }
125             }
126 2042         3570 push @ret, @n, @m;
127              
128 2042         5202 $n_ref->factors( \@ret );
129              
130             # 0 for success
131 2042         21612 return 0;
132             }
133              
134              
135             sub mult
136             {
137 90     90 1 1462 my $n = shift;
138 90         137 my $m = shift;
139              
140 90         164 my $result = $n->clone();
141 90         279 $result->mult_by($m);
142 90         188 return $result;
143             }
144              
145              
146             sub is_square
147             {
148 1364     1364 1 12093 my $self = shift;
149 1364         1905 return ( scalar( @{ $self->factors() } ) == 0 );
  1364         2657  
150             }
151              
152              
153             sub exists
154             {
155 1949     1949 1 16985 my ( $self, $factor ) = @_;
156              
157 1949     2940   5343 return defined( List::Util::first { $_ == $factor } @{ $self->factors() } );
  2940         24940  
  1949         3842  
158             }
159              
160              
161             sub last
162             {
163 90     90 1 800 my $self = shift;
164              
165 90         202 return $self->factors()->[-1];
166             }
167              
168 1     1   9 use vars qw($a $b);
  1         10  
  1         170  
169              
170              
171             sub product
172             {
173 90     90 1 159 my $self = shift;
174              
175 90     43   266 return ( List::Util::reduce { $a * $b } @{ $self->factors() } );
  43         476  
  90         213  
176             }
177              
178              
179             sub first
180             {
181 600     600 1 5295 my $self = shift;
182              
183 600         1152 return $self->factors()->[0];
184             }
185              
186              
187             1;
188              
189             __END__