Perl Weekly Challenge 93: Max Points and Sum Path
These are some answers to the Week 93 of the Perl Weekly Challenge organized by Mohammad S. Anwar.
Spoiler Alert: This weekly challenge deadline is due in a day or so. This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.
Task 1: Max Points
You are given set of coordinates @N
.
Write a script to count maximum points on a straight line when given coordinates plotted on 2d 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
From the examples provided, it appears that the given coordinates will be integers, that the points of a straight line have to be immediate neighbors and that the lines can only be horizontal, vertical or diagonal. Because of that, I will not try to solve the task with math formulas, as it is somewhat impractical to deal with integers in geometric equations. Also, representing a vertical line with a math equation is a mess.
Max Points in Raku
With such a type of problem, the first thing I usually want to do is to make a graphical representation of the point cloud, so that I can visually verify the test results. This is done in the following displaypoints
subroutine:
sub displaypoints (@points) {
my @sorted = reverse sort
{ $^a[0] <=> $^b[0]  $^b[1] <=> $^a[1] },
map { $_.reverse }, @points;
my $current = (@sorted.max({$_[0]}))[0];
my $max_length = (@sorted.max({$_[1]}))[1];
my $line = "";
my $pos = 0;
for @sorted > $item {
if $item[0] < $current {
say $line;
$pos = 0;
$line = "";
$current;
}
while $item[0] < $current {
say "$current ";
$current;
}
$line = "$current " and $pos = 0 if $line eq "";
$line ~= " " x ~ ($item[1]  $pos  1) ~ "x";
$pos = $item[1];
}
say $line;
while $current > 0 { say "$current " };
say "_" x ($max_length + 3), "\n";
}
With the following set of points:
(1,1), (2,2), (5,2), (3,3), (3,1), (2,7);
the procedure first reverse sorts the points as well as their individual coordinates:
[(7 2) (3 3) (2 2) (2 5) (1 1) (1 3)]
This is the output of this subroutine:
7  x
6 
5 
4 
3  x
2  x x
1 x x
0 
________
For finding the alignments, I used a dispatch table (%directions
) defining four directions in which to move in order to find the next point: North, NorthEast, East, and SouthEast (the other four directions are just symmetric and are not necessary, since we will look for straight lines starting from every point in the set. We also build a %pointhash
hash to store all points in the form of a string containing the abscissa and ordinate of every point (separated by a semicolon). Then we loop over every point in the data set and loop over each of the four directions, and find in the hash whether there is a new point in that direction. We count the number of points found in that direction and keep track of the maximum count ($maxcount
).
sub findalignments (@points) {
my %directions = (
N => { $^a, $^b + 1 },
NE => { $^a + 1, $^b + 1 },
E => { $^a + 1, $^b },
SE => { $^a + 1, $^b  1 }
);
my %pointhash = map { "$_[0];$_[1]" => True }, @points;
my $maxcount = 0;
for @points > $point {
for %directions.keys > $dir {
my $count = 1;
my $p = %directions{$dir}($point);
while %pointhash{"$p[0];$p[1]"} {
$p = %directions{$dir}($p);
$count++;
}
$maxcount = $count if $count > $maxcount;
}
}
say "Count: $maxcount \n\n";
}
Note that the code to find the alignments (i.e. to actually solve the task) contains only 22 code lines, and is thus shorter that the code to display the points (but it may be argued that it uses slightly more advanced techniques).
This is the full program:
use v6;
my @tests = ((1,1), (2,2), (5, 5), (5,2), (3,3), (3,1), (2,7), (4, 4)),
((1,1), (2,2), (3,1), (1,3), (5,3)),
((1,1), (4,2), (1,3), (2,2), (1,2), (5,1), (1,4));
for @tests > @points {
displaypoints(@points);
findalignments(@points);
}
sub displaypoints (@points) {
my @sorted = reverse sort
{ $^a[0] <=> $^b[0]  $^b[1] <=> $^a[1] },
map { $_.reverse }, @points;
my $current = (@sorted.max({$_[0]}))[0];
my $max_length = (@sorted.max({$_[1]}))[1];
my $line = "";
my $pos = 0;
for @sorted > $item {
if $item[0] < $current {
say $line;
$pos = 0;
$line = "";
$current;
}
while $item[0] < $current {
say "$current ";
$current;
}
$line = "$current " and $pos = 0 if $line eq "";
$line ~= " " x ~ ($item[1]  $pos  1) ~ "x";
$pos = $item[1];
}
say $line;
while $current > 0 { say "$current " };
say "_" x ($max_length + 3), "\n";
}
sub findalignments (@points) {
my %directions = (
N => { $^a, $^b + 1 },
NE => { $^a + 1, $^b + 1 },
E => { $^a + 1, $^b },
SE => { $^a + 1, $^b  1 }
);
my %pointhash = map { "$_[0];$_[1]" => True }, @points;
my $maxcount = 0;
for @points > $point {
for %directions.keys > $dir {
my $count = 1;
my $p = %directions{$dir}($point);
while %pointhash{"$p[0];$p[1]"} {
$p = %directions{$dir}($p);
$count++;
}
$maxcount = $count if $count > $maxcount;
}
}
say "Count: $maxcount \n\n";
}
This program displays the following output:
$ raku maxpoints.raku
7  x
6 
5  x
4  x
3  x
2  x x
1 x x
0 
________
Count: 5
3 x x
2  x
1 x x
0 
________
Count: 3
4 x
3 x
2 xx x
1 x x
0 
________
Count: 4
Max Points in Perl
This is a port of the Raku program into Perl. Note that, for the sake of brevity, I will not show here the display_points
subroutine as it is very similar to the equivalent code in Raku and is not very interesting. The test data sets are the same as in the Raku program, so you can look above to see the graphical representations of the point clouds. The find_alignments
subroutine is similar to its counterpart in Raku and also uses a dispatch table with four directions in which to move to find the next point. Please refer to the Raku section above is you need additional explanations.
use strict;
use warnings;
use feature "say";
my @tests = ( [[1,1], [2,2], [5, 5], [5,2], [3,3], [3,1], [2,7], [4, 4]],
[[1,1], [2,2], [3,1], [1,3], [5,3]],
[[1,1], [4,2], [1,3], [2,2], [1,2], [5,1], [1,4]],
);
for my $point_set (@tests) {
# display_points(@points);
find_alignments(@$point_set);
}
sub find_alignments {
my @points = @_;
my %directions = (
N => sub { $_[0]>[0] , $_[0]>[1] + 1 },
NE => sub { $_[0]>[0] + 1, $_[0]>[1] + 1 },
E => sub { $_[0]>[0] + 1, $_[0]>[1] },
SE => sub { $_[0]>[0] + 1, $_[0]>[1]  1 }
);
my %point_hash = map { my @a = @$_; "$$_[0];$$_[1]" => 1 } @points;
my $max_count = 0;
for my $point (@points) {
for my $dir (keys %directions) {
my $count = 1;
my @p = $directions{$dir}>($point);
while ($point_hash{"$p[0];$p[1]"}) {
@p = $directions{$dir}>([@p]);
$count++;
}
$max_count = $count if $count > $max_count;
}
}
say join " ", map { "(@{$_})" } @points;
say "Count: $max_count \n";
}
This program displays the following results:
$ perl maxpoints.pl
(1 1) (2 2) (5 5) (5 2) (3 3) (3 1) (2 7) (4 4)
Count: 5
(1 1) (2 2) (3 1) (1 3) (5 3)
Count: 3
(1 1) (4 2) (1 3) (2 2) (1 2) (5 1) (1 4)
Count: 4
Task 2: Sum Path
You are given binary tree containing numbers 09 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)
Sum Path in Raku
For this task, I also used a display
subroutine, which uses itself a bft
(breadthfirst traversal) recursive subroutine, but that’s not what was asked in the task and I have already covered that, so I’ll omit that from this post (see this blog post for an example), and only detail the dfs
(depthfirst search) recursive subroutine which does the work of going through all the path through the tree. The newsum
variable keep tasks of the total sum so far through the path and, when we reach a leaf (no subtree), we update the $*totalsum
.
use v6;
my @tests = [1, [2, [3,], [4,]]],
[1, [2, [4,]], [3, [5], [6]]],
[5, [4, [3, [7], [2]]], [8, [2], [9, [1]]]];
for @tests > @tree {
my $*totalsum = 0;
say @tree;
dfs(@tree, 0);
say $*totalsum;
}
sub dfs (@node, $sumsofar) {
my $newsum = $sumsofar + @node[0];
unless @node[1]:exists or @node[2]:exists {
$*totalsum += $newsum;
return;
}
dfs(@node[1], $newsum)
if defined @node[1];
dfs(@node[2], $newsum)
if defined @node[2];
}
This produces the following output:
$ raku sumpath.raku
[1 [2 [3] [4]]]
13
[1 [2 [4]] [3 [5] [6]]]
26
[5 [4 [3 [7] [2]]] [8 [2] [9 [1]]]]
71
Sum Path in Perl
This is a port to Perl of the Raku program above, also with a dfs
(depthfirst search) recursive subroutine.
#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
my @tests = ( [1, [2, [3,], [4,]]],
[1, [2, [4,]], [3, [5], [6, ]]],
[5, [4, [3, [7], [2]]], [8, [2], [9, [1]]]]
);
my $total_sum;
for my $tree (@tests) {
$total_sum = 0;
dfs($tree, 0);
say $total_sum;
}
sub dfs {
my ($node, $sum_so_far) = @_;
my $new_sum = $sum_so_far + $node>[0];
unless (exists $node>[1] or exists $node>[2]) {
$total_sum += $new_sum;
return;
}
dfs($node>[1], $new_sum)
if defined $node>[1];
dfs($node>[2], $new_sum)
if defined $node>[2];
}
This yields the same results as the Raku program:
$ perl sumpath.pl
13
26
71
Wrapping up
The next week Perl Weekly Challenge will start soon and will end next year, a year that we all hope will be better than this year. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, January 10, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.
Does your method find (0,0), (1,2), (2,4) collinear?
＞ that the points of a straight line have to be immediate neighbors and that the lines can only be horizontal, vertical or diagonal. ...
Hi Ben. Similar to Laurent, I also implemented a solution under a similar interpretation of "straight line(s)".
As I remember, the event organizer, Mohammad, has expressed that participants can implement a script as the coders preferred whatever reasonable.
I did my choice due to the two reasons.
The first is that the two examples provided are the diagonal lines with integralcoordinate points.
The second reason: If the only integer coordinates are concerned, cases like
{(0,0), (1,2), (2,4)}
are rare ‒ the maximum number of points on any one of these nondiagonal skewed lines is1+min(number_of_points, min(x_range_of_the_points, y_range_of_the_points))/2
. In applications (probably games, e.g. a tilematching game), usually just the fourdirection (horizontal, vertical, diagonal, antidiagonal) lines are considered.:)
Hi Ben, I basically agree with C.Y. Fung's answer. My method definitely doesn't look for points like (0,0), (1,2), (2,4). As I said in the introduction part, it appears that the given coordinates will be integers, that the points of a straight line have to be immediate neighbors (i.e. no gaps between them) and that the lines can only be horizontal, vertical or diagonal. Points like (0,0), (1,2), (2,4) don't fit this bill.
Checking for collinearity of three points in the completely general case is a matter of calculating the determinant of
1 x_1 y_1
1 x_2 y_2
1 x_3 y_3
like this
https://github.com/benkasminbullock/perlweeklychallengeclub/blob/master/challenge093/bkb/perl/ch1.pl#L37L48
Some other people such as Dave Jacoby had examples like this:
https://github.com/benkasminbullock/perlweeklychallengeclub/blob/master/challenge093/bkb/test/points.pl#L46
where he seemed to think that they were collinear.
https://github.com/benkasminbullock/perlweeklychallengeclub/blob/master/challenge093/davejacoby/perl/ch1.pl#L18