laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few hours . 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: Minimum Sum Path

Given an m × n matrix with non-negative integers, write a script to find a path from top left to bottom right which minimizes the sum of all numbers along its path. You can only move either down or right at any point in time.

Example

Input:

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

The minimum sum path looks like this:

1→2→3
    ↓
    6
    ↓
    9

Thus, your script could output: 21 ( 1 → 2 → 3 → 6 → 9 )

Minimum Sum Path in Raku

Whenever I have to explore multiple paths in a tree or some other data structure, I tend to use a recursive approach. Here, the recursive traverse-mat subroutine tries every possible path in the matrix, compares the path cost with a global $min variable, and keeps track of the best solution so far. One of the small difficulties is how to initialize the $min variable. You could start with a very large value, but cannot be sure it will really be large enough if you don’t know your input data. In my first solution, I initialized it to the sum of all values in the matrix:

my $min = 0;
$min += [+] $_ for @mat;

This is relatively cheap compared to the exploration of the tree of all possible paths (especially for large matrices).

Then I thought that Raku has the Inf or ∞ infinity value, which should be large enough compared to any defined non-negative integer.

use v6;

my @mat = (<7 8 9>, <1 2 3>,  <4 5 6>, );
# say @mat;
my @best-path;
my $min = Inf;
my @empty-path;

traverse-mat(0, 0, 0, @empty-path);

sub traverse-mat (UInt $i, UInt $j, UInt $sum, @path is copy) {
    my $new-sum = $sum + @mat[$i][$j];
    return if $new-sum > $min;
    push @path, @mat[$i][$j];
    if @mat[$i][$j+1].defined {
        traverse-mat($i, $j+1, $new-sum, @path);
    } 
    if @mat[$i+1][$j].defined {
        traverse-mat($i+1, $j, $new-sum, @path);
    } 
    unless (@mat[$i][$j+1].defined or @mat[$i+1][$j].defined) {
        @best-path = @path;
        $min = $new-sum;
    }
}
say $min, " (", join(' → ', @best-path), ")";

This program displays the following output:

$ perl6 best-path.p6
19 (7 → 1 → 2 → 3 → 6)

Minimum Sum Path in Perl

For initializing the $min variable, we don’t have an infinity value available in Perl, so I implemented a loop to initialize it to the sum of all values in the matrix. Other than that, this program is a simple port to Perl of the Raku program:

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

my @mat = ([qw<7 8 9>], [qw<1 2 3>],  [qw<4 5 6>] );
my @best_path;
my $min = 0;
for my $row (@mat) {
    $min += $_ for @$row;
}
my @empty_path;

traverse_mat(0, 0, 0, ());

sub traverse_mat {
    my ($i, $j, $sum, @path) = @_;
    my $new_sum = $sum + $mat[$i][$j];
    return if $new_sum > $min;
    my @new_path = (@path, $mat[$i][$j]);
    if (defined $mat[$i][$j+1]) {
        traverse_mat($i, $j+1, $new_sum, @new_path);
    } 
    if (defined $mat[$i+1][$j]) {
        traverse_mat($i+1, $j, $new_sum, @new_path);
    } 
    unless (defined $mat[$i][$j+1] or defined $mat[$i+1][$j]) {
        @best_path = @new_path;
        $min = $new_sum;
    }
}
say $min, " (", join(' → ', @best_path), ")";

This program displays essentially the same output as the Raku program:

$ perl best-path.pl
19 (7 → 1 → 2 → 3 → 6)

Task 2: Word Break

You are given a string $S and an array of words @W.

Write a script to find out if $S can be split into sequence of one or more words as in the given @W.

Print the all the words if found otherwise print 0.

Example 1:

*Input:*

$S = "perlweeklychallenge"
@W = ("weekly", "challenge", "perl")

Output:

"perl", "weekly", "challenge"

Example 2:

Input:

$S = "perlandraku"
@W = ("python", "ruby", "haskell")

Output:

0 as none matching word found.

Word Break in Raku

I was hoping to dynamically construct a regex from the word list, something like `rx/weekly | challenge | week/’, but I wasn’t able to find the syntax that would work properly.

So, I decided to simply loop on the array of words and use the index built-in function. Although the task specification did not request it explicitly, the example provided had the output words in the order of the original string. To obtain such an output, I stored the matches as keys in a hash, with the position of the match as values.

use v6;

my $string = "perlweeklychallenge";
my @words = <weekly challenge week perl>;
my %location;
for @words -> $word {
    my $index = index $string, $word;
    push %location, $word => $index if $index.defined;;
}
if %location.elems == 0 {
    say "0" 
} else {
    print "{$_.key} " for %location.sort({.value});
}

This is the output:

$ perl6 word-break.p6
perl weekly week challenge

Word Break in Perl

This is a port to Perl of the above Raku program:

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

my $string = "perlweeklychallenge";
my @words = <weekly challenge week perl>;
my %loc;
for my $word (@words) {
    my $index = index $string, $word;
    $loc{$word} = $index if $index >= 0;
}
if (%loc == 0) {
    say "0";
} else {
    say join " ", sort { $loc{$a} <=> $loc{$b} } keys %loc;
}

Output:

$ perl word-break.pl
perl weekly week challenge

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, June 21, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.