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:
See how easy that is? ;)#!/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; }
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; }
In reply to Re: Generalizing Code: Generating Unique Permutations (iterator)
by tye
in thread Generalizing Code: Generating Unique Permutations
by Anonymous Monk
For: | Use: | ||
& | & | ||
< | < | ||
> | > | ||
[ | [ | ||
] | ] |