#!/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;
}

##</code><code>##

 > 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) )

##</code><code>##

#!/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;
}