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
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.