Commits

Anonymous committed 43e6d1a

Added the functionality and the rest of the missing modules. At the
moment, some of the tests still fail.

  • Participants
  • Parent commits 1cc21fa

Comments (0)

Files changed (6)

modules/Math-GrahamFunction/MANIFEST

 Build.PL
 Changes
+lib/Math/GrahamFunction/Object.pm
+lib/Math/GrahamFunction.pm
+lib/Math/GrahamFunction/SqFacts/Dipole.pm
+lib/Math/GrahamFunction/SqFacts.pm
 MANIFEST
 META.yml # Will be created by "make dist"
 README
-lib/Math/GrahamFunction.pm
 t/00-load.t
+t/01-results.t
 t/boilerplate.t
 t/pod-coverage.t
 t/pod.t

modules/Math-GrahamFunction/lib/Math/GrahamFunction.pm

 
 =head1 NAME
 
-Math::GrahamFunction - The great new Math::GrahamFunction!
+Math::GrahamFunction - Calculate the Graham's Function of a Natural 
+Number.
 
 =head1 VERSION
 
 
 our $VERSION = '0.01';
 
+use base qw(Math::GrahamFunction::Object);
+
+use Math::GrahamFunction::SqFacts;
+use Math::GrahamFunction::SqFacts::Dipole;
+
+__PACKAGE__->mk_accessors(qw(
+    _base
+    n
+    _n_vec
+    next_id
+    _n_sq_factors
+    primes_to_ids_map
+    ));
+
+sub _initialize
+{
+    my $self = shift;
+    my $args = shift;
+
+    $self->n($args->{n}) or
+        die "n was not specified";
+
+    $self->primes_to_ids_map({});
+
+    return 0;
+}
+
 =head1 SYNOPSIS
 
 Quick summary of what the module does.
 
     use Math::GrahamFunction;
 
-    my $foo = Math::GrahamFunction->new();
-    ...
+    my $calc = Math::GrahamFunction->new({ 'n' => 500 });
 
-=head1 EXPORT
+    my $results = $calc->solve();
 
-A list of functions that can be exported.  You can delete this section
-if you don't export anything, such as for a purely object-oriented module.
+    print "The Graham Function of 500 is ", 
+        $results->{'factors'}->[-1],
+        "\n";
+
+=cut
 
 =head1 FUNCTIONS
 
-=head2 function1
+=head2 my $calc = Math::GrahamFunction->new({'n' => $n});
+
+Initialises a new object for solving the Graham's Function of the 
+number C<$n>. Call solve() next.
+
+=head2 my $results = $calc->solve();
+
+Calculates the Graham's Function series for the number (could be
+time consuming), and returns a hash ref of results. The only field
+of interest there is C<'factors'>, which points to an array reference
+of the series. The series is increasing so 
+C<$results->{factors}->[0]> is C<$n> and 
+C<$results->{factors}->[-1]} is the Graham's Function.
+
+=head2 $self->_get_num_facts($number)
+
+Get the Square factors of the number $number.
 
 =cut
 
-sub function1 {
+sub _get_num_facts
+{
+    my ($self, $number) = @_;
+
+    return Math::GrahamFunction::SqFacts->new({ 'n' => $number });
 }
 
-=head2 function2
+sub _get_facts
+{
+    my ($self, $factors) = @_;
+
+    return
+        Math::GrahamFunction::SqFacts->new(
+            { 'factors' =>
+                (ref($factors) eq "ARRAY" ? $factors : [$factors])
+            }
+        );
+}
+
+sub _get_num_dipole
+{
+    my ($self, $number) = @_;
+
+    return Math::GrahamFunction::SqFacts::Dipole->new(
+        {
+            'result' => $self->_get_num_facts($number),
+            'compose' => $self->_get_facts($number),
+        }
+    );
+ 
+}
+
+sub _calc_n_sq_factors
+{
+    my $self = shift;
+
+    $self->_n_sq_factors(
+        $self->_get_num_dipole($self->n)
+    );
+}
+
+sub _check_largest_factor_in_between
+{
+    my $self = shift;
+
+    my $n = $self->n();
+    # Cheating: 
+    # Check if between n and n+largest_factor we can fit
+    # a square of SqFact{n*(n+largest_factor)}. If so, return
+    # n+largest_factor.
+    #
+    # So, for instance, if n = p than n+largest_factor = 2p
+    # and so SqFact{p*(2p)} = 2 and it is possible to see if
+    # there's a 2*i^2 between p and 2p. That way, p*2*i^2*2p is
+    # a square number.
+
+    my $largest_factor = $self->_n_sq_factors()->last();
+
+    my ($lower_bound, $lb_sq_factors);
+    
+    $lower_bound = $self->n() + $largest_factor;
+    while (1)
+    {
+        $lb_sq_factors = $self->_get_num_facts($lower_bound);
+        if ($lb_sq_factors->exists($largest_factor))
+        {
+            last;
+        }
+        $lower_bound += $largest_factor;
+    }
+
+    my $n_times_lb = $self->_n_sq_factors->result->mult($lb_sq_factors);
+
+    my $rest_of_factors_product = $n_times_lb->product();
+
+    my $low_square_val = int(sqrt($n/$rest_of_factors_product));
+    my $high_square_val = int(sqrt($lower_bound/$rest_of_factors_product));
+    
+    if ($low_square_val != $high_square_val)
+    {
+        my @factors =
+        (
+            $n,
+            ($low_square_val+1)*($low_square_val+1)*$rest_of_factors_product,
+            $lower_bound
+        );
+        # TODO - possibly convert to Dipole
+        # return ($lower_bound, $self->_get_facts(\@factors));
+        return \@factors;
+    }
+    else
+    {
+        return;
+    }
+}
+
+sub _get_next_id
+{
+    my $self = shift;
+    return $self->next_id($self->next_id()+1);
+}
+
+sub _get_prime_id
+{
+    my $self = shift;
+    my $p = shift;
+    return $self->primes_to_ids_map()->{$p};
+}
+
+sub _register_prime
+{
+    my ($self, $p) = @_;
+    $self->primes_to_ids_map()->{$p} = $self->_get_next_id();
+}
+
+sub _prime_exists
+{
+    my ($self, $p) = @_;
+    return exists($self->primes_to_ids_map->{$p});
+}
+
+sub _get_min_id
+{
+    my ($self, $vec) = @_;
+
+    my $min_id = -1;
+    my $min_p = 0;
+
+    foreach my $p (@{$vec->result()->factors()})
+    {
+        my $id = $self->_get_prime_id($p);
+        if (($min_id < 0) || ($min_id > $id))
+        {
+            $min_id = $id;
+            $min_p = $p;
+        }
+    }
+
+    return ($min_id, $min_p);
+}
+
+sub _try_to_form_n
+{
+    my $self = shift;
+
+    while (! $self->_n_vec->is_square())
+    {
+        # Calculating $id as the minimal ID of the squaring factors of $p
+        my ($id, undef) = $self->_get_min_id($self->_n_vec);
+
+        # Multiply by the controlling vector of this ID if it exists
+        # or terminate if it doesn't.
+        return 0 if (!defined($self->_base->[$id]));
+        $self->_n_vec->mult_by($self->_base->[$id]);
+    }
+
+    return 1;
+}
+
+sub _get_final_factors
+{
+    my $self = shift;
+
+    $self->_calc_n_sq_factors();
+
+    # The graham number of a perfect square is itself.
+    if ($self->_n_sq_factors->is_square())
+    {
+        return $self->_n_sq_factors->_get_ret();
+    }
+    elsif (defined(my $ret = $self->_check_largest_factor_in_between()))
+    {
+        return $ret;
+    }
+    else
+    {
+        return $self->_main_solve();
+    }
+}
+
+sub solve
+{
+    my $self = shift;
+
+    return { factors => $self->_get_final_factors() };
+}
+
+sub _main_init
+{
+    my $self = shift;
+
+    $self->next_id(0);
+
+    $self->_base([]);
+
+    # Register all the primes in the squaring factors of $n
+    foreach my $p (@{$self->_n_sq_factors->factors()})
+    {
+        $self->_register_prime($p);
+    }
+
+    # $self->_n_vec is used to determine if $n can be composed out of the 
+    # base's vectors.
+    $self->_n_vec($self->_n_sq_factors->clone());
+
+    return;
+}
+
+=begin none
+
+# A method to print the base. It is not used but can prove useful for
+# debugging.
+sub _print_base 
+{
+    my $self = shift;
+    print "Base=\n\n";
+    for(my $j = 0 ; $j < scalar( @{$self->_base()} ) ; $j++)
+    {
+        next if (! defined($self->_base->[$j]));
+        print "base[$j] (" . join(" * ", @{$self->_base->[$j]}) . ")\n";
+    }
+    print "\n\n";
+};
+
+=end none
 
 =cut
 
-sub function2 {
+sub _update_base
+{
+    my ($self, $final_vec) = @_;
+
+    # Get the minimal ID and its corresponding prime number
+    # in $final_vec.
+    my ($min_id, $min_p) = $self->_get_min_id($final_vec);
+
+    if ($min_id >= 0)
+    {
+        # Assign $final_vec as the controlling vector for this prime
+        # number
+        $self->_base->[$min_id] = $final_vec;
+        # Canonicalize the rest of the vectors with the new vector.
+        CANON_LOOP:
+        for(my $j=0;$j<scalar(@{$self->_base()});$j++)
+        {
+            if (($j == $min_id) || (! defined($self->_base->[$j])))
+            {
+                next CANON_LOOP;
+            }
+            if ($self->_base->[$j]->exists($min_p))
+            {
+                $self->_base->[$j]->mult_by($final_vec);
+            }
+        }
+    }
+}
+
+sub _get_final_composition
+{
+    my ($self, $i_vec) = @_;
+
+    # $final_vec is the new vector to add after it was
+    # stair-shaped by all the controlling vectors in the base.
+
+    my $final_vec = $i_vec;
+
+    foreach my $p (@{$i_vec->factors()})
+    {
+        if (!$self->_prime_exists($p))
+        {
+            $self->_register_prime($p);
+        }
+        else
+        {
+            my $id = $self->_get_prime_id($p);
+            if (defined($self->_base->[$id]))
+            {
+                $final_vec->mult_by($self->_base->[$id]);
+            }
+        }
+    }
+
+    return $final_vec;
+}
+
+sub _get_i_vec
+{
+    my ($self, $i) = @_;
+
+    my $i_vec = $self->_get_num_dipole($i);
+    # Skip perfect squares - they do not add to the solution
+    if ($i_vec->is_square())
+    {
+        return;
+    }
+
+    # Check if $i is a prime number
+    # We need n > 2 because for n == 2 it does include a prime number.
+    #
+    # Prime numbers cannot be included because 2*n is an upper bound
+    # to G(n) and so if there is a prime p > n than its next multiple
+    # will be greater than G(n).
+    if (($self->n() > 2) && ($i_vec->first() == $i))
+    {
+        return;
+    }
+
+    return $i_vec;
+}
+
+sub _solve_iteration
+{
+    my ($self, $i) = @_;
+
+    my $i_vec = $self->_get_i_vec($i)
+        or return;
+
+    my $final_vec = $self->_get_final_composition($i_vec);
+
+    $self->_update_base($final_vec);
+
+    # Check if we can form $n
+    if ($self->_try_to_form_n())
+    {
+        return $self->_n_vec->_get_ret();
+    }
+    else
+    {
+        return;
+    }
+}
+
+sub _main_solve
+{
+    my $self = shift;
+
+    $self->_main_init();
+
+    for(my $i=$self->n()+1;;$i++)
+    {
+        if (defined(my $ret = $self->_solve_iteration($i)))
+        {
+            return $ret;
+        }
+    }
 }
 
 =head1 AUTHOR
 
 Copyright 2007 Shlomi Fish, all rights reserved.
 
-This program is released under the following license: bsd
+This program is released under the following license: MIT X11.
+
+Note: 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
 

modules/Math-GrahamFunction/lib/Math/GrahamFunction/Object.pm

+package Math::GrahamFunction::Object;
+
+use strict;
+use warnings;
+
+use base qw(Class::Accessor);
+
+sub new
+{
+    my $class = shift;
+    my $self = {};
+    bless $self, $class;
+    $self->_initialize(@_);
+    return $self;
+}
+
+1;
+

modules/Math-GrahamFunction/lib/Math/GrahamFunction/SqFacts.pm

+package Math::GrahamFunction::SqFacts;
+
+use strict;
+use warnings;
+
+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;
+}
+
+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.
+
+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;
+}
+
+sub mult
+{
+    my $n = shift;
+    my $m = shift;
+    
+    my $result = $n->clone();
+    $result->mult_by($m);
+    return $result;
+}
+
+sub is_square
+{
+    my $self = shift;
+    return (scalar(@{$self->factors()}) == 0);
+}
+
+sub exists
+{
+    my ($self, $factor) = @_;
+    
+    return defined(List::Util::first { $_ == $factor } @{$self->factors()});
+}
+
+sub last
+{
+    my $self = shift;
+
+    return $self->factors()->[-1];
+}
+
+use vars qw($a $b);
+
+sub product
+{
+    my $self = shift;
+
+    return (List::Util::reduce { $a * $b } @{$self->factors()});
+}
+
+sub first
+{
+    my $self = shift;
+
+    return $self->factors()->[0];    
+}
+
+
+
+1;
+

modules/Math-GrahamFunction/lib/Math/GrahamFunction/SqFacts/Dipole.pm

+package Math::GrahamFunction::SqFacts::Dipole;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Math::GrahamFunction::SqFacts::Dipole - a dipole of two vectors - a result and
+a composition.
+
+=cut
+
+use base qw(Math::GrahamFunction::SqFacts);
+
+use List::Util ();
+__PACKAGE__->mk_accessors(qw(result compose));
+             
+sub _initialize
+{
+    my $self = shift;
+    my $args = shift;
+
+    $self->result($args->{result});
+    $self->compose($args->{compose});
+
+    return 0;
+}
+
+sub clone
+{
+    my $self = shift;
+    return __PACKAGE__->new(
+        {
+            'result' => $self->result()->clone(),
+            'compose' => $self->compose()->clone(),
+        });
+}
+
+sub mult_by
+{
+    my $n_ref = shift;
+    my $m_ref = shift;
+
+    $n_ref->result()->mult_by($m_ref->result());
+    $n_ref->compose()->mult_by($m_ref->compose());
+
+    return 0;
+}
+
+sub is_square
+{
+    my $self = shift;
+    return $self->result()->is_square();
+}
+
+sub exists
+{
+    my ($self, $factor) = @_;
+
+    return $self->result()->exists($factor);
+}
+
+sub first
+{
+    my $self = shift;
+
+    return $self->result()->first();
+}
+
+sub factors
+{
+    my $self = shift;
+
+    return $self->result->factors();
+}
+
+sub _get_ret
+{
+    my $self = shift;
+
+    return [ @{$self->compose->factors()} ];
+}
+
+1;
+

modules/Math-GrahamFunction/t/01-results.t

+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 100;
+
+use Math::GrahamFunction;
+
+my @results_array=
+(
+{ n => 1, factors => [1], },
+{ n => 2, factors => [2,3,6], },
+{ n => 3, factors => [3,6,8], },
+{ n => 4, factors => [4], },
+{ n => 5, factors => [5,8,10], },
+{ n => 6, factors => [6,8,12], },
+{ n => 7, factors => [7,8,14], },
+{ n => 8, factors => [8,10,12,15], },
+{ n => 9, factors => [9], },
+{ n => 10, factors => [10,12,15,18], },
+{ n => 11, factors => [11,18,22], },
+{ n => 12, factors => [12,15,20], },
+{ n => 13, factors => [13,18,26], },
+{ n => 14, factors => [14,15,18,20,21], },
+{ n => 15, factors => [15,18,20,24], },
+{ n => 16, factors => [16], },
+{ n => 17, factors => [17,18,34], },
+{ n => 18, factors => [18,24,27], },
+{ n => 19, factors => [19,32,38], },
+{ n => 20, factors => [20,24,30], },
+{ n => 21, factors => [21,27,28], },
+{ n => 22, factors => [22,24,33], },
+{ n => 23, factors => [23,32,46], },
+{ n => 24, factors => [24,27,32], },
+{ n => 25, factors => [25], },
+{ n => 26, factors => [26,27,32,39], },
+{ n => 27, factors => [27,28,30,32,35], },
+{ n => 28, factors => [28,32,35,40], },
+{ n => 29, factors => [29,32,58], },
+{ n => 30, factors => [30,35,42], },
+{ n => 31, factors => [31,32,62], },
+{ n => 32, factors => [32,40,45], },
+{ n => 33, factors => [33,35,40,42,44], },
+{ n => 34, factors => [34,35,42,45,51], },
+{ n => 35, factors => [35,40,42,48], },
+{ n => 36, factors => [36], },
+{ n => 37, factors => [37,50,74], },
+{ n => 38, factors => [38,54,57], },
+{ n => 39, factors => [39,48,52], },
+{ n => 40, factors => [40,45,50], },
+{ n => 41, factors => [41,50,82], },
+{ n => 42, factors => [42,48,56], },
+{ n => 43, factors => [43,50,86], },
+{ n => 44, factors => [44,45,55], },
+{ n => 45, factors => [45,48,60], },
+{ n => 46, factors => [46,54,69], },
+{ n => 47, factors => [47,50,94], },
+{ n => 48, factors => [48,50,54], },
+{ n => 49, factors => [49], },
+{ n => 50, factors => [50,56,63], },
+{ n => 51, factors => [51,54,56,63,68], },
+{ n => 52, factors => [52,54,56,60,63,65], },
+{ n => 53, factors => [53,72,106], },
+{ n => 54, factors => [54,60,63,70], },
+{ n => 55, factors => [55,56,60,63,66], },
+{ n => 56, factors => [56,63,72], },
+{ n => 57, factors => [57,75,76], },
+{ n => 58, factors => [58,60,63,70,87], },
+{ n => 59, factors => [59,72,118], },
+{ n => 60, factors => [60,63,70,72,75], },
+{ n => 61, factors => [61,72,122], },
+{ n => 62, factors => [62,72,75,93], },
+{ n => 63, factors => [63,66,72,75,77], },
+{ n => 64, factors => [64], },
+{ n => 65, factors => [65,66,70,72,77,78], },
+{ n => 66, factors => [66,70,75,77,80], },
+{ n => 67, factors => [67,72,134], },
+{ n => 68, factors => [68,80,85], },
+{ n => 69, factors => [69,75,92], },
+{ n => 70, factors => [70,72,75,80,84], },
+{ n => 71, factors => [71,72,142], },
+{ n => 72, factors => [72,75,77,84,88], },
+{ n => 73, factors => [73,98,146], },
+{ n => 74, factors => [74,96,111], },
+{ n => 75, factors => [75,77,80,84,88,90], },
+{ n => 76, factors => [76,80,95], },
+{ n => 77, factors => [77,84,88,96], },
+{ n => 78, factors => [78,80,84,90,91], },
+{ n => 79, factors => [79,98,158], },
+{ n => 80, factors => [80,90,98], },
+{ n => 81, factors => [81], },
+{ n => 82, factors => [82,96,123], },
+{ n => 83, factors => [83,98,166], },
+{ n => 84, factors => [84,91,96,104], },
+{ n => 85, factors => [85,90,96,98,102], },
+{ n => 86, factors => [86,96,129], },
+{ n => 87, factors => [87,108,116], },
+{ n => 88, factors => [88,98,99], },
+{ n => 89, factors => [89,98,178], },
+{ n => 90, factors => [90,91,96,98,104,105], },
+{ n => 91, factors => [91,96,98,99,104,105,110], },
+{ n => 92, factors => [92,98,99,110,115], },
+{ n => 93, factors => [93,108,124], },
+{ n => 94, factors => [94,96,141], },
+{ n => 95, factors => [95,96,98,99,110,114], },
+{ n => 96, factors => [96,98,108], },
+{ n => 97, factors => [97,98,194], },
+{ n => 98, factors => [98,99,105,108,110,112], },
+{ n => 99, factors => [99,104,105,108,110,112,117], },
+{ n => 100, factors => [100], },
+);
+
+# TEST:$num_results=100
+# TEST*$num_results
+foreach my $test_me (@results_array)
+{
+    my $n = $test_me->{'n'};
+    my $solver = Math::GrahamFunction->new({ 'n' => $n, });
+    my $factors = $solver->solve()->{'factors'};
+    is_deeply ( $factors, $test_me->{'factors'},
+        "Testing the Graham Function Factors of $n"
+    );
+}
+