PERL WEEKLY CHALLENGE – 064

This is my 34th week participating into the weekly challenge.


TASK #1 › Minimum Sum Path

Submitted by: Mohammad S Anwar
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.

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 )


For this challenge I just used a recursive algorithm to either branch right or down, storing the path and totals. The difficult path of this challenge was keeping the path in memory and storing the minimum path.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl
use strict;
use warnings;
use feature qw /say/;

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

say min_path($matrix, 0, 0, \@path)
    . ": " . (join ' → ', @path);

# Calculate the max path
sub min_path {
	my ($matrix, $m, $n, $path) = @_;

	# Size of matrix
	my $max_m = scalar(@{$matrix->[0]});
	my $max_n = scalar(@{$matrix});

	# Out of bounds
	return undef
		if ($m >= $max_m || $n >= $max_n);

	# Points in the branch
	my $total = $matrix->[$m][$n];

	# Calculate path
	push @$path, $total;
	my @path1 = map { $_ } @$path;
	my @path2 = map { $_ } @$path;

	# Points produced by each branch
	my $score1 = min_path($matrix, $m + 1, $n, \@path1);
	my $score2 = min_path($matrix, $m, $n + 1, \@path2);

	# Return the better branch
	if ( ($score1 && $score2 && $score1 <= $score2) ||
	     ($score1 && !$score2) ) {
		@$path = map { $_ } @path1;
		return $total + $score1;
	} elsif ( ($score1 && $score2 && $score1 > $score2) ||
	          (!$score1 && $score2) ) {
		@$path = map { $_ } @path2;
		return $total + $score2;
	} else {
		return $total;
	}
}

Output: perl ./ch-1.pl

21: 1 → 2 → 3 → 6 → 9

Raku solution

# Test: perl6 ch-1.p6
sub MAIN() {
	my @path;
	my @matrix = [
		[ 1, 2, 3 ],
		[ 4, 5, 6 ],
		[ 7, 8, 9 ],
	];

	say min-path(@matrix, 0, 0, @path)
	    ~ ': ' ~ @path.join(" → ");
}

# Calculate the max path
sub min-path(@matrix, Int $m, Int $n, @path) {

	# Size of matrix
	my $max_m = @matrix[0].elems;
	my $max_n = @matrix.elems;

	# Out of bounds
	return Nil
		if ($m >= $max_m || $n >= $max_n);

	# Points in the branch
	my $total = @matrix[$m][$n];

	# Calculate path
	@path.push($total);
	my @path1 = @path.map({ $_ });
	my @path2 = @path.map({ $_ });

	# Points produced by each branch
	my $score1 = min-path(@matrix, $m + 1, $n, @path1);
	my $score2 = min-path(@matrix, $m, $n + 1, @path2);

	# Return the better branch
	if ( ($score1 && $score2 && $score1 <= $score2) ||
	     ($score1 && !$score2) ) {
		@path = @path1.map({ $_ });
		return $total + $score1;
	} elsif ( ($score1 && $score2 && $score1 > $score2) ||
	          (!$score1 && $score2) ) {
		@path = @path2.map({ $_ });
		return $total + $score2;
	} else {
		return $total;
	}
}

Output perl6 ch-1.p6

21: 1 → 2 → 3 → 6 → 9

TASK #2 › Word Break

Submitted by: Mohammad S Anwar

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.

For this challenge I just created a regex string from the words and used the split function (with capturing) to return the words.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl
use strict;
use warnings;
use feature qw /say/;

my $S = "perlweeklychallenge";
my @W = ("weekly", "challenge", "perl");
say $S;
say check_word($S, \@W);

my $S2 = "perlandraku";
my @W2 = ("python", "ruby", "haskell");
say "\n" . $S2;
say check_word($S2, \@W2);


sub check_word {
	my ($string, $words) = @_;

	my $word_re = join '|', @$words;
	my @split_words =
		grep { $_  }
		split (/($word_re)/, $string);

	return scalar(@split_words) == scalar(@$words) ?
		join ' ', @split_words : 0;
}

Output ./ch-2.pl

perlweeklychallenge
weekly challenge perl

perlandraku
0

Raku solution

# Test: perl6 ch-2.p6

sub MAIN() {
	my $S = "perlweeklychallenge";
	my @W = ("weekly", "challenge", "perl");
	say $S;
	say check-word($S, @W);

	my $S2 = "perlandraku";
	my @W2 = ("python", "ruby", "haskell");
	say "\n" ~ $S2;
	say check-word($S2, @W2);
}

sub check-word(Str $string, @words) {
	my @split_words =
		$string.split(/<@words>/, :v, :skip-empty);

	return (@split_words.elems == @words.elems) ??
		@split_words.join(" ") !! 0;
}

Output perl6 ch-2.p6

perlweeklychallenge
perl weekly challenge

perlandraku
0

One thought on “PERL WEEKLY CHALLENGE – 064

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s