use List::Util 'sum';
sub partition {
my @block_size = sort { $a <=> $b } @{ shift(@_) };
my @items = @_;
@items == sum @block_size
or die "Combined size of blocks must equal the number of items";
my @rg;
return sub {
if ( !@rg ) {
@rg = map { ($_) x $block_size[$_] } 0 .. $#block_size;
} elsif ( ! next_rg_perm(\@rg) ) {
next_permute(\@block_size) or return;
@rg = map { ($_) x $block_size[$_] } 0 .. $#block_size;
}
## uncomment this to see the internal state:
## print "@block_size / @rg\n";
my @return;
push @{ $return[ $rg[$_] ] }, $items[$_] for 0 .. $#items;
return @return;
};
}
## to obtain lexicographically next RG string, look for the rightmost
## position where we have an appropriate candidate available. the
## candidate is smallest number to the right of our current position
## such that:
## - candidate is larger than our current position
## - candidate is not >=2 larger than everything to the left
## (restricted growth property)
sub next_rg_perm {
my $vals = shift;
my ($candidate, @avail);
my $i = @$vals;
while (--$i) {
($candidate) = grep defined, @avail[ $vals->[$i]+1 .. $#avail ];
last if defined $candidate
and grep { $_ >= $vals->[$candidate]-1 } @$vals[0..$i-1];
$avail[ $vals->[$i] ] = $i;
}
return if $i == 0;
@$vals[$i, $candidate] = @$vals[$candidate, $i];
@$vals[$i+1 .. $#$vals] = sort { $a <=> $b } @$vals[$i+1 .. $#$vals];
return 1;
}
## stolen ... er, adapted from tye: http://perlmonks.org/?node_id=29374
sub next_permute {
my $vals = shift;
return if @$vals < 2;
## find rightmost position where the sequence increases
my $i = $#$vals - 1;
$i-- until $i < 0 or $vals->[$i] < $vals->[$i+1];
return if $i < 0;
## reverse everything to the right (now it's in increasing order)
@$vals[ $i+1 .. $#$vals ] = reverse @$vals[ $i+1 .. $#$vals ];
## move right to find the first number that's larger, which we
## will swap with position i
my $j = $i+1;
$j++ until $vals->[$i] < $vals->[$j];
@$vals[$i,$j] = @$vals[$j,$i];
return 1;
}
####
## split 'a' through 'f' into blocks of sizes 3+2+1:
my $iter = partition( [3,2,1], qw[a b c d e f]);
while (my @parts = $iter->()) {
print "[@$_] " for @parts;
print $/;
}
##
##
sub equipartition {
my $parts = shift;
my $items = @_;
my @p = map { int( ($items+$_)/$parts ) } 0 .. $parts-1;
partition( \@p, @_ );
}
my $iter = equipartition(4 => 1..16);
...