Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Generating all possible combinations from an AoA

by Anonymous Monk
on Apr 13, 2011 at 08:40 UTC ( #899125=perlquestion: print w/ replies, xml ) Need Help??
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?

Comment on Generating all possible combinations from an AoA
Select or Download Code
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.
Re: Generating all possible combinations from an AoA
by GrandFather (Cardinal) on Apr 13, 2011 at 09:07 UTC
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
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.
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;

      I like this one best. A nice simple recursive function using map.

        Just don't use it on a problem of interesting size, as it requires the entire list to be in memory at once.

        - tye        

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

    Cheers Rolf

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

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");
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
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.

      Like this?
      @results = (''); foreach my $subarray (@array) { @results = map {my $res = $_; map $res.$_, @$subarray } @results; } print join "\n", @results,'';
        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! :-)
Re: Generating all possible combinations from an AoA
by raybies (Chaplain) on Apr 14, 2011 at 21:05 UTC
    Here's my uber-inelegant 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

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 = $#array-1; $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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://899125]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2014-10-02 11:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (54 votes), past polls