In Perl, how can I iterate over the Cartesian product of multiple sets?
Asked Answered
G

5

4

Given x number of arrays, each with a possibly different number of elements, how can I iterate through all combinations where I select one item from each array?

Example:

[   ]   [   ]   [   ]
 foo     cat      1
 bar     dog      2
 baz              3
                  4

Returns

[foo]   [cat]   [ 1 ]
[foo]   [cat]   [ 2 ]
  ...
[baz]   [dog]   [ 4 ]

I'm doing this in Perl, btw.

Gounod answered 10/8, 2009 at 17:6 Comment(2)
There's quite a lot on this topic on stackoverflow already; just search for "permutation". I didn't check if there was one for perl in particular.Glorianna
"permutation" is the wrong thing to search for since this isn't a permutation.Whitman
G
1

Recursive and more-fluent Perl examples (with commentary and documentation) for doing the Cartesian product can be found at http://www.perlmonks.org/?node_id=7366

Example:

sub cartesian {
    my @C = map { [ $_ ] } @{ shift @_ };

    foreach (@_) {
        my @A = @$_;

        @C = map { my $n = $_; map { [ $n, @$_ ] } @C } @A;
    }

    return @C;
}
Gounod answered 10/8, 2009 at 18:31 Comment(0)
W
21

My Set::CrossProduct module does exactly what you want. Note that you aren't really looking for permutations, which is the ordering of the elements in a set. You're looking for the cross product, which is the combinations of elements from different sets.

My module gives you an iterator, so you don't create it all in memory. You create a new tuple only when you need it.

use Set::Crossproduct;

my $iterator = Set::CrossProduct->new(
    [
        [qw( foo bar baz )],
        [qw( cat dog     )],
        [qw( 1 2 3 4     )],
    ]
    );

while( my $tuple = $iterator->get ) {
    say join ' ', $tuple->@*;
    }
Whitman answered 10/8, 2009 at 18:8 Comment(1)
+1 ... I had not seen your post when I cooked up my attempt at repeating the functionality of this module (I did not know it existed either).Buckthorn
B
2

A simple recursive solution for an arbitrary number of lists:

sub permute {
  my ($first_list, @remain) = @_;

  unless (defined($first_list)) {
    return []; # only possibility is the null set
  }

  my @accum;
  for my $elem (@$first_list) {
    push @accum, (map { [$elem, @$_] } permute(@remain));
  }

  return @accum;
}

A not-so-simple non-recursive solution for an arbitrary number of lists:

sub make_generator {
  my @lists = reverse @_;

  my @state = map { 0 } @lists;

  return sub {
    my $i = 0;

    return undef unless defined $state[0];

    while ($i < @lists) {
      $state[$i]++;
      last if $state[$i] < scalar @{$lists[$i]};
      $state[$i] = 0;
      $i++;
    }

    if ($i >= @state) {
      ## Sabotage things so we don't produce any more values
      $state[0] = undef;
      return undef;
    }

    my @out;
    for (0..$#state) {
      push @out, $lists[$_][$state[$_]];
    }

    return [reverse @out];
  };
}

my $gen = make_generator([qw/foo bar baz/], [qw/cat dog/], [1..4]);
while ($_ = $gen->()) {
  print join(", ", @$_), "\n";
}
Bellbird answered 10/8, 2009 at 17:11 Comment(4)
Note that there's some unnecessary allocation here - it can be optimized a bit further. But this general approach is what you want :)Bellbird
It's not really the approach that you want. Avoid recursion in Perl, and don't create the whole thing in memory.Whitman
Non-recursive variant added :)Bellbird
permute() has a bug. Every inner list contains an empty array ref at the end.Winstonwinstonn
G
1

Recursive and more-fluent Perl examples (with commentary and documentation) for doing the Cartesian product can be found at http://www.perlmonks.org/?node_id=7366

Example:

sub cartesian {
    my @C = map { [ $_ ] } @{ shift @_ };

    foreach (@_) {
        my @A = @$_;

        @C = map { my $n = $_; map { [ $n, @$_ ] } @C } @A;
    }

    return @C;
}
Gounod answered 10/8, 2009 at 18:31 Comment(0)
S
0

You can use nested loops.

for my $e1 (qw( foo bar baz )) {
for my $e2 (qw( cat dog )) {
for my $e3 (qw( 1 2 3 4 )) {
   my @choice = ($e1, $e2, $e3); 
   ...
}}}

When you need an arbitrary number of nested loops, you can use Algorithm::Loops's NestedLoops.

use Algorithm::Loops qw( NestedLoops );

my @lists = (
   [qw( foo bar baz )],
   [qw( cat dog )],
   [qw( 1 2 3 4 )],
);

my $iter = NestedLoops(\@lists);
while ( my @choice = $iter->() ) {
   ...
}
Schappe answered 26/7, 2018 at 20:55 Comment(0)
G
-1

There's one method I thought of first that uses a couple for loops and no recursion.

  1. find total number of permutations
  2. loop from 0 to total_permutations-1
  3. observe that, by taking the loop index modulus the number of elements in an array, you can get every permutations

Example:

Given A[3], B[2], C[3],

for (index = 0..totalpermutations) {
    print A[index % 3];
    print B[(index / 3) % 2];
    print C[(index / 6) % 3];
}

where of course a for loop can be substituted to loop over [A B C ...], and a small part can be memoized. Of course, recursion is neater, but this might be useful for languages in which recursion is severely limited by stack size.

Gounod answered 10/8, 2009 at 17:58 Comment(2)
I think it's the same as three nested loops, except with this approach you also spend time on doing the math in the process.Encephalogram
With a little work, this approach will work for any number of lists, which can't be said for nested for loops.Tzar

© 2022 - 2024 — McMap. All rights reserved.