Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

RFC: Integer::Partition::Unrestricted

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

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, <> =head1 ACKNOWLEDGEMENTS This module was inspired by a problem in Project Euler (L<>) =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<> L <> =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

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 <>
    Subscribe to The Perl Review
      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 <>
        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? :)

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

    Don't fool yourself.
      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?

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

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2022-08-10 22:51 GMT
Find Nodes?
    Voting Booth?

    No recent polls found