views:

249

answers:

4

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

How do I get:

["big", "red", "apple"]
["big", "red", "pear"]

..etc..

["small", "green", "banana"]

I understand this is called permutation. But I am not sure how to do it. Also I don't know how many arrays I can have. There may be three or four, so I don't want to do nested loop.

+4  A: 

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.

Vivin Paliath
thanks for your solution but I think Sinan's solution is easier. but thank you for explaining your solution
No worries! I like Sinan's solution too. Much less complicated!
Vivin Paliath
+10  A: 

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
Sinan Ünür
Oh my. I had *no* idea. That would have saved me a LOT of headache!
Vivin Paliath
thank you!!!! this helped me a lot.
Just a small note: Math::Cartesian::Product makes you walk the entire space immediately. That might be what you want. If you want to invert control, use Set::CrossProduct.
brian d foy
+3  A: 

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 ]
  } [[]], @_
}
hobbs
can you explain? this looks cool!
@nubie2 Basically it's the same as the solution that Vivin Paliath, only using a reduce instead of recursion. Start with a list of one 0-tuple (`[[]]`), and then for each arrayref in the input, append each item to each of the existing entries. If you know what `reduce` does, it's easy enough to trace out on paper. If you don't know what `reduce` does, learn! :)
hobbs
`s/solution that/solution posted by/`
hobbs
thanks for the explanation!!!
+3  A: 

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.

brian d foy