Pointy Path with Raku
[109] Published 1. January 2021.This is my response to the Perl Weekly Challenge #093.
Challenge #093.1: Max Points
@N.
Write a script to count maximum points on a straight line when given co-ordinates plotted on 2-d plane.
Example 1:
|
| x
| x
| x
+ _ _ _ _
Input: (1,1), (2,2), (3,3)
Output: 3
|
|
| x x
| x
| x x
+ _ _ _ _ _
Input: (1,1), (2,2), (3,1), (1,3), (5,3)
Output: 3
We need a way of specifying the input. Luckily we can reuse the code from last week's second challenge «Insert Interval» (see Isomorphic Insertation with Raku):
File: max-test (partial)
unit sub MAIN (Str $string = "(1,1), (2,2), (3,3)", :v(:$verbose));
my @array = $string.EVAL; # [1]
say ": Array: { @array.raku }" if $verbose;
my $max = @array>>.max.max; # [2]
my $min = @array>>.min.min; # [2a]
say ": Min: $min\n: Max: $max" if $verbose;
[1] EVAL will (try to) evaluate the string as a
Raku expression, and will succeed in this case. Note the quotes used to prevent
the shell from playing havoc with the parens. The result is an array of arrays,
as given by the input.
[2] We need the dimensions, both the minimum and maximum values. Note that this
does not differentiate between the rows and columns. The >>.max part
gives the largest value from each pair, and the final .max reduces
that again to a single maximum value.
See
docs.raku.org/routine/EVAL for
more information about EVAL.
Looking up cell positions in this type of array is hard, so I'll go for a two-dimentional array with the positions as indices:
File: max-points (the rest)
my @matrix; @array.map({ @matrix[$_[0]][$_[1]] = True }); # [3]
say ": { @matrix.raku } " if $verbose;
[3] Set the cells with an «x» to True, as that is better.
Running it:
$ ./max-test -v
: Array: [(1, 1), (2, 2), (3, 3)]
: Min: 1
: Max: 3
: [Any, [Any, Bool::True], [Any, Any, Bool::True], [Any, Any, Any, Bool::True]]
Note that arrays in Raku start at index 0, so
the first (stand alone) Any belongs to row zero (which is empty).
The three rows following it start at index (or column) 0, so ignore the first
value to see that the matrix is indeed correct.
You may have noticed a potential
problem with this «start at zero» way of setting up the rows and columns.
If we specify something like this on the command line, we will end up with a
lot of empty rows in the array:
"(12345678901,1), (12345678902,2), (12345678903,3)".
Note that EVAL when
used like this is not as unsafe as the lower case equivalent in Perl (that
it is based on). But you can still get it do to a lot of mischief. E.g.
$ ./max-test -v "mkdir 123"
About a Queen
We did something similar in Challenge #062.2: N Queens, where we considered the 8 directions a Queen can travel from the current position:
The idea this time is to start at all the positions in the matrix shown with an «x», and count how far we can go in each of the 8 directions before running out of xes. As shown in the figure to the left.
We start at the top row, and go through the cells from left to right for each row. This gives some redundance, so we can skip the 4 directions shown greyed out in the figure in the middle (as we have already covered them, from the opposite direction).
The last redundancy can be observed in the rightmost figure. We got the diagonal starting at (1,1), but are accessing it again when we come to (2,2) - but with a shorter length. This gives some extra computations, but I 'll ignore the issue.
See my article The Email Queen with Raku for details about the Queen.
#! /usr/bin/env raku
unit sub MAIN (Str $string = "(1,1), (2,2), (3,3)", :v(:$verbose));
my @array = $string.EVAL;
say ": { @array.raku }" if $verbose;
my $max = @array>>.max.max;
my $min = @array>>.min.min;
say ": [$min <-> $max]" if $verbose;
my @matrix; @array.map({ @matrix[$_[0]][$_[1]] = True });
say ": { @matrix.raku }" if $verbose;
my $answer; # [1]
for $min .. $max -> $row # [2]
{
for $min .. $max -> $col # [3]
{
say ": [$row][$col]" if $verbose;;
next unless @matrix[$row][$col].defined; # [4]
say "@ [$row][$col]" if $verbose;;
for (0,1),(1,-1),(1,0),(1,1) -> @add # [5]
{
my $maximum = traverse(1, $row, $col, @add[0], @add[1]); # [6]
say "::: @add[] -> $maximum" if $verbose;
$answer = max($answer, $maximum); # [7]
}
}
}
say $answer; # [8]
sub traverse ($count, $row, $col, $add-row, $add-col) # [9]
{
return $count unless @matrix[$row + $add-row][$col + $add-col]; # [10]
return traverse($count +1, $row + $add-row, $col + $add-col, # [11]
$add-row, $add-col);
}
[1] The final answer (the longest line) to be held here.
[2] Iterate over all the rows,
[3] • and the columns.
[4] Skip cells without an «x».
[5] Iterate over the 4 directions (the green cells in the rightmost illustration), as offsets on the row and column numbers.
[6] A recursive call. It goes on in the specified direction and returns the number of cells with «x» in that direction.
[7] Do we have a new «high score»? If so, save the new value.
[8] Print the answer.
[9] The recurive procedure, with the starting point and the direction as line and column offsets.
[10] Return the count if we have reached a cell that is not an «x». (The code
checks for True - which is the cell value. A cell off the edge will
have an undefined value, and will halt the line.
[11] Add one to the length of the line.
Running it:
$ ./max-points "(1,1), (2,2), (3,3)"
3
$ ./max-points "(1,1), (2,2), (3,1), (1,3), (5,3)"
3
With verbose mode:
$ ./max-points -v "(1,1), (2,2), (3,3)"
: [(1, 1), (2, 2), (3, 3)]
: [1 <-> 3]
: [Any, [Any, Bool::True], [Any, Any, Bool::True], [Any, Any, Any, Bool::True]]
: [1][1]
@ [1][1]
::: 0 1 -> 1
::: -1 1 -> 1
::: 1 0 -> 1
::: 1 1 -> 3
: [1][2]
: [1][3]
: [2][1]
: [2][2]
@ [2][2]
::: 0 1 -> 1
::: -1 1 -> 1
::: 1 0 -> 1
::: 1 1 -> 2
: [2][3]
: [3][1]
: [3][2]
: [3][3]
@ [3][3]
::: 0 1 -> 1
::: -1 1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
3
$ ./max-points -v "(1,1), (2,2), (3,1), (1,3), (5,3)"
: [(1, 1), (2, 2), (3, 1), (1, 3), (5, 3)]
: [1 <-> 5]
: [Any, [Any, Bool::True, Any, Bool::True], [Any, Any, Bool::True], \
[Any, Bool::True], Any, [Any, Any, Any, Bool::True]]
: [1][1]
@ [1][1]
::: 0 1 -> 1
::: -1 1 -> 1
::: 1 0 -> 1
::: 1 1 -> 2
: [1][2]
: [1][3]
@ [1][3]
::: 0 1 -> 1
::: -1 1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
: [1][4]
: [1][5]
: [2][1]
: [2][2]
@ [2][2]
::: 0 1 -> 1
::: -1 1 -> 2
::: 1 0 -> 1
::: 1 1 -> 1
: [2][3]
: [2][4]
: [2][5]
: [3][1]
@ [3][1]
::: 0 1 -> 1
::: -1 1 -> 3
::: 1 0 -> 1
::: 1 1 -> 1
: [3][2]
: [3][3]
: [3][4]
: [3][5]
: [4][1]
: [4][2]
: [4][3]
: [4][4]
: [4][5]
: [5][1]
: [5][2]
: [5][3]
@ [5][3]
::: 0 1 -> 1
::: -1 1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
: [5][4]
: [5][5]
3
Now let us revisit the problem of high values:
$ ./max-points -v "(12345678901,1), (12345678902,2), (12345678903,3)"
: [(12345678901, 1), (12345678902, 2), (12345678903, 3)]
: [1 <-> 12345678903]
MoarVM panic: Memory allocation failed; could not allocate 98765431216 bytes
We can adjust the window of values. But the «min» (-> 1) and «max» (-> 12345678903) approach in the original program will not work. We have to get them separately for the rows and the columns.
File: max-points2
#! /usr/bin/env raku
unit sub MAIN (Str $string = "(1,1), (2,2), (3,3)", :v(:$verbose));
my @array = $string.EVAL;
say ": { @array.raku }" if $verbose;
my $max-row = @array>>.first.max;
my $min-row = @array>>.first.min;
my $max-col = @array>>.[1].max; # [1]
my $min-col = @array>>.[1].min; # [1a]
say ": [Row: $min-row <-> $max-row]" if $verbose; # [2]
say ": [Col: $min-col <-> $max-col]" if $verbose; # [2a]
my @matrix;
@array.map({ @matrix[$_[0] - $min-row +1][$_[1] - $min-col+1] = True });
# [3]
say ": { @matrix.raku }" if $verbose;
my $answer;
for 1 .. $max-row - $min-row +1 -> $row # [4]
{
for 1 .. $max-col - $min-col +1 -> $col # [4a]
{
say ": [$row][$col]" if $verbose;;
next unless @matrix[$row][$col].defined;
say "@ [$row][$col]" if $verbose;;
for (0,1),(1,-1),(1,0),(1,1) -> @add
{
my $maximum = traverse(1, $row, $col, @add[0], @add[1]);
say "::: @add[] -> $maximum" if $verbose;
$answer = max($answer, $maximum);
}
}
}
say $answer;
sub traverse ($count, $row, $col, $add-row, $add-col)
{
return $count unless @matrix[$row + $add-row][$col + $add-col];
return traverse($count +1, $row + $add-row, $col + $add-col,
$add-row, $add-col);
}
[1] Get the first element of each sublist (with
first), and apply max on the result.
[2] There is no corresponding «second» method (for a list that is. The method does
exist when we deal with time, but that one returns a number of seconds). We
can get the second element with an index, as done here. (And we could have used
[0] instead of first in [1].) There is a last,
but that one is used to terminate a loop. But we could have used first
with an option to tell it to start at the end: first(:end).
[3] Adjust the values for row and column, so that both start at 0.
[4] Adjust the loops iterating over the rows [2] and columns [2a] with xes to the new reality (with the first value at index 1).
See
docs.raku.org/routine/first for
more information about first.
Running it:
$ ./max-points2 "(12345678901,1), (12345678902,2), (12345678903,3)"
3
$ ./max-points2 -v "(12345678901,1), (12345678902,2), (12345678903,3)"
: [(12345678901, 1), (12345678902, 2), (12345678903, 3)]
: [Row: 12345678901 <-> 12345678903]
: [Col: 1 <-> 3]
: [Any, [Any, Bool::True], [Any, Any, Bool::True], [Any, Any, Any, Bool::True]]
: [1][1]
@ [1][1]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 3
: [1][2]
: [1][3]
: [2][1]
: [2][2]
@ [2][2]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 2
: [2][3]
: [3][1]
: [3][2]
: [3][3]
@ [3][3]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
3
It handles zeroes, if you wondered:
$ ./max-points2 -v "(0,0), (1,1), (2,2)"
: [(0, 0), (1, 1), (2, 2)]
: [Row: 0 <-> 2]
: [Col: 0 <-> 2]
: [Any, [Any, Bool::True], [Any, Any, Bool::True], [Any, Any, Any, Bool::True]]
: [1][1]
@ [1][1]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 3
: [1][2]
: [1][3]
: [2][1]
: [2][2]
@ [2][2]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 2
: [2][3]
: [3][1]
: [3][2]
: [3][3]
@ [3][3]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
3
The order does not matter:
$ ./max-points2 "(0,0), (1,1), (2,2)"
3
$ ./max-points2 "(1,1), (0,0), (2,2)"
3
Note that you can still make it blow up, by specifying a big range of values. E.g.
$ ./max-points2 -v "(1,1), (12345678901,12345678901)"
: [(1, 1), (12345678901, 12345678901)]
: [Row: 1 <-> 12345678901]
: [Col: 1 <-> 12345678901]
MoarVM panic: Memory allocation failed; could not allocate 98765431216 bytes
This is fixable, by replacing the array with a hash. We can drop the index realignments introcuced with «max-points2», and have to replace the two loops with some cleverness.
File: /max-points-hash
#! /usr/bin/env raku
unit sub MAIN (Str $string = "(1,1), (2,2), (3,3)", :v(:$verbose));
my @array = $string.EVAL;
say ": { @array.raku }" if $verbose;
my %matrix; @array.map({ %matrix{ $_[0] }{ $_[1] } = True }); # [1]
say ": { %matrix.raku }" if $verbose;
my $answer;
for @array -> @current # [2]
{
my ($row, $col) = @current;
say ": [$row][$col]" if $verbose;;
for (0,1),(1,-1),(1,0),(1,1) -> @add
{
my $maximum = traverse(1, $row, $col, @add[0], @add[1]);
say "::: @add[] -> $maximum" if $verbose;
$answer = max($answer, $maximum);
}
}
say $answer;
sub traverse ($count, $row, $col, $add-row, $add-col)
{
return $count unless %matrix{ $row + $add-row }{ $col + $add-col}; # [3]
return traverse($count +1, $row + $add-row, $col + $add-col,
$add-row, $add-col);
}
[1] Set up a hash instead of an array. The hash is two-dimentional as well
[2] Iterate over the values (as got them from the command line), instead of sorting out the emty cells in the prior double loop.
[3] Check the hash.
Running it to check that it works:
$ ./max-points-hash -v "(1,1), (2,2), (12345678901,12345678901)"
: [(1, 1), (2, 2), (12345678901, 12345678901)]
: {"12345678901;12345678901" => Bool::True, "1;1" => Bool::True, \
"2;2" => Bool::True}
: [1][1]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 2
: [2][2]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
: [12345678901][12345678901]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
2
$ ./max-points-hash -v "(1,1), (2,2), (12345678901,12345678901)"
: [(1, 1), (2, 2), (12345678901, 12345678901)]
: {"1" => ${"1" => Bool::True}, "12345678901" => ${"12345678901" \
=> Bool::True}, "2" => ${"2" => Bool::True}}
: [1][1]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 2
: [2][2]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
: [12345678901][12345678901]
::: 0 1 -> 1
::: 1 -1 -> 1
::: 1 0 -> 1
::: 1 1 -> 1
2
Challenge #093.2: Sum Path
0-9 only.
Write a script to sum all possible paths from root to leaf.
Example 1:
Input:
1
/
2
/ \
3 4
Output: 13
as sum two paths (1->2->3) and (1->2->4)
Input:
1
/ \
2 3
/ / \
4 5 6
Output: 26
as sum three paths (1->2->4), (1->3->5) and (1->3->6)
Deja Vu
This is similar to Perl Weekly Challenge #056.2: Path Sum. See my article Diff Sum by Raku (and the «path-sum-conf2» program) for details.
The format used in «path-sum-conf2» for command line specification of a binary tree worked quite well, so we use it here as well. The two examples in the challenge are coded like this:
"1 | 2 * | 3 4"
"1 | 2 3 | 4 * 5 6"
We specify the tree from the top, one row at a time with space separated values,
and | to indicate a new row. The * marks a missing child,
where it is missing inside a row.
If the missing nodes are at the end of a row, they can be skipped.
Like this:
|
|
The first two thirds of the program is unchanged, except for the default tree value:
File: sum-path (partial)
#! /usr/bin/env raku
unit sub MAIN (Str $tree = "1 | 2 3 | 4 * 5 6", :v(:$verbose));
class BinaryNode
{
has Int $.value;
has BinaryNode $.left;
has BinaryNode $.right;
}
my @btree = $tree.split("|")>>.words;
my @old-nodes;
my @new-nodes;
for @btree.reverse -> $row
{
my @current = @$row;
@old-nodes = @new-nodes;
@new-nodes = ();
for @current -> $value
{
if $value eq "*"
{
@new-nodes.push("*");
next;
}
my $left = @old-nodes.shift // "*"; $left = Nil if $left eq "*";
my $right = @old-nodes.shift // "*"; $right = Nil if $right eq "*";
@new-nodes.push(BinaryNode.new(value => $value.Int,
left => $left // Nil,
right => $right // Nil));
}
}
my $btree = @new-nodes[0];
say ": { $btree.raku }" if $verbose;
See the discussion of «path-sum-conf2» in my Diff Sum by Raku article for the explanation.
File: sum-path (the rest)
my $sum = 0; # [1]
traverse($btree, ()); # [2]
say $sum; # [3]
sub traverse ($current, @path is copy) # [4]
{
@path.push: $current.value; # [5]
if ($current.left or $current.right) # [6]
{
traverse($current.left, @path) if $current.left; # [7]
traverse($current.right, @path) if $current.right; # [8]
}
else # [9]
{
my $this-sum = @path.sum; # [10]
say ": Path: { @path.join(" -> ") } (sum: $this-sum)" if $verbose;
$sum += $this-sum; # [11]
return; # [12]
}
}
[1] The final result; the sum of the values of all possible paths.
[2] Off we go. The first argument is a node in the tree, and the second is the path so far as a list of values (and not BinaryNode objects).
[3] Print the grand total.
[4] is copy so that we can add to it. The default mode for parameters
is read only.
[5] • push the value of the node to the path.
[6] Does the current node have any children? If yes,
[7] • recursively follow a left child, if any.
[8] • recursively follow a right child, if any.
[9] If not, we have reached a terminal (or childless) node.
[10] • Get the sum of the path.
[11] • Add this sum to the final result.
[12] • Finish this recursive call.
Running it:
$ ./sum-path "1 | 2 * | 3 4"
13
$ ./sum-path "1 | 2 3 | 4 * 5 6"
26
With verbose mode (and newlines and indentation added on the first verbose line to make it less unreadable).
$ ./sum-path -v "1 | 2 * | 3 4"
: BinaryNode.new(value => 1,
left => BinaryNode.new(value => 2,
left => BinaryNode.new(value => 3,
left => BinaryNode,
right => BinaryNode
),
right => BinaryNode.new(value => 4,
left => BinaryNode,
right => BinaryNode
)
),
right => BinaryNode
)
: Path: 1 -> 2 -> 3 (sum: 6)
: Path: 1 -> 2 -> 4 (sum: 7)
13
$ ./sum-path -v "1 | 2 3 | 4 * 5 6"
: BinaryNode.new(value => 1,
left => BinaryNode.new(value => 2,
left => BinaryNode.new(value => 4,
left => BinaryNode,
right => BinaryNode
),
right => BinaryNode
),
right => BinaryNode.new(value => 3,
left => BinaryNode.new(value => 5,
left => BinaryNode,
right => BinaryNode
),
right => BinaryNode.new(value => 6,
left => BinaryNode,
right => BinaryNode
)
)
)
: Path: 1 -> 2 -> 4 (sum: 7)
: Path: 1 -> 3 -> 5 (sum: 9)
: Path: 1 -> 3 -> 6 (sum: 10)
26
We got the correxct result this time as well.
And that's it.