Perl Weekly Challenge: Week 93
Challenge 1:
Max Points
You are given set of co-ordinates @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
Example 2
|
|
| x x
| x
| x x
+ _ _ _ _ _
Input: (1,1), (2,2), (3,1), (1,3), (5,3)
Output: 3
I assume we are getting the co-ordinates from the command-line as comma-seperated pairs. For example 1,
the input looks like this: 1,1 2,2 3,3. The first order of business is to convert the input into an array
of 2-element arrays ussing .split() and .map().
my @points = @N.map({ [ $_.split(q{,}) ] });
The result will be the maximum number of points that make a straight line so we need a variable to store it. Because we have at least one point, we can start it at 1.
my $maxPoints = 1;
For each point, we (figuratively) draw lines to every other point via a double for-loop.
We will store line information in as keys of a Hash whose value will be the number of times that line occurs.
for @points.keys -> $i {
my %lines;
for @points.keys -> $j {
If the origin point is the same as the destination point we can ignore it and move on to the next destination point.
if $i == $j {
next;
}
We extract the x and y co-ordinates from the origin and destination points and find the delta of each.
my ($x1, $y1) = @points[$i];
my ($x2, $y2) = @points[$j];
my ($dx, $dy) = ($x2 - $x1, $y2 - $y1);
We can get the slope of the line by dividing $dy by $dx but only if $dx is not 0. If it is, the
line is vertical so it is added under the special key 'infinity'.
if $dx == 0 {
%lines{∞}++;
} else {
If $dx is not 0, we can proceed with finding the slope of the line. Using this, we can also find
the intercept. Together the slope and intercept provide enough information to use as a unique key in %lines to count how many points share the same line.
my $slope = $dy / $dx;
my $intercept = $y1 - $slope * $x1;
%lines{"$slope,$intercept"}++;
}
}
After processing all destination points for a given origin point, we can determin the maximum number of points on any line passing through that origin which we store as $localMax. The // 0 is to allow the possibility that
the origin point is completely isolated (i.e. no other points are collinear with it.) We also have to add 1 to
account for the origin point itself.
my $localMax = (%lines.values.max // 0) + 1;
It then updates the overall maximum ($maxPoints) if a higher count is found. A subtle point is that the code adds 1 to $localMax when updating $maxPoints, accounting for the anchor point itself.
$maxPoints = ($maxPoints, $localMax).max;
}
Finally, we print the result, which is the largest number of points that are collinear.
say $maxPoints;
This is the Perl version. We don't have max() so we have to provide my own. I had an
implementation from previous challenges but it only worked on two values so I wrote a different
version that works on an entire array.
sub max(@values) {
my $maximum = shift @values;
while (my $next = shift @values) {
if ($next > $maximum) {
$maximum = $next;
}
}
return $maximum;
}
The rest of the code is pretty much the same as in Raku.
my @points = (map { [split /,/] } @N);
my $maxPoints = 1;
for my $i (keys @points) {
my %lines;
for my $j (keys @points) {
if ($i == $j) {
next;
}
my ($x1, $y1) = @{$points[$i]};
my ($x2, $y2) = @{$points[$j]};
my ($dx, $dy) = ($x2 - $x1, $y2 - $y1);
if ($dx == 0) {
$lines{'inf'}++;
} else {
my $slope = $dy / $dx;
my $intercept = $y1 - $slope * $x1;
$lines{"$slope,$intercept"}++;
}
}
my $localMax = (max(values %lines) // 0) + 1;
$maxPoints = max($maxPoints, $localMax);
}
say $maxPoints;
Challenge 2:
Sum Path
You are given binary tree containing numbers `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)
Example 2
Input:
1
/ \
2 3
/ / \
4 5 6
Output: 26
as sum three paths (1->2->4), (1->3->5) and (1->3->6)
Conceptually, this challenge is simple. We need to do a depth-first search to each leaf node of the binary
tree adding the value of each node along the way. The most difficult part for me was getting the input into
binary tree form. I chose to have the command-line arguments to the script represent node values in level order
with - as a placeholder for missing nodes. This is done in the makeTree() function which will be explained below. The tree produced by this function is an input, along with the value of the current node (which is 0) and
the current value of the sum (which is also 0 initially,) to the sumPaths() function which will return the result.
This will also be explained below. Thus the MAIN() function is very simple:
say sumPaths(makeTree(@nodes), 0, 0);
I have mentioned the binary tree has nodes but what exactly is a node? I have modelled a node as a Raku class
with three fields.
class Node {
The value contained in the Node. It is set in stone when a Node object is created.
has $.val;
The left and right children of this node if any. These are also Node objects and can be set after the object
is created as shown by the is rw attribute.
has Node $.left is rw;
has Node $.right is rw;
}
Raku will take care of creating any neccessary getters and setters for us.
makeTree() constructs a binary tree from an array of values.
sub makeTree(@values) {
First any empty tree is created as an Array of Nodes.
my Node @tree;
For each value...
for @values.keys -> $i {
...if the value is -, that slot in the @tree array is left empty...
if @values[$i] eq q{-} {
next;
}
...otherwise a Node object is created in that slot, containing that value.
@tree[$i] = Node.new(val => @values[$i]);
}
Then, we link each node to its left and right children based on their positions in the array, following the standard binary heap indexing: left child at 2 * $i + 1, right child at 2 * $i + 2.
for @tree.keys -> $i {
(skipping empty spaces of course.)
if (!@tree[$i]) {
next;
}
my $l = 2 * $i + 1;
my $r = 2 * $i + 2;
if $l <= @tree.elems - 1 && @tree[$l] {
@tree[$i].left = @tree[$l];
}
if $r <= @tree.elems - 1 && @tree[$r] {
@tree[$i].right = @tree[$r];
}
}
Finally, function returns the root node of the constructed tree.
return @tree[0];
}
The sumPaths() subroutine recursively traverses the tree.
sub sumPaths(Node $node, $num is copy, $sum is copy) {
Every recursive function needs a halting condition so it does not continue for ever (or until stack space runs out.)
For sumpaths() that happens when the current node is empty and in that case, the current value of $sum is returned.
if !$node {
return $sum;
}
We accumulate the value of each node along the current path in $num.
$num += $node.val;
When a leaf node is reached (no left or right child), We add the accumulated path value to $sum.
if !$node.left && !$node.right {
$sum += $num;
Otherwise, for non-leaf nodes, we continue the traversal for both left and right children.
} else {
$sum = sumPaths($node.left, $num, $sum);
$sum = sumPaths($node.right, $num, $sum);
}
The recursion ensures all root-to-leaf paths are considered, and when that is done, final sum is returned.
return $sum;
}
Until now, I would have used something like the Moo module rather than Perls' builtin OOP facilities but in modern versions of Perl, the builtin support has improved markedly. See perldoc perlclass for details.
In order to use this, we have to include this line in our script.
use feature qw/ class /;
Because this is still considered an experimental feature, we also need this line so Perl doesn't complain about us using it.
no warnings qw/ experimental::class /;
Now we can create a class like this. The :param attribute means that an initial value for that field is required
when an object of that class is constructed.
class Node {
field $val :param;
field $left;
field $right;
Unfortunately in Perl v5.38 which I am using, support for automatic generation of getters and setters is missing but it is simple to create them ourselves.
method val { return $val; }
method left { return $left; }
method right { return $right; }
method setLeft($node) { $left = $node; }
method setRight($node) { $right = $node; }
}
The rest of the code is very close to the Raku version.
sub makeTree(@values) {
my Node @tree;
for my $i (keys @values) {
if ($values[$i] eq q{-}) {
next;
}
$tree[$i] = Node->new(val => $values[$i]);
}
for my $i (keys @tree) {
if (!$tree[$i]) {
next;
}
my $l = 2 * $i + 1;
my $r = 2 * $i + 2;
if ($l <= scalar @tree - 1 && $tree[$l]) {
$tree[$i]->setLeft($tree[$l]);
}
if ($r <= scalar @tree - 1 && $tree[$r]) {
$tree[$i]->setRight($tree[$r]);
}
}
return $tree[0];
}
sub sumPaths($node, $num, $sum) {
if (!$node) {
return $sum;
}
$num += $node->val;
if (!$node->left && !$node->right) {
$sum += $num;
} else {
$sum = sumPaths($node->left, $num, $sum);
$sum = sumPaths($node->right, $num, $sum);
}
return $sum;
}
say sumPaths(makeTree(@nodes), 0, 0);