I hope to make a future version of Algorithm::Loops such that this is easier to write. However, you can still avoid having to generate the entire list into memory by avoiding duplicates as you go:
#!/usr/bin/perl -w
use strict;
use Algorithm::Loops qw( NestedLoops );
my $permlist= [ 'a' .. shift(@ARGV)||'c' ];
my $max= $#$permlist;
my $card= shift(@ARGV) || 1;
my $iter= NestedLoops(
[
[ 0 .. $max+1-2*$card ],
sub { [ $_+1 .. $max ] },
map {
my $left= $card - $_;
sub {
my %used; @used{@_}= (1) x @_;
[ grep !$used{$_}, $_[-2]+1 .. $max+1-2*$left ];
},
sub {
my %used; @used{@_}= (1) x @_;
[ grep !$used{$_}, $_+1 .. $max ];
},
} 1 .. $card-1,
],
);
## my @data;
my @idx;
my $count;
{
my $prod= 1;
my $mult= @$permlist;
for( 1..$card ) {
$prod *= $mult--;
$prod /= $_;
}
for( 1..$card ) {
$prod *= $mult--;
$prod /= 2;
}
print "$prod pairings:\n";
}
while( @idx= $iter->() ) {
my @group;
while( @idx ) {
my @pair= @{$permlist}[ splice(@idx,0,2) ];
push @group, \@pair;
}
printf "( %s )\n", join ", ", map sprintf("(%s,%s)",@$_), @group;
## push @data, \@group;
}
See how easy that is? ;)
A sample use is:
> perl pairs.pl e 2
15 pairings:
( (a,b), (c,d) )
( (a,b), (c,e) )
( (a,b), (d,e) )
( (a,c), (b,d) )
( (a,c), (b,e) )
( (a,c), (d,e) )
( (a,d), (b,c) )
( (a,d), (b,e) )
( (a,d), (c,e) )
( (a,e), (b,c) )
( (a,e), (b,d) )
( (a,e), (c,d) )
( (b,c), (d,e) )
( (b,d), (c,e) )
( (b,e), (c,d) )
Uncomment two lines to have the list of groups saved into @data.
Update: Note that you can actually make that a bit faster such that most of the loop list constructors don't need the %used trick, but it makes the code a bit more complex to read:
#!/usr/bin/perl -w
use strict;
use Algorithm::Loops qw( NestedLoops );
my $permlist= [ 'a' .. shift(@ARGV)||'c' ];
my $max= $#$permlist;
my $card= shift(@ARGV) || 1;
my $iter= NestedLoops(
[
[ 0 .. $max+1-2*$card ],
map( {
my $left= $card - $_;
sub { [ $_+1 .. $max+1-2*$left ] },
} 1 .. $card-1 ),
(
sub {
my %used; @used{@_}= (1) x @_;
[ grep !$used{$_}, $_[-$card]+1 .. $max ];
},
) x $card,
],
);
## my @data;
my @idx;
while( @idx= $iter->() ) {
my @group= map {
[ @{$permlist}[ @idx[$_,$_+$card] ] ]
} 0 .. $card-1;
printf "( %s )\n", join ", ", map sprintf("(%s,%s)",@$_), @group;
## push @data, \@group;
}
Which produces the same results though sorted in a different order.
-
tye