Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

RFC: Integer::Partition::Unrestricted

by Limbic~Region (Chancellor)
on Feb 27, 2006 at 21:14 UTC ( #533164=perlmeditation: print w/ replies, xml ) Need Help??

All,
A problem at 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 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.

Before I do, I want to solicit your input.

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 part +itions =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 partiti +ons 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 a +rgument. It will default to using L<"pos"> if no argument is provided. If the specified value exceed L<"last_pos">, as many new partitions wi +ll 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 partiti +ons for that value. It will increment L<"last_pos"> by 1 and calculate th +e 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 partiti +ons 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 partiti +ons. 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 arg +s 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 attemp +ts not to waste memory. I am sure there could be plenty of improvements and I w +elcome 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 p +artition is L<http://en.wikipedia.org/wiki/Integer_partition> L <http://mathworld.wolfram.com/Partition.html> =cut
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.

Cheers - L~R

Comment on RFC: Integer::Partition::Unrestricted
Download Code
Replies are listed 'Best First'.
Re: RFC: Integer::Partition::Unrestricted
by brian_d_foy (Abbot) on Feb 27, 2006 at 23:45 UTC

    That's very cool!

    Recall, however, that pos is a Perl keyword, so you might want to use something else. In general, I like to spell out the words (and ambs has an article on this in the next issue of The Perl Review).

    --
    brian d foy <brian@stonehenge.com>
    Subscribe to The Perl Review
      brian_d_foy,
      Yes, pos and next are both Perl keywords. I am currently ambivalent on both points you raise. I could make the argument that there is enough visual distinction between a method call and a built-in call not to confuse the two or that shortened names for things have thrived in Unix for years, but I won't.

      You have much more experience writing software for others than I do so I will take your advice. There were comments made by diotalevi and others in the CB that I will take as well. I solicited comments because I don't do this for a living ;-)

      Cheers - L~R

        You could make that argument, but it fails when you need to use those builtins inside the package that defines those methods. And, just because Unix is vowel-deficient doesn't mean that you need to be. :)

        --
        brian d foy <brian@stonehenge.com>
        Subscribe to The Perl Review
Re: RFC: Integer::Partition::Unrestricted
by polettix (Vicar) on Feb 24, 2007 at 14:46 UTC
    I think you probably don't go and look for feedback for problem 78 on Project Euler, so I decided to give you one here :)

    Your generator is quite impressive but it is a bit overkill in this case. The problem statement requires divisibility by 1_000_000, which means that you can do all sums and differences modulo 1_000_000 and still get a good answer; moreover, you can cache values of p(n) modulo 1_000_000. As a consequence, you can work with "regular" integers and get rid of bigint, which slows you down.

    In my solution, I am a bit less optimised than you, because I'm calculating pentas all the time; in any case, it runs in about 19 seconds on Centrino 1.6GHz. If you're interested, I've put it into Project Euler forum entry #78 (I'm polettix).

    I also saw that you didn't publish this code, but I think it could be useful - who knows? :)

    Flavio
    perl -ple'$_=reverse' <<<ti.xittelop@oivalf

    Don't fool yourself.
      frodo72,
      Thanks for the feedback. I lost interest in Project Euler a long time ago. Since my intent, as noted in the forum of problem 78, was to write code reusable for others - I ignored optimizations specific to the problem posed. I have not given up on the idea of publishing it but it needs to be part of a larger puzzle and right now I don't have time for that.

      Cheers - L~R

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://533164]
Front-paged by kutsu
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2015-07-30 17:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (273 votes), past polls