Anonymous Monk has asked for the
wisdom of the Perl Monks concerning the following question:
This isn't really a Perl question, but more of a programming logic one. It just happens that the only language I'm a little fluent in is Perl.
Given an array of arrays of unknown dimensions, how do I generate all possible combinations, as in:
my @array = (
[ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
);
a1x, a1y, a2x, a2y, a3x, a3y, a4x, a4y, b1x, b1y, b2x, b2y, b3x, b3y,
+b4x, b4y, c1x, c1y, c2x, c2y, c3x, c3y, c4x, c4y
Until now all I've managed is:
my @as = @{ $array[0] };
foreach my $a (@as) {
my @bs = @{ $array[1] };
foreach my $b (@bs) {
my @cs = @{ $array[2] };
foreach my $c (@cs) {
print $a;
print $b;
print $c . ", ";
}
}
}
I need to abstract away from the indices (1,2,3) in that code, meaning I need this to work independent of dimension of the first array (it will always remain a array of arrays though, no further embedding is necessary).
Or am I approaching this wrong in the first place?
Re: Generating all possible combinations from an AoA by james2vegas (Chaplain) on Apr 13, 2011 at 09:06 UTC 
Use File::Glob's bsd_glob function, something like:
use File::Glob (bsd_glob);
my @array = (
[ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
);
my $glob = join( '', map { '{' . join( ',', @$_ ) . '}' } @array );
my @list = bsd_glob($glob);
Update: I guess I approached this as a Perl programming problem not as a programming logic problem, oh well.  [reply] [d/l] 
Re: Generating all possible combinations from an AoA by GrandFather (Cardinal) on Apr 13, 2011 at 09:07 UTC 
 [reply] 

 [reply] 
Re: Generating all possible combinations from an AoA by jwkrahn (Monsignor) on Apr 13, 2011 at 09:12 UTC 
$ perl le'
my @array = (
[ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
);
my $pattern = join "", map "{$_}", map join( ",", @$_ ), @array;
print for glob $pattern;
'
a1x
a1y
a2x
a2y
a3x
a3y
a4x
a4y
b1x
b1y
b2x
b2y
b3x
b3y
b4x
b4y
c1x
c1y
c2x
c2y
c3x
c3y
c4x
c4y
 [reply] [d/l] 
Re: Generating all possible combinations from an AoA by BrowserUk (Pope) on Apr 13, 2011 at 09:28 UTC 
#! perl slw
use strict;
sub nFor(&@) {
my $code = shift;
die "First argument must be a code ref" unless ref( $code ) eq 'CO
+DE';
my @limits = @_;
my @indices = ( 0 ) x @limits;
for( my $i = $#limits; $i >= 0; ) {
$i = $#limits;
$code>( @indices ), ++$indices[ $i ]
while $indices[ $i ] < $limits[ $i ];
$i = $#limits;
$indices[ $i ] = 0, ++$indices[ $i ]
while $i >= 0 and $indices[ $i ] == $limits[ $i ];
}
}
my @array = (
[ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
);
nFor {
print join '', map $array[ $_ ][ $_[ $_ ] ], 0 .. $#_
} map scalar @$_, @array;
__END__
c:\test>nfor
a1x
a1y
a2x
a2y
a3x
a3y
a4x
a4y
b1x
b1y
b2x
b2y
b3x
b3y
b4x
b4y
c1x
c1y
c2x
c2y
c3x
c3y
c4x
c4y


Examine what is said, not who speaks  Silence betokens consent  Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
 [reply] [d/l] 
Re: Generating all possible combinations from an AoA by JavaFan (Canon) on Apr 13, 2011 at 10:24 UTC 
use 5.010;
sub mix {@_ ? map {my $x = $_; map "$x$_", mix(@_[1..$#_])} @{$_[0]} :
+ ""}
say for mix @array;
 [reply] [d/l] 

 [reply] 

 [reply] 
Re: Generating all possible combinations from an AoA by eye (Chaplain) on Apr 13, 2011 at 12:12 UTC 
When you have an indeterminate level of nesting, it is good to think about recursive solutions (as in JavaFan's solution).  [reply] 
Re: Generating all possible combinations from an AoA by LanX (Canon) on Apr 13, 2011 at 12:42 UTC 
Approaches:
1.Metaprogramming
Generate dynamically a string of the above code with all nesting and eval it. (fast and intuitive!)
2. Recursion
Write a function X2() which gets two arrayrefs and returns an arr_ref of the cross product.
Call it recursively until @array exceeded.
3. Reduce
is a variation of the above, with List::Util::reduce
use Data::Dumper;
# crossproduct of two array refs
sub X2 {
my ($a,$b)=@_;
my @result;
for my $x (@$a) {
for my $y (@$b) {
unless (ref($x) eq "ARRAY"){
push @result, [$x,$y];
}else{
push @result, [(@$x,$y)];
}
}
}
return \@result;
}
use List::Util qw/reduce/;
# crossproduct of list of array refs
sub X { reduce { X2($a,$b) } @_ }
my @array = (
[ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
);
print Dumper X(@array);
The function X() now works somehow like the X operator in perl6, but of course you could also use reduce { X2($a,$b) } @array directly.
The function X2() could be rewritten with two nested maps, but thats a little two cryptic for my taste.
Bad ideas:
1. Glob
that's a hack which only works for strings as element type, everything else will be stringified, eg refs!!!
UPDATES:
* just noticed that you only want a simple concatenation of strings. That simplifies the code...
* There is a problem with this code .. the first one to spot it gets upvoted! :)  [reply] [d/l] [select] 
Re: Generating all possible combinations from an AoA by ikegami (Pope) on Apr 13, 2011 at 17:54 UTC 
use Algorithm::Loops qw( NestedLoop );
my @terms = NestedLoop(\@array, sub { join '', @_ });
print(join(', ', @terms), "\n");
 [reply] [d/l] 
Re: Generating all possible combinations from an AoA by dj_nitrkl (Initiate) on Apr 13, 2011 at 19:33 UTC 
Hi ,
I have approached this problem thru programming logic using recursive functions .May be its a little noobish but it gets the job done .any comments are welcome.
@array = (
[ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
["A","B","C"]
);
our @initial_array = @{$array[0]};
our $i = 1 ;
$stop = scalar (@array) ;
recurse () ;
sub recurse () {
$k = 0 ;
foreach (@initial_array)
{
$firstelement = $_ ;
@next_array = @{$array[$i]} ;
foreach (@next_array) {
$combination
+[$k]= $firstelement.$_ ;
$k++ ;
}
}
@initial_array = @combination ; $i++ ;
if ( $i == $stop )
{
print " @combination ";
exit ;
}
else {
recurse () ;
}
}
output
______
a1xA a1xB a1xC a1yA a1yB a1yC a2xA a2xB a2xC a2yA a2yB a2yC a3xA a3xB
+a3xC a3yA a3yB a3yC a4xA a4xB a4xC a4yA a4yB a4yC b1xA b1xB b1xC b1yA
+ b1yB b1yC b2xA b2xB b2xC b2yA b2yB b2yC b3xA b3xB b3xC b3yA b3yB b3y
+C b4xA b4xB b4xC b4yA b4yB b4yC c1xA c1xB c1xC c1yA c1yB c1yC c2xA c2
+xB c2xC c2yA c2yB c2yC c3xA c3xB c3xC c3yA c3yB c3yC c4xA c4xB c4xC c
+4yA c4yB c4yC
 [reply] [d/l] 
Re: Generating all possible combinations from an AoA by Anonymous Monk on Apr 13, 2011 at 20:34 UTC 
Using foreach loops only:
my @results = ("");
foreach my $subarray (@array) {
my @tmp_results = ();
my @subarray = @{ $subarray };
foreach my $tmp_result (@results) {
foreach my $element (@subarray) {
my $string = $tmp_result . $element;
push @tmp_results, $string;
}
}
@results = @tmp_results;
}
print join "\n", @results;
print "\n";
The trick is in the overwritting of @results with @tmp_results at the end of the outer loop, as well as in initializing @results with a single empty list in order for concatenation to work further down.
This could probably be written with several map's, but it might become difficult to read.  [reply] [d/l] 

@results = ('');
foreach my $subarray (@array) {
@results = map {my $res = $_;
map $res.$_, @$subarray
} @results;
}
print join "\n", @results,'';
 [reply] [d/l] 

Best answer to this problem I've seen so far, where everybody replies with long solutions or black boxes. Short, no globs, no modules, clear and readable. Very good! :)
 [reply] 
Re: Generating all possible combinations from an AoA by raybies (Chaplain) on Apr 14, 2011 at 21:05 UTC 
Here's my uberinelegant serialized approach... If you don't care about the order that every combination is created: (btw, I renamed @array to be @arrays)...
my ($carry, @tallykeeper) = map 0, @arrays, 0; #gets rid of warnings..
+. w/strictures
while (!$carry) {
$carry = 1;
for my $dx (0 .. $#arrays ) {
print $arrays[$dx]>[$tallykeeper[$dx]];
$tallykeeper[$dx] += $carry;
if ($tallykeeper[$dx] < @{$arrays[$dx]}) {
$carry = 0;
}else{
$tallykeeper[$dx] = 0;
}
}
print "\n";
}
OR if you MUST have it in that order you could reverse the order of your array lists, or with my solution use this solution:
my ($carry, @tallykeeper) = map 0, @arrays, 0; #gets rid of warnings..
+.
while (!$carry) {
$carry = 1;
my $combostr = "";
for my $dx (reverse 0 .. $#arrays ) {
$combostr .= $arrays[$dx]>[$tallykeeper[$dx]];
$tallykeeper[$dx] += $carry;
if ($tallykeeper[$dx] < @{$arrays[$dx]}) {
$carry = 0;
}else{
$tallykeeper[$dx] = 0;
}
}
$combostr = reverse $combostr;
print "$combostr\n";
}
Okay mine are ultra lame... but it was fun to try to make a generic solution that worked for everything possible array of arrays...
Ray  [reply] [d/l] [select] 
Re: Generating all possible combinations from an AoA by raraya (Initiate) on Apr 14, 2011 at 22:10 UTC 
Approaching in a logical way, You can think this is a combinatory problem. You need to combine each index of each array with each other.
So if you have 3 arrays with 1, 2 and 3 elements you have 6 permutations of 3 elements each. In this case you need to generate 000, 001, 002, 010, 011 and 012.
To achieve this list you can iterate over total combinations incrementing the index of the array that hasnt reach its maximum order, and when it does you reset the index to "0" and increment the next (or previous depending the way you implement it) that hasnt reach it max everytime.
In code:
#!/usr/bin/perl w
use strict;
my @array = ([ "a", "b", "c", ],
[ "1", "2", "3", "4", ],
[ "x", "y", ],
[ "U", "V", "W", "X", "Y", "Z",],);
my (@current, @result); # In @current we store the array index to cons
+truct the string
my $comb = 1;
map($comb *= @{$_}, @array); # Get total permutations
for (my $num = 1; $num <= $comb; $num++)
{
my $string = '';
for (my $k = 0; $k <= $#array; $k++)
{
$current[$k] = 0 if !$current[$k];
$string .= ${$array[$k]}[$current[$k]];
}
if ($current[$#array] < $#{$array[$#array]})
{
$current[$#array]++;
}
else #If we reach max index we increment previous not maxed one
{
$current[$#array] = 0;
for (my $i = $#array1; $i > 1; $i)
{
# We exit the loop when we increment a not maxed index
$current[$i] < $#{$array[$i]} ? do {$current[$i]++; last} : do {
+$current[$i] = 0};
}
}
push(@result, $string);
}
print join(",", @result) . "\n";
The execution:
[raraya@tolkien perl]$ aoa.pl
a1xU,a1xV,a1xW,a1xX,a1xY,a1xZ,a1yU,a1yV,a1yW,a1yX,a1yY,a1yZ,a2xU,a2xV,
+a2xW,a2xX,a2xY,a2xZ,a2yU,a2yV,a2yW,a2yX,a2yY,a2yZ,a3xU,a3xV,a3xW,a3xX
+,a3xY,a3xZ,a3yU,a3yV,a3yW,a3yX,a3yY,a3yZ,a4xU,a4xV,a4xW,a4xX,a4xY,a4x
+Z,a4yU,a4yV,a4yW,a4yX,a4yY,a4yZ,b1xU,b1xV,b1xW,b1xX,b1xY,b1xZ,b1yU,b1
+yV,b1yW,b1yX,b1yY,b1yZ,b2xU,b2xV,b2xW,b2xX,b2xY,b2xZ,b2yU,b2yV,b2yW,b
+2yX,b2yY,b2yZ,b3xU,b3xV,b3xW,b3xX,b3xY,b3xZ,b3yU,b3yV,b3yW,b3yX,b3yY,
+b3yZ,b4xU,b4xV,b4xW,b4xX,b4xY,b4xZ,b4yU,b4yV,b4yW,b4yX,b4yY,b4yZ,c1xU
+,c1xV,c1xW,c1xX,c1xY,c1xZ,c1yU,c1yV,c1yW,c1yX,c1yY,c1yZ,c2xU,c2xV,c2x
+W,c2xX,c2xY,c2xZ,c2yU,c2yV,c2yW,c2yX,c2yY,c2yZ,c3xU,c3xV,c3xW,c3xX,c3
+xY,c3xZ,c3yU,c3yV,c3yW,c3yX,c3yY,c3yZ,c4xU,c4xV,c4xW,c4xX,c4xY,c4xZ,c
+4yU,c4yV,c4yW,c4yX,c4yY,c4yZ
Greetings Rod.  [reply] [d/l] [select] 

