package Math::GrahamFunction::SqFacts; use strict; use warnings; =head1 NAME Math::GrahamFunction::SqFacts - a squaring factors vector. =head1 WARNING! This is a module for Math::GrahamFunction's internal use only. =cut use base qw(Math::GrahamFunction::Object); use List::Util (); __PACKAGE__->mk_accessors(qw(n factors)); sub _initialize { my $self = shift; my $args = shift; if ($args->{n}) { $self->n($args->{n}); $self->_calc_sq_factors(); } elsif ($args->{factors}) { $self->factors($args->{factors}); } else { die "factors or n must be supplied."; } return 0; } =head1 CONSTRUCTION =head2 Math::GrahamFunction::SqFacts->new({n => $n}) Initializes a squaring factors object from a number. =head2 Math::GrahamFunction::SqFacts->new({factors => \@factors}) Initializes a squaring factors object from a list of factors. =head1 METHODS =head2 $facts->clone() Creates a clone of the object and returns it. =cut sub clone { my $self = shift; return __PACKAGE__->new({'factors' => [@{$self->factors()}]}); } sub _calc_sq_factors { my $self = shift; $self->factors($self->_get_sq_facts($self->n())); return 0; } my %gsf_cache = (1 => []); sub _get_sq_facts { my $self = shift; my $n = shift; if (exists($gsf_cache{$n})) { return $gsf_cache{$n}; } my $start_from = shift || 2; for(my $p=$start_from; ;$p++) { if ($n % $p == 0) { # This function is recursive to make better use of the Memoization # feature. my $division_factors = $self->_get_sq_facts(($n / $p), $p); if (@$division_factors && ($division_factors->[0] == $p)) { return ($gsf_cache{$n} = [ @{$division_factors}[1 .. $#$division_factors] ]); } else { return ($gsf_cache{$n} = [ $p, @$division_factors ]); } } } } # Removed because it is too slow - we now use our own custom memoization ( # or perhaps it is just called caching) # memoize('get_squaring_factors', 'NORMALIZER' => sub { return $_[0]; }); # This function multiplies the squaring factors of $n and $m to receive # the squaring factors of ($n*$m) # OOP-Wise, it should be a multi-method, but since we don't inherit this # object it's all-right. =head2 $n_facts->mult_by($m_facts) Calculates the results of the multiplication of the number represented by C<$n_facts> and C<$m_facts> and stores it in $n_facts (destructively). This is actually addition in vector space. =cut sub mult_by { my $n_ref = shift; my $m_ref = shift; my @n = @{$n_ref->factors()}; my @m = eval { @{$m_ref->factors()}; }; if ($@) { print "Hello\n"; } my @ret = (); while (scalar(@n) && scalar(@m)) { if ($n[0] == $m[0]) { shift(@n); shift(@m); } elsif ($n[0] < $m[0]) { push @ret, shift(@n); } else { push @ret, shift(@m); } } push @ret, @n, @m; $n_ref->factors(\@ret); # 0 for success return 0; } =head2 my $result = $n->mult($m); Non destructively calculates the multiplication and returns it. =cut sub mult { my $n = shift; my $m = shift; my $result = $n->clone(); $result->mult_by($m); return $result; } =head2 $facts->is_square() A predicate that returns whether the factors represent a square number. =cut sub is_square { my $self = shift; return (scalar(@{$self->factors()}) == 0); } =head2 $facts->exists($myfactor) Checks whether C<$myfactor> exists in C<$facts>. =cut sub exists { my ($self, $factor) = @_; return defined(List::Util::first { $_ == $factor } @{$self->factors()}); } =head2 my $last_factor = $factors->last() Returns the last (and greatest factor). =cut sub last { my $self = shift; return $self->factors()->[-1]; } use vars qw($a $b); =head2 $facts->product() Returns the product of the factors. =cut sub product { my $self = shift; return (List::Util::reduce { $a * $b } @{$self->factors()}); } =head2 $facts->first() Returns the first (and smallest) factor. =cut sub first { my $self = shift; return $self->factors()->[0]; } =head1 AUTHOR Shlomi Fish, C<< >> =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2007 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. B the module meta-data says this module is released under the BSD license. However, MIT X11 is the more accurate license, and "bsd" is the closest option for the CPAN meta-data. =cut 1;