1package mix_tests;
2
3use strict;
4use warnings;
5use vars qw(@EXPORT @EXPORT_OK @ISA);
6
7use Exporter;
8
9@ISA = qw(Exporter);
10@EXPORT = qw(variegate_list combine_list combine_nk totalcombs);
11@EXPORT_OK = @EXPORT;
12
13sub variegate_list($@);
14sub combine_list($@);
15
16sub variegate_list($@) {
17	my ($amount, @items) = @_;
18	my @result;
19
20	$amount == 1 and return map { [ $_ ] } @items;
21
22	foreach my $idx ( 0 .. $#items ) {
23		my @copy = @items;
24		my @round_item = splice( @copy, $idx, 1 );
25		my @round_list = variegate_list( $amount - 1, @copy );
26		foreach my $sublist (@round_list) {
27			push( @result, [ @round_item, @{$sublist} ] );
28		}
29	}
30
31	return @result;
32}
33
34sub totalcombs($$){
35	my ($n, $k) = @_;
36	my $c = 1;
37	$k > $n and return 0;
38	for my $d ( 1 .. $k ) {
39		$c *= $n--;
40		$c /= $d;
41		$c = int($c);
42	}
43	return $c;
44}
45
46sub combine_nk($$) {
47	my ($n, $k) = @_;
48	my @indx;
49	my @result;
50
51	@indx = map { $_ } ( 0 .. $k - 1 );
52
53LOOP:
54	while( 1 ) {
55		my @line = map { $indx[$_] } ( 0 .. $k - 1 );
56		push( @result, \@line ) if @line;
57		for( my $iwk = $k - 1; $iwk >= 0; --$iwk ) {
58			if( $indx[$iwk] <= ($n-1)-($k-$iwk) ) {
59				++$indx[$iwk];
60				for my $swk ( $iwk + 1 .. $k - 1 ) {
61					$indx[$swk] = $indx[$swk-1]+1;
62				}
63				next LOOP;
64			}
65		}
66		last;
67	}
68
69	return @result;
70}
71
72sub combine_list($@) {
73	my ($amount, @items) = @_;
74	my @result;
75
76	$amount == 1 and return map { [ $_ ] } @items;
77
78	foreach my $idx ( 0 .. $#items ) {
79		my @copy = @items;
80		my @round_item = splice( @copy, $idx, 1 );
81		my @round_list = combine_list( $amount - 1, @copy );
82		foreach my $sublist (@round_list) {
83			push( @result, [ @round_item, @{$sublist} ] );
84		}
85	}
86
87	my @sorted = map { [ sort { $a <=> $b } @{$_} ] } @result;
88	my %uniq_sorted;
89	foreach my $si (@sorted) {
90		my $si_key = join(",", @{$si});
91		$uniq_sorted{$si_key} = $si;
92	}
93	@result = values(%uniq_sorted);
94
95	return @result;
96}
97
981;
99