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!

You might find [this question](http://stackoverflow.com/q/635768/725418) beneficial. The answer given is that it is in perlfaq: http://learn.perl.org/faq/perlfaq4.html#How-do-I-permute-N-elements-of-a-list- — TLP, Jun 17 '13 at 12:01

score 4 · Accepted Answer · answered Jun 17 '13 at 15:03

4

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

answered Jun 17 '13 at 15:03

mob

117,087
18
149
283

I really appreciate all the answers. I even did not expect as much support. Thanks everyone! :) This answer is most suitable in terms of the form of the question as it points out the exact perl module which solves this problem and that is exactly what the question was about. – Mike Jun 18 '13 at 10:52

score 3 · Answer 2 · answered Jun 17 '13 at 13:21

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

It's quite hard to follow this code - for example the names of variables `@nums`, `@num` and `$num`! — plusplus, Jun 18 '13 at 13:19

score 1 · Answer 3 · answered Jun 17 '13 at 12:00

1

See the functions in Algorithm::Combinatorics.

answered Jun 17 '13 at 12:00

daxim

39,270
4
65
132

This might be a good idea but the thing is I really can not find any way to make use of any of those functions to solve this problem. What this problem is about is actually neither permutation nor variation nor any of such. – Mike Jun 17 '13 at 12:13

Bill Ruppert · Answer 4 · 2013-06-17T14:23:27.373

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";
        }
    }
}

score 0 · Answer 5 · answered Jun 17 '13 at 15:10

0

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]

answered Jun 17 '13 at 15:10

ysth

96,171
6
121
214

2

[The glob trick should always be accompanied by the various caveats for when it fails.](http://stackoverflow.com/questions/10299961/in-perl-how-can-i-generate-all-possible-combinations-of-a-list#comment-13255473) – daxim Jun 17 '13 at 15:39
No modules, that is, except `File::Glob` which doesn't require a `use` statement. – Borodin Jun 17 '13 at 16:05
meh; the caveats don't apply in this case – ysth Jun 17 '13 at 16:50

perreal · Answer 6 · 2013-06-18T21:35:25.783

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.$_ : $_);
    }   
}

plusplus · Answer 7 · 2013-06-17T14:04:48.223

-1

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

edited Jun 17 '13 at 14:04

answered Jun 17 '13 at 13:21

plusplus

1,992
15
22

yes, and it works. Just edited it to include the originals number as well as the letters, but otherwise it did what was asked for - what's the problem? – plusplus Jun 17 '13 at 13:59
... you mean you've fixed it? – Borodin Jun 17 '13 at 16:10
it was pretty close, I'd only missed including the original digits in the output (which wasn't particularly clear in the text of the question). the downvote was a little harsh I think – plusplus Jun 18 '13 at 13:16

Words for phone number

7 Answers7