Starting into Perl Weekly Challenge #64.

### TASK #1 › Minimum Sum Path

Reviewed by: Ryan Thompson

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.

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

My first thought for this was to do an iterative Shortest-Path solution, like I’ve used for my Ladder Puzzle solver, but I decided that, instead, a recursive solution would be best. Or at least, easiest to implement.

It kinda doesn’t matter, because if we’re looking for the lowest sums of all paths from upper-left to lower-right, we have to take all paths to get there, and with this as the matrix —

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

— there are a limited number of paths. 1 → 2 → 3 → 6 → 9, 1 → 2 → 5 → 6 → 9, 1 → 2 → 5 → 8 → 9, 1 → 4 → 5 → 6 → 9, 1 → 4 → 5 → 8 → 9, and 1 → 4 → 7 → 8 → 9, specifically, and they’re all five places long. If there were paths that were shorter, and that’s the thing to be looking for, then this might make sense.

But going depth-first instead of breadth-first, and only passing things back when we reach 9, then we can save a lot of record-keeping if we go with recursion.

``````#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use feature qw{ fc postderef say signatures state switch };
no warnings qw{ experimental };

use List::Util qw{sum};

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

my @solutions = solve_matrix(\$matrix);

my (\$sol) = sort { sum( \$a->@*) <=> sum( \$b->@* )} @solutions;

say join ' -> ', \$sol->@*;

sub solve_matrix ( \$matrix, \$x = 0, \$y = 0, \$path = [] ) {
my @output;
my @path = \$path->@*;
my \$endx = -1 + scalar \$matrix->@*;
my \$endy = -1 + scalar \$matrix->[0]->@*;
return if \$x > \$endx;
return if \$y > \$endy;

push @path, \$matrix->[\$x][\$y];

return \@path if \$x == \$endx && \$y == \$endy;
push @output, solve_matrix( \$matrix, \$x,     \$y + 1, \@path );    #right
push @output, solve_matrix( \$matrix, \$x + 1, \$y,     \@path );    #down
return wantarray ? @output : \@output;
}
``````

I suppose if I did this iteratively, I could tell when we’ve hit the last and do something like `@min_path = map {\$_} @path if sum(@path) < sum(@min_path)`, but oh well.

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

I have this. I am not happy.

``````#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use feature qw{ postderef say signatures state switch };
no warnings qw{ experimental };

use Carp;
use JSON;
my \$json = JSON->new->canonical->allow_nonref->pretty->space_after;

my @input;
push @input, [ "perlweeklychallenge", "weekly", "challenge", "perl" ];
push @input, [ "perlandraku",         "python", "ruby",      "haskell" ];

for my \$i (@input) {
my \$s = shift \$i->@*;
my @w = \$i->@*;
my \$out = wordbreak( \$s, @w );
say \$out;
}

sub wordbreak ( \$s, @w ) {
my @permutations = permute_array( \@w );
for my \$perm (@permutations) {
my \$str = join '', \$perm->@*;
return join ',', map { qq{"\$_"} } \$perm->@* if \$str eq \$s;
}
return 0;
}

sub permute_array ( \$array ) {
return \$array if scalar \$array->@* == 1;
my @response = map {
my \$i        = \$_;
my \$d        = \$array->[\$i];
my \$copy->@* = \$array->@*;
splice \$copy->@*, \$i, 1;
my @out = map { unshift \$_->@*, \$d; \$_ } permute_array(\$copy);
@out
} 0 .. scalar \$array->@* - 1;
return @response;
}
``````

For the given solution, `\$s = "perlweeklychallenge"; @w = ( "weekly", "challenge", "perl" )`, we can make it work with `( "perl", "weekly", "challenge" )` but by the description, I should be able to add `"zed"` into the input and still have the same output, I think, but instead of pulling out my old `permute_array` code, I might have to dive into Algorithm::Combinatorics so I can get subarrays.