Creating tuples based on sets

[waxmop]

I have a project that I'm not making good headway on. The end product has to be written in C, but I want to make a perl prototype first.

Here's the deal: I need to write a function that gets two arguments:

• A set, sort of like {A, B, C}
• an integer, that specifies the size of the tuples to create.

This function will return a reference to a 2-d array. Each row in the array will be a tuple. For example,

my @set = qw(A B C);
my $output = mk_tuples(@set, 2);

And $output would be a ref to a 2-d array that looks like this (each row is an array):

A A

A B

A C

B A

B B

B C

C A

C B

C C

The number of tuples to be created is equal to the number of elements in the set raised to the power of the size of the tuples. In this case, that turns out to be 3**2, or 9.

The stumbling block for me is how to create the tuples. I can hear a voice in my head that says recursion might be useful, but I'm just not seeing it right now. Any help would be appreciated.

[Thelonius]

#!perl -w
use strict;

my @set = qw(a b c);

my @tuples = mk_tuples(3, \@set);
for (@tuples) {
  print "(", join(", ", @$_), ")\n";
}
sub mk_tuples {
  my $n = shift;
  my $setr = shift;
  my $len = 0;
  my @result = ();
  my @hold = ();

  mk_tuples_r($n, $setr, \@hold, \@result);
  return @result;
}

sub mk_tuples_r {
  my ($n, $setr, $holdr, $resultr) = @_;
  my $len = 1 + @$holdr;
  for my $e (@$setr) {
    push @$holdr, $e;
    if ($len == $n) {
      push @$resultr, [ @$holdr ];
    } else {
      mk_tuples_r($n, $setr, $holdr, $resultr);
    }
    pop @$holdr;
  }
}

[waxmop]

Your response was the best combination of easy to understand and successful. I love this website.

[mojotoad]

Update: I missed the part about needing arbitrarily sized tuples. This only groups in sets of two...my bad. :(

Original message follows...

Ah, the joys of dot products. No need for recursion:

#!/usr/bin/perl -w

@set = qw(A B C);

print join("\n", map(join(',', @$_), @{&make_tuples(\@set, \@set)}));

sub make_tuples {
  my($set1, $set2) = @_;
  my @product;
  foreach my $x (0 .. $#$set1) {
    foreach my $y (0 .. $#$set2) {
      push(@product, [$set1->[$x], $set2->[$y]]);
    }
  }
  \@product;
}

I daresay I just answered a homework question for you, but so be it.

Matt

[waxmop]

At the end of the program, you just do

\@product;

Does this do the same thing as

return \@product;

???

[perlguy]

There is a definite possibility that I am missing something, but isn't waxmop asking for something that will solve for an arbitrary number of elements (in the solution), not just 2 necessarily?

[waxmop]

Yeah, I need the function to fit any of these situations:

my @set1 = qw(A B C D);
my @set2 = qw(X Y Z);
mk_tuples(@set1, 2);
mk_tuples(@set2, 5);

etc...

Here's a side question. How come this doesnt' work in perl?

mk_tuples(["A", "B"], 3);

I can't replace an array with just a list of elements.

[The Mad Hatter]

You'll have to have multiple foreach loops that go through each item in the set. For tuples of size 2, you'll need two. For tuples of size 3, you'll need three. You get the idea. You might be able to use Algorithm::Loops to help you with this.

[tye]

Exactly what I was thinking. (:

sub tuples {
    my( $count, @set )= @_;
    my @out;
    nestedLoops(
        [ ([0..$#set]) x $count ],
        { Code => sub { push @out, [@set[@_]] } }
    );
    return \@out;
}
my $tuples= tuples( 2, qw(A B C) );
for my $tuple (  @$tuples  ) {
    print "@$tuple\n";
}

or, if you want to take advantage of iterators:

sub tupleMaker {
    my( $count, @set )= @_;
    my $iter= nestedLoops( [ ([0..$#set]) x $count ] );
    return sub { @set[ $iter->() ] };
}
my $gen= tupleMaker( 2, qw(A B C) );
while(  my @tuple= $gen->()  ) {
    print "@tuple\n";
}

which means you can deal with tons of tuples without needing tons of RAM.
                - tye

[perlguy]

Here is my solution. This is not a great example, as I didn't have time to really think this out, but...

use strict;
my @set = qw(A B C);
mk_tuples(2, 0, \@set, []);  # put the number of tuples first
print join "\n", map join(' ', @$_), get_tuples();

{
   my @full_builds;
   sub mk_tuples {
      my ($depth, $previous_depth, $set, $built) = @_;
      push(@full_builds, $built) if $depth == $previous_depth;

      for my $current_depth ($previous_depth..$depth) {
         for (@$set) {
            mk_tuples($depth, $previous_depth+1, $set, [@$built, $_]);
         }
      }
   }

   sub get_tuples {
      die "none made\n" unless @full_builds;
      return @full_builds;
   }
}

Hope that helps.

Update: As you can see, mine requires 4 arguments: 1) the depth to stop at, 2) the depth we are at currently, 3) the full set of possibles to iterate over, and 4) the partial_builds to be passed recursively. I know this isn't exactly what you want... Sorry.

[adrianh]

One more variation ;-)

CPAN provides us with Set::CrossProduct, which allows us to write your mk_tuples like this:

use Set::CrossProduct;

sub mk_tuples(\@$) {
    my ($arrayref, $n) = @_;
    [ Set::CrossProduct->new( [($arrayref) x $n] )->combinations ];
};

my @set = qw(A B C); 
my $output = mk_tuples(@set, 2);

[shotgunefx]

You could use my code at Non- recursive permutation of arrays. like so.

my @elements = qw(a b c);
my $tupler = make_permutator(([@elements]) x 2 );
while (my @tuple = $tupler->() ){
    print @tuple,"\n";
}

If a ref return value is wanted, just change "return @els" to "return \@els" in the sub that make_permutator returns.

-Lee

"To be civilized is to deny one's nature."