In Perl, how can I get the Cartesian product of multiple sets?

Question

I want to do permutation in Perl. For example I have three arrays: [\"big\", \"tiny\", \"small\"] and then I have [\"red\", \"yellow\", \"green\"]

Answer 1

IF

• you don't want to include dependencies
• you have a small number of arrays
• your arrays are not really huge

then you can simply do this:

For two arrays @xs and @ys:

map{ my $x = $_; map { [$x, $_] } @ys } @xs

For three arrays @xs, @ys, @zs

map{ my $x = $_; map { my $y = $_; map { [$x, $y, $_] } @zs } @ys } @xs

Answer 2

You can use my Set::CrossProduct module if you like. You don't have to traverse the entire space since it gives you an iterator, so you're in control.

Answer 3

Now in twitter-form:

sub prod { reduce { [ map { my $i = $_; map [ @$_, $i ], @$a } @$b ] } [[]], @_ }

use strict;
use warnings;
use List::Util qw(reduce);

sub cartesian_product {
  reduce {
    [ map {
      my $item = $_;
      map [ @$_, $item ], @$a
    } @$b ]
  } [[]], @_
}

Answer 4

That's actually not permutation but Cartesian product. See Math::Cartesian::Product.

#!/usr/bin/perl

use strict; use warnings;

use Math::Cartesian::Product;

cartesian { print "@_\n" }
    ["big", "tiny", "small"],
    ["red", "yellow", "green"],
    ["apple", "pear", "banana"];

Output:

C:\Temp> uu
big red apple
big red pear
big red banana
big yellow apple
big yellow pear
big yellow banana
big green apple
big green pear
big green banana
tiny red apple
tiny red pear
tiny red banana
tiny yellow apple
tiny yellow pear
tiny yellow banana
tiny green apple
tiny green pear
tiny green banana
small red apple
small red pear
small red banana
small yellow apple
small yellow pear
small yellow banana
small green apple
small green pear
small green banana

Answer 5

I had to solve this exact problem a few years ago. I wasn't able to come up with my own solution, but instead ran across this wonderful piece of code which involves clever and judicious use of map along with recursion:

#!/usr/bin/perl

print "permute:\n";
print "[", join(", ", @$_), "]\n" for permute([1,2,3], [4,5,6], [7,8,9]);

sub permute {

    my $last = pop @_;

    unless(@_) {
           return map([$_], @$last);
    }

    return map { 
                 my $left = $_; 
                 map([@$left, $_], @$last)
               } 
               permute(@_);
}

Yes, this looks crazy, but allow me to explain! The function will recurse until @_ is empty, at which point it returns ([1], [2], [3]) (a list of three arrayrefs) to the previous level of recursion. At that level $last is a reference to an array that contains [4, 5, 6].

The body of the outer map is then run three times with $_ set to [1], then [2] and finally [3]. The inner map is then run over (4, 5, 6) for each iteration of the outer map and this returns ([1, 4], [1, 5], [1, 6]), ([2, 4], [2, 5], [2, 6]), and finally ([3, 4], [3, 5], [3, 6]).

The last but one recursive call then returns ([1, 4], [1, 5], [1, 6], [2, 4], [2, 5], [2, 6], [3, 4], [3, 5], [3, 6]).

Then, it runs that result against [7,8,9], which gives you [1, 4, 7], [1, 4, 8], [1, 4, 9], [1, 5, 7], [1, 5, 8], [1, 5, 9], [1, 6, 7], [1, 6, 8], [1, 6, 9], [2, 4, 7], [2, 4, 8], [2, 4, 9], [2, 5, 7], [2, 5, 8], [2, 5, 9], [2, 6, 7], [2, 6, 8], [2, 6, 9], [3, 4, 7], [3, 4, 8], [3, 4, 9], [3, 5, 7], [3, 5, 8], [3, 5, 9], [3, 6, 7], [3, 6, 8], [3, 6, 9]

I remember posting a question on perlmonks.org asking someone to explain this to me.

You can easily adapt this solution to your problem.