perlmeditation
Limbic~Region
All,
<br />
A problem at [http://mathschallenge.net/index.php?section=project&ref=about|Project Euler] led me to try and find an extremely fast way of determining the number of unrestricted partitions of an integer. I was suprised to find that nothing on [http://www.cpan.org|CPAN] did this already (or at least I couldn't find anything). So once I solved the problem, I decided to throw together some code and perhaps upload it.
<p>
Before I do, I want to solicit your input.
</p>
<READMORE>
<CODE>
package Integer::Partition::Unrestricted;
use strict;
use warnings;
use Carp;
use Math::BigInt;
our $VERSION = '0.01';
sub new {
my $class = shift;
croak "Incorrect number of parameters" if @_ % 2;
my $self = bless {}, $class;
$self->_Init(@_);
return $self;
}
sub pos {
my ($self, $new_pos) = @_;
return $self->{POS} if ! defined $new_pos;
croak "The 'pos' argument must be a non-negative integer" if $new_pos =~ /[^0-9]/;
croak "Out of range 'pos'" if $new_pos > $#{$self->{PART}};
return $self->{POS} = $new_pos;
}
sub last_pos {
my $self = shift @_;
return $#{$self->{PART}};
}
sub val {
my ($self, $pos) = @_;
my $last = $self->last_pos();
$pos = $last if ! defined $pos;
croak "The 'pos' argument must be a non-negative integer" if $pos =~ /[^0-9]/;
return $self->{PART}[$pos] if $pos <= $last;
$self->_Add_Partitions($last + 1, $pos);
return $self->{PART}[$self->last_pos()];
}
sub next {
my $self = shift @_;
if ($self->pos() < $self->last_pos()) {
$self->pos($self->pos() + 1);
return $self->val($self->pos());
}
$self->_Add_Partitions($self->last_pos() + 1, $self->last_pos() + 1);
$self->pos($self->pos() + 1);
return $self->val($self->pos());
}
sub prev {
my $self = shift @_;
$self->pos($self->pos() - 1) if $self->pos();
return $self->val($self->pos());
}
sub gen_iter {
my ($self, $target) = @_;
$target = $self->pos() if ! defined $target;
croak "The 'gen_iterator' argument must be a positive integer" if $target =~ /[^0-9]/;
my @part = (0, (1) x ($target - 1));
my $done = undef;
return sub {
return () if $done;
my $min = $part[-2];
my $total = $part[0] ? 0 : 1;
my $index = 0;
for (0 .. $#part - 1) {
if ($part[$_] > $min) {
$total += $part[$_];
next;
}
$index = $_;
last;
}
$part[$index]++;
$total += $part[$index];
if ($total > $target || $part[$index] > $part[0]) {
@part = ($index ? ++$part[0] : $part[0], (1) x ($target - $part[0]));
}
else {
@part = (@part[0 .. $index], (1) x ($target - $total));
push @part, 1 if $part[0] == 1;
}
$done = 1 if $part[0] == $target;
return @part;
};
}
sub _Init {
my ($self, %opt) = @_;
my $n = 1;
$n = delete $opt{init} if exists $opt{init};
croak "The 'init' option must be a positive integer" if ! $n || $n =~ /\D/;
croak "Invalid option provided" if %opt;
$self->_Set_Defaults();
$self->_Add_Partitions(1, $n);
return;
}
sub _Set_Defaults {
my $self = shift @_;
$self->{PART} = [ Math::BigInt->new(1) ];
$self->{PENT} = [ 0 ];
$self->{POS} = 0;
return;
}
sub _Add_Partitions {
my ($self, $min, $max) = @_;
$self->_Add_Pent($max);
for my $i ($min .. $max) {
my $sum = 0;
for my $j (1 .. $self->_Find_Idx($i)) {
if (($j % 4) % 3) {
$sum += $self->{PART}[$i - $self->{PENT}[$j]];
}
else {
$sum -= $self->{PART}[$i - $self->{PENT}[$j]];
}
}
$self->{PART}[$i] = $sum;
}
return;
}
sub _Add_Pent {
my ($self, $max) = @_;
my $need = int(sqrt($max + 1)) * 2 + 1;
return if $need <= @{$self->{PENT}};
my $last = $self->_Pent_2_N();
for ($last + 1 .. ($need - 1) / 2) {
push @{$self->{PENT}}, ($_ * (3 * $_ - 1) / 2), (-$_ * (3 * -$_ - 1) / 2);
}
return;
}
sub _Pent_2_N {
my $self = shift @_;
my $c = $self->{PENT}[-1];
my $x = (1 + sqrt(1 - (4 * 3 * -2 * $c))) / 6;
return abs($x) if $x == int($x);
return abs((1 - sqrt(1 - (4 * 3 * -2 * $c))) / 6);
}
sub _Find_Idx {
my ($self, $tgt) = @_;
my $min = 0;
my $max = $#{$self->{PENT}};
my $mid;
while ($min <= $max) {
$mid = int(($min + $max) / 2);
my $val = $self->{PENT}[$mid];
return $mid if $val == $tgt;
$tgt < $val ? ($max = $mid - 1) : ($min = $mid + 1);
}
return $self->{PENT}[$mid] < $tgt ? $mid : $mid - 1;
}
"This statement is false";
__END__
=head1 NAME
Integer::Partition::Unrestricted - Work with unrestricted integer partitions
=head1 VERSION
Version 0.01 developed on 2006-02-27
=head1 SYNOPSIS
use Integer::Partition::Unrestricted;
my $part = Integer::Partition::Unrestricted->new(init => 100);
my $last = $part->last_pos();
while ($part->pos() <= $last) {
my $pos = $part->pos();
print "$pos = ", $part->val($pos), "\n";
$part->next();
}
my $next = $part->gen_iter(10);
while (my @part = $next->()) {
print "@part\n";
}
$part->pos(0);
print $part->prev();
=head1 DESCRIPTION
This module allows you to work with unrestricted integer partitions
=head1 SYNTAX
The new() constructor can be called with a hash of additional options
my $part = Integer::Partition::Unrestricted->new();
or
my $part = Integer::Partition::Unrestricted->new(init => 42);
=head1 OPTIONS
=over 4
=item init
This option allows you to specify an initial number of integer partitions
my $part = Integer::Partition::Unrestricted->new(init => 1000);
=back
=head1 METHODS
=head2 pos
This method returns the current iterator position if no arguments are specified.
You can set the position any where between 0 and L<"last_pos">
my $curr_pos = $part->pos();
# Set iterator to end of currently calculated partitions
$part->pos($part->last_pos());
=head2 last_pos
This method returns the position of the last calculated parition
my $calculated = $part->last_pos();
=head2 val
This method returns the number of partitions of the integer provided argument.
It will default to using L<"pos"> if no argument is provided.
If the specified value exceed L<"last_pos">, as many new partitions will be
calculated as necessary.
# The number of integer partitions of 100 is
print $part->val(100), "\n";
=head2 next
This method increments L<"pos"> by 1 and returns the number of partitions
for that value. It will increment L<"last_pos"> by 1 and calculate the next
integer partition if necessary.
# Set position to end of calculated values
my $n = $part->last_pos();
$part->pos($n);
# Print number of positions for next integer
print $n + 1, " = ", $part->next(), "\n";
=head2 prev
This method decrements L<"pos"> by 1 and returns the number of partitions
for that value. It will always return 1 at position 0.
my $prev_val = $part->prev();
=head2 gen_iter
Sometimes it is necessary to know more than just the number of partitions.
This method will return an code ref to iterate over the partitions of
the integer argument specified. It will default to L<"pos"> if no args are supplied.
$part->pos(42);
my $next = $part->gen_iter();
while (my @part = $next->()) {
print "@part\n";
}
=head1 AUTHOR
Joshua Gatcomb, <Limbic_Region_2000@Yahoo.com>
=head1 ACKNOWLEDGEMENTS
This module was inspired by a problem in Project Euler
(L<http://mathschallenge.net/index.php?section=project&ref=about>)
=head1 BUGS
None known. Bug reports, fixes, and feedback are desired.
=head1 PERFORMANCE
While this module is pure perl and is OO, it is fairly fast and attempts not to
waste memory. I am sure there could be plenty of improvements and I welcome
suggestions (preferrably as patches).
=head1 COPYRIGHT
Copyright (c) 2006 Joshua Gatcomb. All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=head1 SEE ALSO
The following links may be helpful if you don't know what an integer partition is
L<http://en.wikipedia.org/wiki/Integer_partition>
L <http://mathworld.wolfram.com/Partition.html>
=cut
</CODE>
</READMORE>
Beyond needing a test suite, I also considered adding a couple of methods to peek at values without changing the position. Feel free to comment on that or any other new methods you think might be useful.
<div class="pmsig"><div class="pmsig-180961">
<p>
Cheers - [Limbic~Region|L~R]
</p>
</div></div>