laurent_r

These are some answers to the Week 67 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a couple of days (July 5, 2020). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Number Combinations

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] ]

Note that I don’t consider the formatting of the displayed output above to be part of the task.

Number Combinations in Raku

Raku has a built-in combinations method making the task really very simple. For example:

use v6;
my $m = 5;
my $n = 2;

.say for 1..$m.combinations: $n;

This duly prints the same list as the output specified in the task:

(1 2)
(1 3)
(1 4)
(1 5)
(2 3)
(2 4)
(2 5)
(3 4)
(3 5)
(4 5)

It could be argued that the input values are hardcoded in the program and that it would better to pass them to the program. True, but implementing a MAIN subroutine to deal with paramleters passed to the program is so simple that it is left as an exercize to the reader (although an example is provided in one of the one-liners below).

The code is so simple that it can easily be converted to a Raku one-liner:

~ raku -e '.say for (1..5).combinations(2)'
(1 2)
(1 3)
(1 4)
(1 5)
(2 3)
(2 4)
(2 5)
(3 4)
(3 5)
(4 5)

Here again, the input values are hardcoded in the one-liner script, and, to me, it is perfectly OK in a one-liner, as it is very easy to launch the one-liner again with modified values, but if you really want to pass the input values as parameters to the script, here is one way to do it:

~ raku -e 'sub MAIN {.say for (1..$^a).combinations: $^b}' 5 2
(1 2)
(1 3)
(1 4)
(1 5)
(2 3)
(2 4)
(2 5)
(3 4)
(3 5)
(4 5)

Note that this script is using the ^ twigil to create self-declared formal positional parameters to the MAIN subroutine. Variables of the form $^a are a type of placeholder variable.

Number Combinations in Perl

Perl does not have a built-in combinations function, but there are several modules (for example Math::Combinatorics) providing the functionality. However, this being a coding challenge, I don’t want to use a third-party ready-made solution and prefer to show a way to do it yourself.

If we knew in advance how many items we want in each combination, nested loops might be the best solution. But if we want to be flexible about the number of items in each combination, then it is often simpler to use a recursive approach. Here, the combinations subroutine is recursive and is called once for every item wanted in the combination.

use strict;
use warnings;
use feature qw /say/;

my $m = shift // 5;
my $num = shift // 2;
combinations([], 1..$m);

sub combinations {
    my ($out, @in) = @_;
    return unless @in;
    for my $digit (@in) {
        next if defined $out->[-1] and $digit <= $out->[-1];
        my $new_out = [ @$out, $digit ];
        say "@$new_out" and next if scalar @$new_out == $num;
        combinations($new_out, @in[1..$#in]);
    }
}

These are three sample runs:

$ perl combinations.pl
1 2
1 3
1 4
1 5
2 3
2 4
2 5
3 4
3 5
4 5

$ perl combinations.pl 6 3
1 2 3
1 2 4
1 2 5
1 2 6
1 3 4
1 3 5
1 3 6
1 4 5
1 4 6
1 5 6
2 3 4
2 3 5
2 3 6
2 4 5
2 4 6
2 5 6
3 4 5
3 4 6
3 5 6
4 5 6

$ perl combinations.pl 5 4
1 2 3 4
1 2 3 5
1 2 4 5
1 3 4 5
2 3 4 5

Task 2: Letter Phone

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

Example:

​ Input: $S = ‘35’

​ Output: [“dj”, “dk”, “dl”, “ej”, “ek”, “el”, “fj”, “fk”, “fl”].

The first thing to notice in the above keyboard is that there is no letter or other character corresponding to the 0 key. I decided to assign a dash (-) to it, to avoid problems if the input numeric string contains a zero.

Letter Phone in Raku

I used a hash of arrays to store the letters or characters associated with digits, but, given that the digits are integers between 0 and 9, we could have used an array of arrays as well.

My first attempt was to use a recursive subroutine (take-one) to solve the problem:

use v6;

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 => <A Q R S>, 8 => <T U V>, 9 => <W X Y Z>;

my $str = @*ARGS[0] // "35";
take-one("", $str.comb);
say "";

sub take-one (Str $str, @digits is copy) {
    if @digits.elems == 0 {
        print "$str ";
        return;
    }
    my $digit = shift @digits;
    for %nums{$digit}.Seq -> $letter {
        my $new-str = $str ~ $letter;
        take-one($new-str, @digits)
    }
}

This yields the right result:

raku letter-phone.raku
DJ DK DL EJ EK EL FJ FK FL

But even before I completed the above script, I realized that this was overkill as it can be done in a much simpler way (I nonetheless completed the above recursive program for the purpose of illustration).

Raku has the X cross operator that can generate a cross product of two (or more) arrays, as shown here under the REPL:

> say <a b c> X <1 2 3>
((a 1) (a 2) (a 3) (b 1) (b 2) (b 3) (c 1) (c 2) (c 3))

It can also be used as a meta-operator together with another operator. For example, with the string concatenation operator, we generate a list of strings:

> say <a b c> X~ <1 2 3>
(a1 a2 a3 b1 b2 b3 c1 c2 c3)

Finally, using this together with the [] reduction meta-operator, we solve the problem in just one line of actual code:

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 => <A Q R S>, 8 => <T U V>, 9 => <W X Y Z>;

my $str = @*ARGS[0] // 35;
say [X~] %nums{$str.comb};

These are three example runs:

$ raku letter-phone2.raku
(DJ DK DL EJ EK EL FJ FK FL)

$ raku letter-phone2.raku 325
(DAJ DAK DAL DBJ DBK DBL DCJ DCK DCL EAJ EAK EAL EBJ EBK EBL ECJ ECK ECL FAJ FAK FAL FBJ FBK FBL FCJ FCK FCL)

$ raku letter-phone2.raku 305
(D-J D-K D-L E-J E-K E-L F-J F-K F-L)

Letter Phone in Perl

This is a port to Perl of the initial recursive approach in Raku:

use strict;
use warnings;
use feature qw /say/;

my %nums = (0 => ['-'], 1 => ['_', ',', '@'], 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 <A Q R S>], 
           8 => [qw <T U V>], 9 => [qw <W X Y Z>]);

my $str = shift // "35";
take_one("", split //, $str);
say "";

sub take_one {
    my ($str, @digits) = @_;
    if (@digits == 0) {
        print "$str ";
        return;
    }
    my $digit = shift @digits;
    for my $letter (@{$nums{$digit}}) {
        my $new_str = $str . $letter;
        take_one($new_str, @digits)
    }
}

These are some example outputs:

$ perl letter-phone.pl
DJ DK DL EJ EK EL FJ FK FL

$ perl letter-phone.pl 42
GA GB GC HA HB HC IA IB IC

$ perl letter-phone.pl 453
GJD GJE GJF GKD GKE GKF GLD GLE GLF HJD HJE HJF HKD HKE HKF HLD HLE HLF IJD IJE IJF IKD IKE IKF ILD ILE ILF

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, July 5, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.