Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
go ahead... be a heretic
 
PerlMonks  

Generator of integer partitionts of n

by chiburashka
on Aug 28, 2004 at 01:39 UTC ( #386531=perlquestion: print w/ replies, xml ) Need Help??
chiburashka has asked for the wisdom of the Perl Monks concerning the following question:

Dear monasterians,
i've built a generator of integer partitions of n which gives you all the sets of nonzero integers that add up to exactly n.

the code (i'm terribly sorry about the names of the variables. and there are few bugs that you'll be able to see as you run it):

#!/usr/bin/perl -w print 'enter n : '; $kk = $n = $nn = readline(*STDIN); my @ready = @aa = (); while ($n) {$aa[$n] = 1;$n--;} @bb = @aa; while ($kk) { $aa[$nn - $kk + 1] += $aa[$nn - $kk]; $aa[$nn - $kk]=''; $ready[($nn - $kk)*3] = "@aa\n"; $aa[$kk - 1] += $aa[$kk]; $aa[$kk]=''; $ready[($nn - $kk)*3 + 1] = "@aa\n"; $aa[$nn - $kk + 1] += $aa[$nn - $kk]; $aa[$nn - $kk]=''; $ready[($nn - $kk)*3 + 2] = "@bb\n"; $bb[$kk - 1] += $bb[$kk]; $bb[$kk]=''; $kk--;} print @ready;

so my "questions" is if there's a way to make a few improvments ?

Comment on Generator of integer partitionts of n
Download Code
Re: Generator of integer partitionts of n
by hv (Parson) on Aug 28, 2004 at 02:20 UTC

    I think there are a variety of improvements that could be made to the style of the code.

    Firstly, initialising @a and @b can be done rather more simply:

    @aa = @bb = (1) x $nn;
    .. which removes the need for the variable $n

    Secondly, the @ready array is being built up an element at a time, starting from element zero. So it would be simpler to remove the index calculations, and just use push:

    push @ready, "@aa\n"; ... push @ready, "@aa\n"; ... push @ready, "@bb\n";

    $kk is used to count down from the start value to 0, and I'd find it clearer to express that directly at the head of the loop:

    for (my $kk = $nn; $kk > 0; --$kk) { ... }

    It also seems odd that you declare @ready with my(), but none of the other variables. While writing everything with use strict is a good habit to get into, since there are no function calls in this code nor variables declared inside blocks there isn't much to be gained here. However consistency is always good, and you should either declare all your variables that way or none of them.

    I don't understand the algorithm you are using at all: when I run the code for small values of $nn I get many warnings, and the results include many duplications, odd spacing, and some zeros. Also, this algorithm always produces exactly 3n results, which is too many for small values of n and too few for larger values. (The first example I noticed of a missing partition was for n = 6 = 2 + 2 + 2.)

    If I were attempting to produce an algorithm for this, I'd be inclined to start off with the assumption that I'd want an iterator, so I'd consider first how to define a canonical ordering for a partition (eg with the numbers sorted in descending order), and then consider how given one partition I could generate the next one.

    This is fairly easy to do if you define the iterator function to take an additional parameter, but I don't want to give too much away here in case you still want the fun of working it out for yourself.

    Hugo

      if u don't mind, i want the fun, but i'm having this fun ,since yesterday(without sleep), i'm soo stuck here, please help me, SOS...
      and also i've read too much quantum chemistry, so it's kind of hard to think about anything that loops for a little while.

        I'd do it something like this:

        use strict; my $n = shift @ARGV; my $try = [ $n ]; while ($try) { print join(' ', @$try), "\n"; $try = next_partition($try); } exit 0; # all done sub next_partition { my $current = shift; # an arrayref of numbers in descending order # find the last entry greater than one my $i; for ($i = 0; $i < @$current; ++$i) { last if $current->[$i] == 1; } --$i; # if all ones, there is no next partition return undef if $i < 0; # we'll strip off all the ones, and one more my $count = @$current - $i; # and must generate the first partition of that count # subject to a top limit of what's to our left my $limit = --$current->[$i]; # replace the ones splice @$current, $i + 1, $count - 1, # with the first paritition (limited) of the count ($limit) x int($count / $limit), grep $_, $count % $limit; $current; }

Re: Generator of integer partitionts of n
by kvale (Monsignor) on Aug 28, 2004 at 02:35 UTC
    Here is a different algorithm that seems to be simpler:
    my $integer = 5; my @p; part( 2*$integer, $integer, 0); sub part { my ($n, $k, $t) = @_; $p[$t] = $k; print( join " ", @p[1..$#p], "\n") if $n == $k; for (my $j = $k<$n-$k ? $k : $n-$k; $j >= 1; $j--) { part( $n-$k, $j, $t+1); } }
    which results in
    1004% perl part.pl 5 4 1 3 2 3 1 1 2 2 1 2 1 1 1 1 1 1 1 1
    Update: Thanks to blokhead for catching my error! I had the correct algorithm, but blew it on the print statement. The last valid element of @p is at index $t. Here is the corrected code:
    my $integer = 5; my @p; part( 2*$integer, $integer, 0); sub part { my ($n, $k, $t) = @_; $p[$t] = $k; print( join " ", @p[1..$t], "\n") if $n == $k; for (my $j = $k<$n-$k ? $k : $n-$k; $j >= 1; $j--) { part( $n-$k, $j, $t+1); } }

    -Mark

      Thank you sooooooo much , that's Exactly what i was trying to do, but i need to get this output into an array somehow line by line, can you help just a little bit more please ?
        my @p; sub part { my ($a, $k, $n, $t) = @_; $n = 2*$k unless (defined($n)); $t = 0 unless (defined($t)); $p[$t] = $k; push(@$a, [ @p[1..$#p] ]) if $n == $k; for (my $j = $k<$n-$k ? $k : $n-$k; $j >= 1; $j--) { part($a, $j, $n-$k, $t+1); } } my $integer = ...; my @a; part(\@a, $integer); print(join(" ", @$_), "\n") foreach (@a);
        Some random advice for you.

        Depending on what you're doing, you should reconsider your desire to keep this data in an array. As n grows, the data requirements for that array grow rapidly. Once you use up available RAM (which happens sooner than you'd think), you're in trouble.

        Changing your flow of control of your actual problem to avoid having to have it all in memory at once will let you calculate several more values of whatever you're trying to calculate.

      Changing $integer to 6 for example gives:
      6 5 1 4 2 4 1 1 3 3 1 # oops 3 2 1 3 1 1 1 2 2 2 1 # oops 2 2 1 1 2 1 1 1 1 1 1 1 1 1 1
      You can check how many partitions of N exist for the first many values of N at this site. For N=10, for instance, there should be 77 and your script returns less than 50 (many of them even adding up to more than 10). Update: Other than an extra 1 on a few partitions here and there, it seems to get all of them though.

      blokhead

Re: Generator of integer partitionts of n
by eric256 (Parson) on Aug 28, 2004 at 02:42 UTC

    I started with the assumption that the partition of 1 was [ [ 1 ] ] and that the partion of each larger one was each sub partion with 1 added to the end, and with one added to each element. Hmm that was more confusing than in my head. Well here, the partition of 2 is [ [ 1 + 1] , [1 , 2]][ [ 1 + 1] , [1 , 1]] and the partition of 3 is [ [ 2 + 1], [1 + 1, 2], [1, 2 + 1], [1 , 2 , 1]]. Well if that hasn't made any sense here is the code.

    use strict; use warnings; use Data::Dumper; sub partition { my $num = shift || 1; my $temp = [ [1] ]; # updated 0 to 2 in the following, # since we start with one, the first add_one gets us to two. $temp = add_one($temp) for (2 .. $num); return $temp; } sub add_one { my $combinations = shift; my $temp; foreach my $combination (@$combinations) { foreach my $element (@$combination) { $element++; push @$temp, [ @$combination ]; $element--; } push @$temp, [ @$combination, 1 ]; } my $hash; foreach my $combination (@$temp) { $hash->{ join("-", sort @$combination) }++; } return [ map { [ split "-", $_ ] } keys %$hash ]; } print Dumper(partition(10) );

    Oh and I added in some code to stop it from accumulating duplicates.

    Updates: Thanks blockhead for noticeing some errors there


    ___________
    Eric Hodges
Re: Generator of integer partitionts of n
by Solo (Deacon) on Aug 28, 2004 at 03:11 UTC
    See also this node.

    --Solo

    --
    You said you wanted to be around when I made a mistake; well, this could be it, sweetheart.
Re: Generator of integer partitionts of n
by blokhead (Monsignor) on Aug 28, 2004 at 06:59 UTC
    Sloane's Integer Sequences gives the number for partitions of N for many values of N. The first solution given in this thread (and the one in its reply) doesn't work. For instance, with N=10, it only gives 42 when it should give 77 (among other obviously invalid partitions it lists).

    Here's one using an iterator. Since the number of partitions of N grows exponentially with N, it might be best to not have the entire set of partitions in memory. This is based off the algorithm outlined here.

    my $n = shift || 10; my $iter = int_partitions($n); my $total; while ( my @part = $iter->() ) { $total++; print "@part\n"; } print "There are $total partitions of $n\n"; sub int_partitions { my $n = shift; my @tally; return sub { if (!@tally) { @tally = ( (0) x $n, 1 ); return ($n); } ## last partition is $n 1's return if $tally[1] == $n; ## take one away from smallest >1 part my ($least) = grep { $tally[$_] } 2 .. $n; $tally[$least]--; $tally[$least-1]++; $tally[1]++; ## collect multiple 1's into groups smaller than $least while ( $least > 2 and $tally[1] > 1 ) { my $move = ( sort { $a <=> $b } $least-1, $tally[1] )[0]; $tally[1] -= $move; $tally[$move]++; } return map { ($_) x $tally[$_] } reverse 1 .. $n; }; }
    This returns partitions in decreasing lexicographic order. Cheers!

    Update: Just for fun, here's code for iterating over all partitions of a set (also inspired from the article linked above):

    my @set = @ARGV ? @ARGV : 1 .. 4; my $iter = set_partitions(@set); my $total; while ( my @part = $iter->() ) { $total++; print join(" ", map { "[@$_]" } @part), $/; } print "There are $total partitions of @set\n"; sub set_partitions { my @universe = @_; my @growth; return sub { if (!@growth) { @growth = (0) x @universe; return [ @universe ]; } return if $growth[-1] == $#growth; my $i = $#growth; $growth[$i--] = 0 while $growth[$i-1] == $growth[$i] - 1; $growth[$i]++; my @return; push @{ $return[$growth[$_]] }, $universe[$_] for 0 .. $#growt +h; return @return; }; }
    The internal order of parts is not significant. The parts are returned in ascending order of their smallest element. If the input set has duplicates, so will the output. I'd have to think about how to do this for multisets... Hey, this is fun! ;)

    blokhead

Re: Generator of integer partitionts of n
by jdalbec (Deacon) on Aug 28, 2004 at 15:39 UTC
    My $0.02:
    #! /usr/bin/perl -w use strict; sub partitions { my $n = shift; return partmax($n, $n) }; sub partmax { my ($n, $maxpart) = @_; return [] if $n < 0; return [[]] if $n == 0; my $partitions = []; foreach my $part (reverse 1..$maxpart) { my $subpartitions = partmax($n - $part, $part); foreach (@$subpartitions) { unshift @$_, $part; } push @$partitions, @$subpartitions; } return $partitions; } my $example = partitions shift; print scalar @$example, "\n"; foreach my $partition (@$example) { print join(" ", @$partition), "\n"; }
Re: Generator of integer partitionts of n
by sfink (Deacon) on Aug 29, 2004 at 04:23 UTC
    And my take (this just prints things out; it would be easy enough to accumulate them into an array or whatever):
    #!/usr/bin/perl part(shift, []); # Print all partitions of $n using numbers no greater # than the last element of $sofar sub part { my ($n, $sofar) = @_; if ($n == 0) { print join(" ", @$sofar), "\n"; return; } my $max = @$sofar ? $sofar->[-1] : $n; my $to = ($max > $n) ? $n : $max; for (reverse 1 .. $to) { part($n - $_, [ @$sofar, $_ ]); } }
Re: Generator of integer partitionts of n
by BrowserUk (Pope) on Aug 29, 2004 at 09:57 UTC

    #! perl -slw use strict; sub xp{ [ @$_, 1 ], @$_ > 1 && $_->[ -1 ] < $_->[ -2 ] ? [ @$_[ 0 .. $#$_ -1 ], $_->[ -1 ]+1 ] : () } sub partitions { return unless $_[ 0 ]; map( xp, partitions( $_[ 0 ] - 1 ) ), [ $_[ 0 ] ]; } print "@$_" for partitions $ARGV[ 0 ]; __END__ P:\test>386531 6 1 1 1 1 1 1 2 1 1 1 1 2 2 1 1 2 2 2 3 1 1 1 3 2 1 3 3 4 1 1 4 2 5 1 6

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
Re: Generator of integer partitionts of n
by Limbic~Region (Chancellor) on Sep 25, 2004 at 14:40 UTC
    chiburashka,
    Here is an iterative solution that produces output in ascending order and is about twice as fast as blokhead's in my rudimentary benchmarks.
    #!/usr/bin/perl use strict; use warnings; my $numb = $ARGV[ 0 ] || 10; my $iter = partition( $numb ); while ( my @part = $iter->() ) { print "@part\n"; } sub partition { my $target = shift; return sub { () } if ! $target || $target =~ /\D/; 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 ($targ +et - $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; } }
    I am sure it could probably be improved a bit more but it is working and that's what's important.

    Cheers - L~R

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2014-04-21 10:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (492 votes), past polls