Here goes a larger (functional) code fragment, along with a test-case. The results of the test-case are below as well.
use strict;
sub getDistinctPermutations($$);
### RUN SUB
my @data = ('A', 'B', 'C', 'D', 'E', 'F');
my $cardinality = 2;
my $dataref = getDistinctPermutations(\@data, $cardinality);
if ($dataref == 0) {
die "Bad return\n";
}
for (my $i = 0; $i < scalar(@$dataref); $i++) {
my $element = $$dataref[$i];
print join(' ', @{$element->{first}}, @{$element->{second}}), "\n"
+;
}
### SUB
sub getDistinctPermutations($$) {
my $permlist = $_[0];
my $cardinality = $_[1];
if (scalar(@$permlist) < 2) {
return 0;
}
elsif ($cardinality < 1) {
return 0;
}
my @data;
if ($cardinality == 1) {
for (my $i = 0; $i < scalar(@$permlist); $i++) {
for (my $j = 0; $j < scalar(@$permlist); $j++) {
push @data, {
first => [$$permlist[$i]],
second => [$$permlist[$j]],
};
}
}
}
if ($cardinality == 2) {
for (my $i = 0; $i < scalar(@$permlist); $i++) {
for (my $j = $i+1; $j < scalar(@$permlist); $j++) {
for (my $k = 0; $k < scalar(@$permlist); $k++) {
for (my $p = $k+1; $p < scalar(@$permlist); $p++) {
push @data, {
first => [$$permlist[$i], $$permlist[$j]],
second => [$$permlist[$k], $$permlist[$p]],
};
}
}
}
}
}
return \@data;
}
Which gives the results:
A B A B
A B A C
A B A D
A B A E
A B A F
A B B C
A B B D
A B B E
A B B F
A B C D
A B C E
A B C F
A B D E
A B D F
A B E F
A C A B
A C A C
A C A D
A C A E
A C A F
A C B C
A C B D
A C B E
A C B F
A C C D
A C C E
A C C F
A C D E
A C D F
A C E F
A D A B
A D A C
A D A D
A D A E
A D A F
A D B C
A D B D
A D B E
A D B F
A D C D
A D C E
A D C F
A D D E
A D D F
A D E F
A E A B
A E A C
A E A D
A E A E
A E A F
A E B C
A E B D
A E B E
A E B F
A E C D
A E C E
A E C F
A E D E
A E D F
A E E F
A F A B
A F A C
A F A D
A F A E
A F A F
A F B C
A F B D
A F B E
A F B F
A F C D
A F C E
A F C F
A F D E
A F D F
A F E F
B C A B
B C A C
B C A D
B C A E
B C A F
B C B C
B C B D
B C B E
B C B F
B C C D
B C C E
B C C F
B C D E
B C D F
B C E F
B D A B
B D A C
B D A D
B D A E
B D A F
B D B C
B D B D
B D B E
B D B F
B D C D
B D C E
B D C F
B D D E
B D D F
B D E F
B E A B
B E A C
B E A D
B E A E
B E A F
B E B C
B E B D
B E B E
B E B F
B E C D
B E C E
B E C F
B E D E
B E D F
B E E F
B F A B
B F A C
B F A D
B F A E
B F A F
B F B C
B F B D
B F B E
B F B F
B F C D
B F C E
B F C F
B F D E
B F D F
B F E F
C D A B
C D A C
C D A D
C D A E
C D A F
C D B C
C D B D
C D B E
C D B F
C D C D
C D C E
C D C F
C D D E
C D D F
C D E F
C E A B
C E A C
C E A D
C E A E
C E A F
C E B C
C E B D
C E B E
C E B F
C E C D
C E C E
C E C F
C E D E
C E D F
C E E F
C F A B
C F A C
C F A D
C F A E
C F A F
C F B C
C F B D
C F B E
C F B F
C F C D
C F C E
C F C F
C F D E
C F D F
C F E F
D E A B
D E A C
D E A D
D E A E
D E A F
D E B C
D E B D
D E B E
D E B F
D E C D
D E C E
D E C F
D E D E
D E D F
D E E F
D F A B
D F A C
D F A D
D F A E
D F A F
D F B C
D F B D
D F B E
D F B F
D F C D
D F C E
D F C F
D F D E
D F D F
D F E F
E F A B
E F A C
E F A D
E F A E
E F A F
E F B C
E F B D
E F B E
E F B F
E F C D
E F C E
E F C F
E F D E
E F D F
E F E F
-
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.