diff options
| -rw-r--r-- | challenge-064/duncan-c-white/README | 81 | ||||
| -rwxr-xr-x | challenge-064/duncan-c-white/perl/ch-1.pl | 113 | ||||
| -rwxr-xr-x | challenge-064/duncan-c-white/perl/ch-2.pl | 72 |
3 files changed, 228 insertions, 38 deletions
diff --git a/challenge-064/duncan-c-white/README b/challenge-064/duncan-c-white/README index 78b667bd21..9df57b02da 100644 --- a/challenge-064/duncan-c-white/README +++ b/challenge-064/duncan-c-white/README @@ -1,56 +1,61 @@ -Task 1: "Last Word +Task 1: "Minimum Sum Path -Define sub last_word($string, $regexp) that returns the last word -matching $regexp found in the given string, or undef if the string does -not contain a word matching $regexp. +Given an MxN 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. -For this challenge, a "word" is defined as any character sequence -consisting of non-whitespace characters (\S) only. That means punctuation -and other symbols are part of the word. +Example + +Input: + +[ 1 2 3 ] +[ 4 5 6 ] +[ 7 8 9 ] -The $regexp is a regular expression. Take care that the regexp can only -match individual words! See the Examples for one way this can break if -you are not careful. +The minimum sum path looks like this: -Examples +1->2->3 + | + 6 + | + 9 -last_word(' hello world', qr/[ea]l/); # 'hello' -last_word("Don't match too much, Chet!", qr/ch.t/i); # 'Chet!' -last_word("spaces in regexp won't match", qr/in re/); # undef -last_word( join(' ', 1..1e6), qr/^(3.*?){3}/); # '399933' +Thus, your script could output: 21 ( 1 -> 2 -> 3 -> 6 -> 9 ) " -My notes: cool question. Will have a go! +My notes: sounds like fun. -Task 2: "Rotate String +Task 2: "Word Break -Given a word made up of an arbitrary number of x and y characters, that -word can be rotated as follows: For the ith rotation (starting at i = -1), i % length(word) characters are moved from the front of the string to -the end. Thus, for the string xyxx, the initial (i = 1) % 4 = 1 character -(x) is moved to the end, forming yxxx. On the second rotation, (i = 2) % -4 = 2 characters (yx) are moved to the end, forming xxyx, and so on. See -below for a complete example. +You are given a string $S and an array of words @W. -Your task is to write a function that takes a string of xs and ys and -returns the minimum non-zero number of rotations required to obtain -the original string. You may show the individual rotations if you wish, -but that is not required. +Write a script to find out if $S can be split into sequence of one +or more words as in the given @W. Print all the words if found +otherwise print 0. -Example +Example 1: + +Input: + +$S = "perlweeklychallenge" +@W = ("weekly", "challenge", "perl") + +Output: + +"perl", "weekly", "challenge" + +Example 2: + +Input: -Input: $word = 'xyxx'; +$S = "perlandraku" +@W = ("python", "ruby", "haskell") -Rotation 1: you get yxxx by moving x to the end. -Rotation 2: you get xxyx by moving yx to the end. -Rotation 3: you get xxxy by moving xxy to the end. -Rotation 4: you get xxxy by moving nothing as 4 % length(xyxx) == 0. -Rotation 5: you get xxyx by moving x to the end. -Rotation 6: you get yxxx by moving xx to the end. -Rotation 7: you get xyxx by moving yxx to the end which is same as the given word. +Output: -Output: 7 +0 as none matching word found. " My notes: sounds like fun. Nice question. diff --git a/challenge-064/duncan-c-white/perl/ch-1.pl b/challenge-064/duncan-c-white/perl/ch-1.pl new file mode 100755 index 0000000000..cf28ce2aa1 --- /dev/null +++ b/challenge-064/duncan-c-white/perl/ch-1.pl @@ -0,0 +1,113 @@ +#!/usr/bin/perl +# +# Task 1: "Minimum Sum Path +# +# Given an MxN 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 ) +# " +# +# My notes: sounds like fun. Input format: CSV rows on command line +# so above is: ./ch-1.pl 1,2,3 4,5,6 7,8,9 +# + +use strict; +use warnings; +use feature 'say'; +use Function::Parameters; +use Data::Dumper; +use List::Util qw(sum); + +die "Usage: min-sum-path row1 row2..\n" if @ARGV==0; +my @m; +foreach my $row (@ARGV) +{ + my @r = split(/,/, $row); + push @m, \@r; +} +#say Dumper(\@m); + +my $rows = @m; +my $cols = @{$m[0]}; +my( $min, $minpath ) = minsumpath( $rows, $cols, @m ); +say "min sum path: $min ($minpath)"; + + +# +# my( $min, $minpath ) = minsumpath( $r, $c, @m ); +# Find and return the minimum sum path through the matrix @m, +# which is $r X $c +# +fun minsumpath( $r, $c, @m ) +{ + my $min; + foreach my $row (@m) + { + $min += sum(@$row); + } + + my $minpath = ""; + my $el = $m[0][0]; + search( "$el", $el, 0, 0, $r-1, $c-1, \@m, + fun ($x, $y) + { + if( $x < $min ) + { + $min = $x; + $minpath = $y; + } + } ); + return ( $min, $minpath ); +} + + +# +# search( $currpath, $currsum, $r, $c, $destr, $destc, $mref, $callback ); +# Given that we've already got $currsum getting to ($r,$c), +# search all paths through @$mref only going left or down +# from ($r,$c), and call the $callback(sum, path) whenever we +# find a complete path (ie. reach $destr and $destc) +# +fun search( $currpath, $currsum, $r, $c, $destr, $destc, $mref, $callback ) +{ + if( $r < $destr || $c < $destc ) + { + if( $r < $destr ) + { + # go down a row + my $val = $mref->[$r+1][$c]; + search( "$currpath -> $val", $currsum+$val, $r+1, $c, $destr, $destc, + $mref, $callback ); + } + if( $c < $destc ) + { + # go right a column + my $val = $mref->[$r][$c+1]; + search( "$currpath -> $val", $currsum+$val, $r, $c+1, $destr, $destc, + $mref, $callback ); + } + } elsif( $r == $destr && $c == $destc ) + { + #say "debug: found path $currpath to $destr, $destc: $currsum"; + $callback->( $currsum, $currpath ); + } +} diff --git a/challenge-064/duncan-c-white/perl/ch-2.pl b/challenge-064/duncan-c-white/perl/ch-2.pl new file mode 100755 index 0000000000..e62aab6eb8 --- /dev/null +++ b/challenge-064/duncan-c-white/perl/ch-2.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl +# +# 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 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. +# " +# +# My notes: sounds like fun. Nice question. Input format: +# string and one or more words on command line. So: +# ./ch-2.pl perlweeklychallenge weekly challenge perl +# + +use strict; +use warnings; +use feature 'say'; +use Function::Parameters; + +die "Usage: word-break string word+\n" unless @ARGV>2; +my $string = shift; +my @w = @ARGV; + +my( $ok, @sol ) = search( $string, @w ); +say $ok ? join(' ',@sol) : "0"; + +# +# my( $ok, @sol ) = search( $string, @w ); +# Search for ways of combining words in @w to make $string, +# using each word in @w only once. Return (1, solutionwords) +# if there is a way, or (0) if there is no way. +# +fun search( $string, @w ) +{ + #say "searching for $string in ", join(',',@w); + return ( 1 ) if $string eq "" && @w == 0; + my @first = grep { $string =~ /^$_/ } @w; + + foreach my $w (@first) + { + my $s = $string; + $s =~ s/^$w//; + my @restw = grep { $_ ne $w } @w; + my( $ok, @sol ) = search( $s, @restw ); + return (1, $w, @sol) if $ok; + } + return ( 0 ); +} |