Words for phone number

Question

I would like to write an simple perl script to generate all possible words for given phone number.

I started with definition of an array:

my @nums = (
    ['0'],
    ['1'],
    ['2', 'a', 'b', 'c'],
    ['3', 'd', 'e', 'f'],
    ['4', 'g', 'h', 'i'],
    ['5', 'j', 'k', 'l'],
    ['6', 'm', 'n', 'o'],
    ['7', 'p', 'q', 'r', 's'],
    ['8', 't', 'u', 'v'],
    ['9', 'w', 'x', 'y', 'z']
);

The final script should generate following output:

$ num2word 12
12
1a
1b
1c

$ num2word 213
213
21d
21e
21f
a13
a1d
a1e
a1f
b13
b1d
b1e
b1f
c13
c1d
c1e
c1f

I am looking for any module which can do most part of the job (something like List::Permutor which does not seem to qualify for this task).

Any hints? Thanks!

Answer 1

Our very own @brian d foy has solved this problem with his Set::CrossProduct module.

use Set::CrossProduct;
my $iterator = Set::CrossProduct->new(
    [ [ qw(8 t u v) ], [ qw(0) ], [ qw(7 p q r s) ] ] );
print "@$_\n" for $iterator->combinations;

Output:

8 0 7
8 0 p
8 0 q
8 0 r
8 0 s
t 0 7
t 0 p
t 0 q
t 0 r
t 0 s
u 0 7
u 0 p
u 0 q
u 0 r
u 0 s
v 0 7
v 0 p
v 0 q
v 0 r
v 0 s

Answer 2

This does what you ask.

use strict;
use warnings;

my @nums = (
    [ qw/ 0 / ],
    [ qw/ 1 / ],
    [ qw /2 a b c / ],
    [ qw /3 d e f / ],
    [ qw /4 g h i / ],
    [ qw /5 j k l / ],
    [ qw /6 m n o / ],
    [ qw /7 p q r s / ],
    [ qw /8 t u v / ],
    [ qw /9 w x y z / ],
);

list_matching('12');
list_matching('213');

sub list_matching {

  my ($num) = @_;
  my @num = $num =~ /\d/g;
  my @map = (0) x @num;

  do {
    print join('', map { $nums[$num[$_]][$map[$_]] } 0 .. $#num), "\n";
    my $i = $#map;
    while ($i >= 0) {
      last if ++$map[$i] < @{ $nums[$num[$i]] };
      $map[$i--] = 0;
    }
  } while grep $_, @map; 
}

output

12
1a
1b
1c
213
21d
21e
21f
a13
a1d
a1e
a1f
b13
b1d
b1e
b1f
c13
c1d
c1e
c1f

Answer 3

See the functions in Algorithm::Combinatorics.

Answer 4

Actually, does work, too early for me...

use autodie;
use strict;
use warnings;

my @nums = (
    ['0'],
    ['1'],
    ['2', 'a', 'b', 'c'],
    ['3', 'd', 'e', 'f'],
    ['4', 'g', 'h', 'i'],
    ['5', 'j', 'k', 'l'],
    ['6', 'm', 'n', 'o'],
    ['7', 'p', 'q', 'r', 's'],
    ['8', 't', 'u', 'v'],
    ['9', 'w', 'x', 'y', 'z']
);

my $input = shift || die "Need a number!\n";
die "Input not numeric!\n" unless $input =~ m/^\d+$/;

my @digits = split //, $input;
my @rows;
push @rows, $nums[$_] for @digits;

print_row(0,'');

exit;

sub print_row {
    my $i    = shift;
    my $word = shift;

    my $row = $rows[$i];

    for my $j (0..$#{$row}) {
        my $word2 = $word . $row->[$j];
        if ($i < $#rows) {
            print_row($i+1, $word2);
        }
        else {
            print "$word2\n";
        }
    }
}

Answer 5

No modules required:

my @nums = (
    ['0'],
    ['1'],
    ['2', 'a', 'b', 'c'],
    ['3', 'd', 'e', 'f'],
    ['4', 'g', 'h', 'i'],
    ['5', 'j', 'k', 'l'],
    ['6', 'm', 'n', 'o'],
    ['7', 'p', 'q', 'r', 's'],
    ['8', 't', 'u', 'v'],
    ['9', 'w', 'x', 'y', 'z']
);

print "$_\n" while glob join '', map sprintf('{%s}', join ',', @{$nums[$_]}), split //, $ARGV[0]

Answer 6

use strict;
use warnings;
my @nums = (
    ['0'], ['1'], ['2', 'a', 'b', 'c'],
    ['3', 'd', 'e', 'f'], ['4', 'g', 'h', 'i'],
    ['5', 'j', 'k', 'l'], ['6', 'm', 'n', 'o'],
    ['7', 'p', 'q', 'r', 's'],  ['8', 't', 'u', 'v'],
    ['9', 'w', 'x', 'y', 'z']);

num2word(12);
num2word(213);

sub num2word {
    my ($i, $n, $t) = ($_[0]=~/(.)(.*)/, $_[1]);
    for (@{$nums[$i]}) {
        print "$t$_\n" and next if !length($n);
        num2word($n, defined $t ? $t.$_ : $_);
    }   
}

Answer 7

A basic recursive solution:

#!/usr/bin/perl

use strict;
use warnings;

my $phone_number = $ARGV[0] or die "No phone number";

my @nums = (
    ['0'],
    ['1'],
    [ '2', 'a', 'b', 'c' ],
    [ '3', 'd', 'e', 'f' ],
    [ '4', 'g', 'h', 'i' ],
    [ '5', 'j', 'k', 'l' ],
    [ '6', 'm', 'n', 'o' ],
    [ '7', 'p', 'q', 'r', 's' ],
    [ '8', 't', 'u', 'v' ],
    [ '9', 'w', 'x', 'y', 'z' ]
);

my %letters = map { shift @{$_} => $_ } @nums;

my @permutations;

sub recurse {
    my $str = shift;
    my $done = shift || '';

    unless ($str) {
        push @permutations, $done;
        return;
    }

    my $next = substr( $str, 0, 1 );
    $str = substr( $str, 1 );

    recurse( $str, $done . $next );

    if ( my @chars = @{ $letters{$next} } ) {

        recurse( $str, $done . $_ ) foreach @chars;

    }
}

recurse($phone_number);

print "$_\n" foreach @permutations;

and:

perl num2word 12
12
1a
1b
1c

perl num2word 213
213
21d
21e
21f
a13
a1d
a1e
a1f
b13
b1d
b1e
b1f
c13
c1d
c1e
c1f