RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved generating combinations of numbers and expanding telephone keypad letters.

You are given two integers $m and $n. Write a script print all possible combinations of $n numbers from the list 1 2 3 … $m.

Every combination should be sorted i.e. [2,3] is valid combination but [3,2] is not.

Example: Input: $m = 5, $n = 2

Output: [ [1,2], [1,3], [1,4], [1,5], [2,3], [2,4], [2,5], [3,4], [3,5], [4,5] ]

Oh well, it was nice while it lasted. Back to the BFS-with-FIFO-buffer mine. On the other hand we can at least use the is_deeply structure comparator of Test::More.

use Test::More tests => 2;

is_deeply(combine(5,2),
          [ [1,2], [1,3], [1,4], [1,5], [2,3], [2,4], [2,5], [3,4], [3,5], [4,5] ],
          'expansion 5 2',
            );
is_deeply(combine(4,3),
          [ [1,2,3], [1,2,4], [1,3,4], [2,3,4] ],
          'expansion 4 3',
            );

sub combine {
  my ($m,$n)=@_;
  my @out;
  my @a;
  do {
    my $s=[];
    if (@a) {
      $s=shift @a;
    }

If there's a slot left open, fill it with each possible value. Otherwise, append the complete answer to the output buffer.

    if (scalar @{$s} < $n) {
      my $base=0;
      if (@{$s}) {
        $base=$s->[-1];
      }
      foreach my $k ($base+1..$m) {
        push @a,[@{$s},$k];
      }
    } else {
      push @out,$s;
    }
  } while @a;
  return \@out;
}

Can't be bothered to do this in Raku. Nor the next one.

You are given a digit string $S. Write a script to print all possible letter combinations that the given digit string could represent.

(This uses standard ITU E 1.161 lettering as found on most phone keypads.)

More BFS/FIFO. This is in fact nearly the same problem as in part one, except that we're meant to produce a list of strings rather than a list of lists of numbers. So we solve it the same way.

use Test::More tests => 1;

is_deeply(expand('35'),
          ["dj", "dk", "dl", "ej", "ek", "el", "fj", "fk", "fl"],
          'expansion 35',
            );

sub expand {
  my ($digits)=@_;
  my %table=(
    2 => [qw(a b c)],
    3 => [qw(d e f)],
    4 => [qw(g h i)],
    5 => [qw(j k l)],
    6 => [qw(m n o)],
    7 => [qw(p q r s)],
    8 => [qw(t u v)],
    9 => [qw(w x y z)],
      );

The problem doesn't specify, but I assume that characters without a letter-equivalent are ignored.

  my @d=grep {exists $table{$_}} split '',$digits;
  my @out;
  my @a;
  do {
    my $s=[];
    if (@a) {
      $s=shift @a;
    }
    my $l=scalar @{$s};
    if ($l <= $#d) {
      foreach my $dx (@{$table{$d[$l]}}) {
        push @a,[@{$s},$dx];
      }
    } else {
      push @out,join('',@{$s});
    }
  } while @a;
  return \@out;
}

It might have been a little more interesting if the results had had to be checked against a list of valid words, so that for example 7375 would produce only "perk" and "serk" (the Middle English ancestor of "sark") rather than all 144 possibilties.