laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a couple of days (March 29, 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: Rotate Matrix

Write a script to rotate the following matrix by given 90/180/270 degrees clockwise.

[ 1, 2, 3 ]
[ 4, 5, 6 ]
[ 7, 8, 9 ]

For example, if you rotate by 90 degrees then expected result should be like below:

[ 7, 4, 1 ]
[ 8, 5, 2 ]
[ 9, 6, 3 ]

This is fairly straight forward. We will write a subroutine to rotate a matrix by 90°, and then we just need to call that subroutine twice to rotate by 180°, and once more to rotate by 270°. We’ll also write a subroutine to display the matrices in a relatively compact graphical form.

Rotate Matrix in Perl

Nothing complicated, we just need to have a clear mind representation of the matrix structure and be a bit cautious when managing array indices. Note that, trying various syntaxes, I re-discovered that you can use $#{$input} or even, simpler, $#$input for getting the last index of the $input arrayref, and even $#{@$input[$row]} to get the last index of the row subarray in an array of arrays. Granted, this last example looks a bit like line noise, but it works fine.

use strict;
use warnings;
use feature "say";

sub display_matrix {
    my $matrix = shift;
    for my $row (@$matrix) {
        say "[", join(", ", @$row), "]";
    }
}

sub rotate_90 {
    my $input = shift;
    my @output;
    for my $row (0 .. $#$input) {
        for my $col (0 .. $#{@$input[$row]}) {
            $output[$col][$#{@$input[$row]} - $row] = $input->[$row][$col];
        }
    }
  return \@output;
}
sub rotate_180 {rotate_90 rotate_90 @_}
sub rotate_270 {rotate_90 rotate_180 @_}

my $matrix_ref = [
    [1, 2 ,3],
    [4, 5, 6],
    [7, 8, 9],
];
say "Initial matrix:";
display_matrix($matrix_ref);
say "\nMatrix rotated 90°";
display_matrix rotate_90 $matrix_ref;
say "\nMatrix rotated 180°";
display_matrix rotate_180 $matrix_ref;
say "\nMatrix rotated 270°";
display_matrix rotate_270 $matrix_ref;
say "\nRotate 360 (sanity check, should be the initial matrix)";
display_matrix rotate_270 rotate_90 $matrix_ref;

Running this program leads to the following output:

$ perl rotate_matrix.pl
Initial matrix:
[1, 2, 3]
[4, 5, 6]
[7, 8, 9]

Matrix rotated 90°
[7, 4, 1]
[8, 5, 2]
[9, 6, 3]

Matrix rotated 180°
[9, 8, 7]
[6, 5, 4]
[3, 2, 1]

Matrix rotated 270°
[3, 6, 9]
[2, 5, 8]
[1, 4, 7]

Rotate 360 (sanity check, should be the initial matrix)
[1, 2, 3]
[4, 5, 6]
[7, 8, 9]

There is probably a simpler way to do that using slices, but while this seems quite easy if you know in advance that you’re gonna get a 3 x 3 matrix, it appeared to me that this is not so simple for square matrices of unknown dimensions and even more so for non-square matrices.

Rotate Matrix in Raku

I’m pretty sure that there must be some Raku built-in operators or routines that could make the thing easier, but nothing obvious came to my mind. So I decided to be lazy and simply port the Perl solution:

use v6;

sub display_matrix (@matrix) {
    for @matrix -> $row {
        say "[", join(", ", $row), "]";
    }
}
sub rotate_90 (@input) {
    my @output;
    for 0 .. @input.end -> $row {
        for 0 .. @input[$row].end -> $col {
            @output[$col][@input[$row].end - $row] = @input[$row][$col];
        }
    }
  return @output;
}
sub rotate_180 (@matrix) {rotate_90 rotate_90 @matrix}
sub rotate_270 (@matrix) {rotate_90 rotate_180 @matrix}

my $matrix = (
    [1, 2 ,3],
    [4, 5, 6],
    [7, 8, 9],
);
say "Initial matrix:";
display_matrix($matrix);
say "\nMatrix rotated 90°";
display_matrix rotate_90 $matrix;
say "\nMatrix rotated 180°";
display_matrix rotate_180 $matrix;
say "\nMatrix rotated 270°";
display_matrix rotate_270 $matrix;
say "\nRotate 360 (sanity check, should be the initial matrix)";
display_matrix rotate_270 rotate_90 $matrix;

This program displays almost exactly the same as the equivalent Perl program:

$ perl6 rotate_matrix.p6
Initial matrix:
[1 2 3]
[4 5 6]
[7 8 9]

Matrix rotated 90°
[7 4 1]
[8 5 2]
[9 6 3]

Matrix rotated 180°
[9 8 7]
[6 5 4]
[3 2 1]

Matrix rotated 270°
[3 6 9]
[2 5 8]
[1 4 7]

Rotate 360 (sanity check, should be the initial matrix)
[1 2 3]
[4 5 6]
[7 8 9]

Task 2: Vowel Strings

Write a script to accept an integer 1 <= N <= 5 that would print all possible strings of size N formed by using only vowels (a, e, i, o, u).

The string should follow the following rules:

1. ‘a’ can only be followed by ‘e’ and ‘i’.
2. ‘e’ can only be followed by ‘i’.
3. ‘i’ can only be followed by ‘a’, ‘e’, ‘o’, and ‘u’.
4. ‘o’ can only be followed by ‘a’ and ‘u’.
5. ‘u’ can only be followed by ‘o’ and ‘e’.

For example, if the given integer N = 2 then script should print the following strings:

ae
ai
ei
ia
io
iu
ie
oa
ou
uo
ue

Although this is not explicitly stated, we will take it for granted that some letters may be repeated in the strings, provided they follow the rules. For example, since ‘u’ may be followed by ‘o’, and ‘o’ may be followed by ‘u’, strings such as “uou” or “ouo” are valid.

Vowel Strings in Perl

One good way to implement the rules (such as ‘a’ can only be followed by ‘e’ and ‘i’) is to build a hash of arrays (%successors) where the keys are the vowels, and the values arrays of vowels that can follow the vowel given in the key (so, for example: a => ['e', 'i']). For any letter that we insert into a string, the hash will give us the list of letters that we can insert next. To cover the tree of possibilities, the easiest is to built a recursive subroutine (make_str) that will print all the permitted combinations.

use strict;
use warnings;
use feature "say";

my %successors = (
    a => ['e', 'i'],
    e => ['i'],
    i => [qw /a e o u/],
    o => ['a', 'u'],
    u => ['e', 'o']
);
my @vowels = sort keys %successors;
my $error_msg = "Please pass a parameter between 1 and 5.";
my $str_size = shift or die $error_msg;
die $error_msg unless $str_size =~ /^[1-5]$/;

for my $start (@vowels) {
    make_str($str_size -1, $start, $start);
}

sub make_str {
    my ($left, $last, $string) = @_;
    say $string and return unless $left; # Stop the recursion
    for my $next (@{$successors{$last}}) {
        my $new_str = $string . $next;
        make_str($left -1, $next, $new_str);
    }
}

Here are some sample runs of this program:

$ perl vowel_strings.pl
Please pass a parameter between 1 and 5. at vowel_strings.pl line 14.

$ perl vowel_strings.pl 2
ae
ai
ei
ia
ie
io
iu
oa
ou
ue
uo

$ perl vowel_strings.pl 3
aei
aia
aie
aio
aiu
eia
eie
eio
eiu
iae
iai
iei
ioa
iou
iue
iuo
oae
oai
oue
ouo
uei
uoa
uou

Rather than building the allowed strings using the hash as above, we could build a list of all vowel combinations (e.g. using the glob built-in function) having the right size, and then filter out those not matching the succession rules. We won’t present here an implementation of this strategy (the code can be shorter, but this tends to be somewhat inefficient when the string size exceeds 2 or 3), but we will show one such implementation below in Raku.

Vowel Strings in Raku

Porting to Raku the Perl Program

To start with, we will use hash of arrays (%successors) where the keys are the vowels, and the values arrays of vowels that can follow the vowel given in the key, as in our Perl implementation. For any letter that we insert into a string, the hash will give us the list of letters that we can insert next. And we will also use a recursive subroutine (make_str) to generate the full tree of permitted combinations.

use v6;

my %successors = (
    'a' => ['e', 'i'],
    'e' => ['i'],
    'i' => [qw /a e o u/],
    'o' => ['a', 'u'],
    'u' => ['e', 'o']
);
my @vowels = sort %successors.keys;
sub MAIN (UInt $str_size where 1 <= * <= 5) {
    my $error_msg = "Please pass a parameter between 1 and 5.";
    die $error_msg unless $str_size ~~ /^<[1..5]>$/;
    for @vowels -> $start {
        make_str($str_size -1, $start, $start);
    }
}
sub make_str (UInt $left, Str $last, Str $string) {
    say $string and return unless $left;
    for |%successors{$last} -> $next {
        my $new_str = $string ~ $next;
        make_str($left -1, $next, $new_str);
    }
}

These are two sample runs:

$ perl6 vowel_strings.p6
Usage:
  vowel_strings.p6 <str_size>

$ perl6 vowel_strings.p6 3
aei
aia
aie
aio
aiu
eia
eie
eio
eiu
iae
iai
iei
ioa
iou
iue
iuo
oae
oai
ouo
ouo
uei
uoa
uou

Generating all Vowels Combinations and Keeping the Valid Strings

Given that Raku has the combinations and permutations built-in methods, it would seem interesting to use them to generate all the candidate strings and then to filter out those not matching the rules.

But this turned out to be a bit more difficult than expected. First, if we want to to get strings such as “aia,” neither of the built-in methods mentioned before can do that. We need to “multiply” the original list of vowels and that leads to a lot of permutations and/or combinations, and also to duplicate strings that will need to be removed. In the program below, we first generate all combinations of $size letters, then all permutations of these combinations, and use some regexes to remove strings with unwanted letter combinations. And we use a SetHash ($result) to remove duplicates:

sub MAIN (UInt $size where 1 <= * <= 5) {
    my @vowels = | qw/a e i o u / xx ($size - 1);
    my SetHash $result;
    for @vowels.combinations($size) -> $seq {
      for | $seq.permutations>>.join('') {
          next if /(\w) $0/;
          next if  /ao|au|ea|eo|eu|oe|oi|ua|ui/;
          $result{$_}++;
      }
    }
    .say for $result.keys.sort;
}

This program produces the same results as before, but is quite slow (about 3.5 second for strings of 4 letters, versus 0.35 second for the original Raku program). Obviously, this program does a large amount of unnecessary work. We can reduce this by removing part of the duplicates earlier on, with two calls to the unique method:

sub MAIN (UInt $size where 1 <= * <= 5) {
    my @vowels = | qw/a e i o u / xx ($size - 1);
    my SetHash $result;
    for @vowels.combinations($size).unique(:with(&[eqv])) -> $seq {
      for | $seq.permutations>>.join('').unique {
          next if /(\w) $0/;
          next if  /ao|au|ea|eo|eu|oe|oi|ua|ui/;
          $result{$_}++;
      }
    }
    .say for $result.keys.sort;
}

For strings of 4 letters, the execution time is now a bit less that 2 seconds. We could further improve performance by fine tuning the number of times the original vowel alphabet is duplicated. For example, using only twice the original alphabet for strings of 4 letters (instead of 3 times as in the above program), the execution time is reduced to 0.8 second. Still significantly longer than the original Raku program.

Wrapping up

The next week Perl Weekly Challenge is due to 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, April 5, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.