Perl Weekly Challenge: Week 64

Challenge 1:

Minimum Sum Path

Given an m x 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:

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

In both my Perl and Raku solutions I chose to hard-code the matrix into the script. Ideally though this should be read in from a file or at the very least from the command line.

my $matrix = [
    [1, 2, 3],
    [4, 5, 6],
    [7, 8, 9],
];

I set up two variables to express the position of the last row and column. Actually in my comment I should have said 'rectangular' not square.

my $bottom_edge = scalar @{$matrix} - 1;
my $right_edge = scalar @{$matrix->[0]} - 1;  # assuming matrix is square

These are two variables for the current row and column. They are initially set to 0 to signify the top left corner.

my $row = 0;
my $col = 0;

A running total is kept to represent the sum of all numbers along the path. Initially it is the value of the top left corner.

my $total = $matrix->[0]->[0];

This is the path. It also initially starts in the top left corner.

my @path;
push @path, $matrix->[0]->[0];

While we haven't reached the bottom right corner...

while ($row < $bottom_edge || $col < $right_edge) {

Start with a downward move. We initialize the value of the $down variable ideally to the largest possible value, for instance INT_MAX in c++. But I don't know how to do that in Perl so I just made it 1,000,000 which is larger than any possible value we could come across. Then if it is possible to make a downward move i.e. we won't fall off the bottom edge of the matrix, we add the value of the matrix element at the new position to the current total and assign that to $down.

    my $down = 1_000_000;
    if ($row + 1 <= $bottom_edge) {
        $down = $total + $matrix->[$row + 1]->[$col];
    }

A similar procedure is performed for a rightward move.

    my $right = 1_000_000;
    if ($col + 1 <= $right_edge) {
        $right = $total + $matrix->[$row]->[$col + 1];
    }

Then the lower of the two values $down and $right is selected. If either move was not possible, its value would have remained at the dafault high value of 1,000,000 and it would have automatically lost. Based on whichever of the two values was lower, we adjust $row or $col and update $total. The value of the new current matrix element is appended to @path.

    if ($down < $right) {
        $row++;
        $total = $down;
    } else {
        $col++;
        $total = $right;
    }
    push @path, $matrix->[$row]->[$col];
}

Finally when we have reached the bottom right corner, we can print out the @path.

say join ' -> ', @path;

(Full code on Github.)

The Raku version is a straight port from Perl. The only change of note is I used ∞ as the maximum value. You can't get more maximum than infinity!

my @matrix = [
    [1, 2, 3],
    [4, 5, 6],
    [7, 8, 9],
];

my $bottom_edge = @matrix.elems - 1;
my $right_edge = @matrix[0].elems - 1;  # assuming matrix is square
my $row = 0;
my $col = 0;
my $total = @matrix[0][0];
my @path;
@path.push(@matrix[0][0]);

while $row != $bottom_edge || $col != $right_edge {

    my $down = ∞
    if ($row + 1 <= $bottom_edge) {
        $down = $total + @matrix[$row + 1][$col];
    }

    my $right = ∞
    if ($col + 1 <= $right_edge) {
        $right = $total + @matrix[$row][$col + 1];
    }

    if ($down < $right) {
        $row++;
        $total = $down;
    } else {
        $col++;
        $total = $right;
    }
    @path.push(@matrix[$row][$col]);
}

@path.join(' -> ').say;

(Full code on Github.)

Challenge 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.

I'm a little dissatisfied with my solution to this one. It does the job but I wanted to display the output in the same order as the words occur in $S but I ran out of time. I think I know how to do it though. Instead of @results being an array, make it a hash where the keys are found words and the values are their position in the string which you can find with the pos() function and the length of the word. Then sort based on those values.

sub search {
    my ($S, @W) = @_;
    my @results;

    push @results, grep { $S =~ /$_/ } @W; 

    return (scalar @results) ? join ', ', @results : 0;
}

say search("perlweeklychallenge", ("weekly", "challenge", "perl"));
say search("perlandraku", ("python", "ruby", "haskell"));

(Full code on Github.)

This is the Raku version:

sub search($S, @W) {
    my @results;

For some reason, when translating the above code from Perl to Raku I was not able to make the push @results line work. I thought something like:

@results.push(@W.grep({ $S ~~ /$_/; }));

...would have been straightforward but for some reason it matches everything.

So I used a loop instead. It's not as elegant but it works.

    for @W -> $word {
        if $S ~~ /$word/ { 
            @results.push($word);
        } 
    }
    return @results.elems ?? @results.join(', ') !! 0;
}

say search("perlweeklychallenge", ["weekly", "challenge", "perl"]);
say search("perlandraku", ("python", "ruby", "haskell"));

(Full code on Github.)