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.
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
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.
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.
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 ] } [[]], @_ } IF
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