#! perl -w
use strict;
=pod
 	Bit-twiddling transpositional combination generator in Perl,
 	© 2002,BrowserUK / perlmonks.com
 	Based upon a C implementation by Doug Moore (unkadoug@yahoo.com).
 	Source:http://www.caam.rice.edu/~dougm/twiddle/yargbitcomb.c
=cut
sub Lshift1
{
	use integer;
	my $i = shift;
	my $ii = $i>>1;
	return 1 << $ii << ($i - $ii);
}

sub yargFirstComb
# Returns the inverse gray code (yarg) of the first combination of k items (i.e. {0,1,..,k-1})
{
	use integer;
	my $kk = Lshift1($_[0])-1;
	return $kk ^ $kk/3;
};

sub leastItem
# Returns the least item in a combination (i. e. leastItem({2,4,5}) == {2}
{ 	use integer; return $_[0] & -$_[0]; };

sub yargLastComb
# Returns the yarg of the last combination of k items from n (i.e. {n-k,..,n-1})
{
	use integer;
	my ($nn, $kk) = ( Lshift1($_[0])-1, Lshift1($_[1])-1);
	return ($_[1]) ?   $nn ^ ($kk/3) : 0;
};

# Returns the yarg of the next combination after yarg input
sub yargNextComb {
	use integer;
	my $comb = shift;
	my $grey = ($comb << 1) ^ $comb;
	my $i = 2;
	my $candidateBits;

	do {
		my $y = ($comb & ~($i - 1)) + $i;
		my $j = leastItem( $y ) << 1;
		my $h = !!($y & $j);
		$candidateBits = (($j - $h) ^ $grey) & ( $j - $i );
		$i = $j;
	} while (!$candidateBits);

	return $comb + leastItem($candidateBits);
}

sub factorial { no integer; my ($f,$n) = (1,shift); $f *= $n-- while( $n ); return $f; }

sub subsets {
	use integer;
	my @AoAoCombs;
	my ($k, $n, $combs) = (shift, shift, 0);
	{
		no integer;
		$combs = factorial($n)/(factorial($k)*factorial($n-$k));
		print "Generating $combs subsets of $k from a set of $n\n";
		 $#AoAoCombs = $combs-1; 						#pre-extend the array of array refs to its final size
	}
	die "Usage: subsets k, n\nGenerate subsets of k-elements from a set of n-elements where k < n.\n"
		 unless $n and $k and $k < $n;

	my $comb = yargFirstComb($k);
	my $lastcomb = yargLastComb( $n, $k);

	while(1)  {
		my $member = 0; #!!
		my $c = $comb ^ ($comb >> 1);

		# 'push' anon array ref & pre-extend anon. array space
		$AoAoCombs[--$combs] = [];
		$#{$AoAoCombs[$combs]} = $k-1;

		($c & Lshift1($_)) and @{$AoAoCombs[$combs]}[$member++] = $_ for 0 .. $n-1; # 'unshift'

		last if $comb == $lastcomb;
		$comb = yargNextComb($comb);
	}
	return \@AoAoCombs;
}

my $AoAoCombs = subsets 2, 4; # Generate combinations of indices

my @data1 = qw( just another perl hacker );
local $,=' ';
print "Applying combined indices to @data1\n\n";
print @data1[ @{$AoAoCombs->[$_]} ], $/ for (0 .. $#$AoAoCombs);

my @data2= (1,2,3,4);
print "\nApplying combined indices to @data2\n\n";
print @data2[ @{$AoAoCombs->[$_]} ], $/ for (0 .. $#$AoAoCombs); # Apply the indices to as many sets as you like
print $/;

no integer;
my @data3 = (1..31);
my @times = (times);
my $start = $times[0] + $times[1];

$AoAoCombs = subsets 26,  ~~@data3;

 @times = times;
my $end = $times[0]+$times[1];

print "Generating " . @{$AoAoCombs} . " combinations of 26 from 31 took ", $end-$start, " seconds of cpu P-II\@233MHz\n",
	"including generating 169911 x 26 element anonymous arrays to store the results.\n";

#print "\nApplying combined indices to @data1\n\n";
#print @data1[@{$^AoAoCombs[$_]}], $/ for (0..$#{$AoAoCombs}); 		# Apply the indices

__END__
# Output
C:\test>191902
Generating 6 subsets of 2 from a set of 4
Applying combined indices to just another perl hacker

just hacker
another hacker
perl hacker
just perl
another perl
just another

Applying combined indices to 1 2 3 4

1 4
2 4
3 4
1 3
2 3
1 2

Generating 169911 subsets of 26 from a set of 31
Generating 169911 combinations of 26 from 31 took  251.51  seconds of cpu P-II@233MHz
 including generating 169911 x 26 element anonymous arrays to store the results.

C:\test>