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
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 ]
} [[]], @_
}
[[]]), 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! :) –
Oversold s/solution that/solution posted by/ –
Oversold map [ $item, @$_ ] changes the order of the output to match how you'd generate a Cartesian product with a series of nested loops with the outermost loop controlling the leftmost output array element. This seems more natural to me. –
Apiculture 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.
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
Here is my solution that doesn't require any module and that can take as many sets as you want.
sub set_product {
my @array_of_aref = @_;
if (@array_of_aref == 0) {
return;
}
elsif (@array_of_aref == 1) {
return $array_of_aref[0];
}
elsif (@array_of_aref >= 2) {
my $array_a = shift @array_of_aref;
my $array_b = shift @array_of_aref;
my @array_c;
foreach my $a ($array_a->@*) {
foreach my $b ($array_b->@*) {
if (ref $a eq "" and ref $b eq "") {
push @array_c, [$a, $b];
}
elsif (ref $a eq "ARRAY" and ref $b eq "") {
push @array_c, [$a->@*, $b];
}
elsif (ref $a eq "" and ref $b eq "ARRAY") {
push @array_c, [$a, $b->@*];
}
elsif (ref $a eq "ARRAY" and ref $b eq "ARRAY") {
push @array_c, [$a->@*, $b->@*];
}
}
}
while (my $aref = shift @array_of_aref) {
@array_c = set_product(\@array_c, $aref);
}
return @array_c;
}
}
EXAMPLES :
print $_->@* foreach set_product(["a","b"]);
print $_->@* foreach set_product(["a","b"], [1,2,3]);
print $_->@* foreach set_product(["a","b"], [1,2,3], ["x","y"]);
print $_->@* foreach set_product(["a","b"], [1,2,3], ["x","y"], ["E","F"]);
© 2022 - 2024 — McMap. All rights reserved.
Math::Cartesian::Producton that duplicate though. – Sailesh