Here are some ways to iterate over @S choose $K, all the $K-sized subsets of @S.
## Filtering tye's "combinations" (power set) iterator:
my $iter = combinations(@S);
while ( my @c = $iter->() ) {
next unless @c == $K;
...
}
## Using tye's Algorithm::Loops:
NestedLoops(
[ 0 .. $#S ],
( sub { [$_+1 .. $#S] } ) x ($K - 1),
sub { my @c = @S[@_]; ... }
}
Finally, the code below which uses a similar principle as [id://128293], keeping track of a list of indices. The subsets are returned in the same order as a nested for-loop.
Update: see [id://459702] for a verbose explanation of what this code does.
sub combinations {
my ($num, $arr) = @_;
return sub { return }
if $num == 0 or $num > @$arr;
my @pick;
return sub {
return @$arr[ @pick = ( 0 .. $num - 1 ) ]
unless @pick;
my $i = $#pick;
$i-- until $i < 0 or $pick[$i]++ < @$arr - $num + $i;
return if $i < 0;
@pick[$i .. $#pick] = $pick[$i] .. $#$arr;
return @$arr[@pick];
};
}
You use it like this:
my $iter = combinations( 3 => ['a' .. 'f'] );
while ( my @c = $iter->() ) {
print "@c\n";
}
#!/usr/bin/perl
use strict;
use warnings;
my $iter = combo( 5 , 1 .. 50 );
while ( my @combo = $iter->() ) {
print "@combo\n";
}
sub combo {
my $by = shift;
return sub { () } if ! $by || $by =~ /\D/ || @_ < $by;
my @list = @_;
my @position = (0 .. $by - 2, $by - 2);
my @stop = @list - $by .. $#list;
my $end_pos = $#position;
my $done = undef;
return sub {
return () if $done;
my $cur = $end_pos;
{
if ( ++$position[ $cur ] > $stop[ $cur ] ) {
$position[ --$cur ]++;
redo if $position[ $cur ] > $stop[ $cur ];
my $new_pos = $position[ $cur ];
@position[ $cur .. $end_pos ] = $new_pos .. $new_pos + $by;
}
}
$done = 1 if $position[0] == $stop[0];
return @list[ @position ];
}
}
I didn't spend a lot of time benchmarking it. In some cases it does better than yours and then in others it does much worse. In any case, since I went through the trouble I figured I would add it here (now that I found it) in the spirit of TIMTOWTDI.
Cheers - [Limbic~Region|L~R]
Update: I kept the algorithm the same, but I made numerous optimizations. It is now much faster in the best case and only marginally slower than your method in the worst cases. The original is in HTML comments if anyone is interested.
perlmonks.org content © perlmonks.org and blokhead, Limbic~Region
prlmnks.org © 2006 edmund von der burg (eccles & toad)
v 0.03