sub permute{
  my ($prefix,$c,@arrays)=@_;
  my @ret=();
  foreach(@$c){
    my $f=$prefix.$_;
    if(scalar(@arrays)==0){
      push @ret,$f;
    }else{
      push @ret,@{permute($f,@arrays)};
    }
  }
  return \@ret;
}

my $perms=permute('',['C','A','T'],['D','O','G'],['B','I','R',D']);
[download]

You mean Permutations and combinations?

foreach $l1 (@one) {
  foreach $l2 (@two) {
    foreach $l3 (@three) {
      $permutation = $l1 . $l2 . $l3;
      # Do whatever
    }
  }
}
[download]

Does this help?

=Blue
...you might be eaten by a grue...

Hmmm.. not really the way I would want to do it if at all possible. But, I could try to make that way work. I think I may have been overthinking this :)

Cheers,
KM

#!/usr/bin/perl -w

use strict;

my @one = qw{C A T};
my @two = qw{D O G};
my @three = qw{B I R D};

my @combos = permute(\@one, \@two, \@three);
show_text(\@combos, \@one, \@two, \@three);

sub permute {
    my @arrays = @_;
    my @lengths;
    foreach my $array_ref (@arrays) {
        push @lengths, scalar @$array_ref;
    }
    return combine(@lengths);
}

sub combine {
    my $length = shift;
    my @results;
    for (0 .. ($length - 1)) {
        if (@_) {
            foreach my $result (combine(@_)) {
                push @results, $_ . $result;
            }
        } else {
            push @results, $_;
        }
    }
    return @results;
}

sub show_text {
    my ($combos, @arrays) = @_;
    foreach my $combo (@$combos) {
        my $i = 0;
        my $text = '';
        foreach my $elem (split'', $combo) {
            $text .= $arrays[$i++]->[$elem];
        }
        print "$text\n";
    }
}
[download]

I took the way chromatic was doing it, and changes little bits and modularized it. At some point, I may actually make this more useful and subclass it for phone number formats other than here in the US. Anyways, this is a quick hack.

I wanted to do this becuase, as some of you know, I recently moved. This means I need to remember a host of new phone numbers, which I am not particularly good at. So, instead of memorizing my new home number, work number, the number of family, friends and cow-orkers, it is useful to (try to) make words out of phone numbers. For example, my old phone number was: xxx-7342. The 7342 spells SEGA, which was easy for me and others to remember. I wanted to do this again.

The following module will accept a 7 digit phone number, and find all the possible letter combinations for those numbers. Then, it uses Text::Ispell to see what combinations are words in my dictionary. It can try the first 3 numbers, last 4 numbers, and all 7. Again, this is a quick hack, but it was fun, and I can now easily remember my new home number :) Perl to the rescue!

package PhoneToWord;

use Exporter;
@ISA    = qw( Exporter );
@EXPORT = qw( );

use strict;
use Text::Ispell qw(spellcheck);

sub new {
        my ($class,$num) = @_;
        $class = ref($class) || $class;
        my $self = {};
        bless $self, $class;
        my @numbers = ([qw(0)], # No letters for 0
                [qw(1)], # ditto
                [qw(A B C)],
                [qw(D E F)],
                [qw(G H I)],
                [qw(J K L)],
                [qw(M N O)],
                [qw(P Q R S)],
                [qw(T U V)],
                [qw(W X Y Z)]
              );      

        $num =~ s/[- ]//g;
        my @nums = split //, $num;  

        $self->{THREE} = [$numbers[$nums[0]], $numbers[$nums[1]], 
                                         $numbers[$nums[2]]];
        $self->{FOUR} = [$numbers[$nums[3]], $numbers[$nums[4]], 
                                         $numbers[$nums[5]], $numbers[
+$nums[6]]];
        $self->{SEVEN} = [$self->{THREE}, $self->{FOUR}];

        return $self;
}

sub first_three {
        my $self = shift;
        my @combos = $self->permute(@{$self->{THREE}});
        my @retval = $self->get_words(\@combos, @{$self->{THREE}});
        return wantarray ? @retval : \@retval;
}

sub last_four {
        my $self = shift;
        my @combos = $self->permute(@{$self->{FOUR}});
        my @retval = $self->get_words(\@combos, @{$self->{FOUR}});
        return wantarray ? @retval : \@retval;
}

sub seven {
        my $self = shift;
        my @combos = $self->permute(@{$self->{SEVEN}});
        my @retval = $self->get_words(\@combos, @{$self->{SEVEN}});
        return wantarray ? @retval : \@retval;
}

sub get_words {
        my $self = shift;
        my $combos = shift;
        my @uses = @_;
        my @ret;
        my @words = join " ", $self->show_text($combos, @uses);
        # spellcheck was spewing out crap I didn't want so
        # the eval shuts it up.
        eval {
                for my $word (spellcheck(@words)) {
                        if ($word->{type} =~ /(?:ok|compound)/) {
                                push @ret, $word->{term};
                        }
                }
        };
        return @ret;
}

sub permute {
        my $self = shift;
        my @arrays = @_;
    my @lengths;
    for my $array_ref (@arrays) {
        push @lengths, scalar @$array_ref;
    }
        return $self->combine(@lengths);
}

sub combine {
        my $self = shift;
        my $length = shift;
    my @results;
    for (0 .. ($length - 1)) {
        if (@_) {
                foreach my $result ($self->combine(@_)) {
                push @results, $_ . $result;
            }
        } else {
            push @results, $_;
        }
    }
    return @results;
}

sub show_text {
        my ($self, $combos, @arrays) = @_;
        my @all;
        foreach my $combo (@$combos) {
                my $i = 0;
                my $text;
                for my $elem (split'', $combo) {
                        $text .= $arrays[$i++]->[$elem];
                }
                push @all, $text;
        }
        return @all;
}

1;
[download]

And a quick example:

#!/usr/bin/perl -w

use strict;
use PhoneToWord;

my $foo = new PhoneToWord qw(663-7375);

my @three = $foo->first_three();
my $four = $foo->last_four(); 
my @all = $foo->seven();

print join "\n", @three;
print "\n";
print join "\n", @$four;
print "\n";
print join "\n", @all;

# Output (with my dictionary, of course)
MOD
MOE
NOD
ONE
PERL

So, I had no seven letter words, 4 three letter ones, and one 4 letter
+ one.
So, this phone number (not mine, so don't call it :) can be ONE-PERL.
[download]

Remember, this is a quick hack.. if I decide to make it more intuitive, I will repost at a later date.

Cheers,
KM

I see no reason to resort to recursion:

#!/usr/bin/perl -w
use strict;
my @letter= map { [ split // ] } qw( CAT DOG BIRD );
my @idx= (0) x @letter;
while( 1 ) {
    print join( "", map { $letter[$_][$idx[$_]] } 0..$#letter ), "\n";
    my $i= 0;
    while(  $i < @letter  &&  $#{$letter[$i]} < ++$idx[$i]  ) {
        $idx[$i++]= 0;
    }
    last   if  @letter <= $i;
}
[download]

Might the CPAN modules List::Permutor or Algorithm::Permute be useful? (The latter even uses the interface of the former!)