Generator of integer partitionts of n

[chiburashka]

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 ?

[kvale]

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);
   }
}

[blokhead]

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.

[hv]

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

[chiburashka]

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.

[hv]

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;
  }

[eric256]

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

[blokhead]

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! ;)

[Solo]

See also this node.

[jdalbec]

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";
}

[BrowserUk]

#! 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

[sfink]

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, $_ ]);
    }
}

[Limbic~Region]

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.