Re^3: Cartesian Cross-Products

[Anonymous Monk]

"The Perl Way"

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

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

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

    return @C;
}

[saenns]

Hi, Perl n00b here. Check out my recursive solution for any number of sets. Feel the scheme.

sub cartesian {
    my @sets = @_;
    # base case
    if (@sets == 0) {
        return ([]);
    }
    my @first = @{@sets[0]};
    # recursive call
    shift @sets;
    my @rest = cartesian(@sets);
    my @result = ();
    foreach my $element (@first) { 
        foreach my $product (@rest) { 
            my @newSet = @{$product};
            unshift (@newSet, $element);
            push (@result, \@newSet);
        }
    }
    return @result;
}

[psini]

Update: Sorry, deleted rerroneous post

[drt]

I had the same thought also (to use a recursive algorithm), but your code didn't seem complete or it didn't work the way I expected. There are certainly more Perlish ways to code this with map etc., but it works. Cartesian product of multiple lists using recursion.

use Data::Dumper;

my $letters = [qw(a b c)];
my $numbers = [1..3];
my $words   = [qw(you me)];

my $result = cartesian($letters, $numbers, $words);

print Dumper( $result );

sub cartesian {
  my ($set, @sets) = @_;

  my @expanded;

  # base case
  if ( !@sets ) {
    foreach ( @{$set} ){
      push @expanded, [$_];
    }
  }

  # recursive call
  else {
    my @product = @{ cartesian(@sets) };
    foreach my $element ( @{$set} ) {
      foreach my $product ( @product ) {
        push @expanded, [ $element, @{$product} ];
      }
    }
  }

  return \@expanded;
}

[Anonymous Monk]

That

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

Can be simplified to:

  my @C = [];

Don't believe me? Try it. Also, it now works correctly in the case you pass no arguments to the function. This may be a matter of taste, but I prefer the leftmost array to be the outermost loop. So that leaves us with:

sub cartesian {
    my @C = [];

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

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

    return @C;
}