Perl Weekly Challenge: Week 333
Challenge 1:
Straight Line
You are given a list of co-ordinates.
Write a script to find out if the given points make a straight line.
Example 1
Input: @list = ([2, 1], [2, 3], [2, 5])
Output: true
Example 2
Input: @list = ([1, 4], [3, 4], [10, 4])
Output: true
Example 3
Input: @list = ([0, 0], [1, 1], [2, 3])
Output: false
Example 4
Input: @list = ([1, 1], [1, 1], [1, 1])
Output: true
Example 5
Input: @list = ([1000000, 1000000], [2000000, 2000000], [3000000, 3000000])
Output: true
I had to dig deep into my memories of high school geometry for this one.
The first order of business is to get the input into the script. Each element of
@list
becomes a command-line argument in the form x,y
. This is turned back into
a List
of point co-ordinates called @coords
using .split()
. The hyperoperator »
applies the split to each element of @list
. Because the command-line arguments are strings, we have to convert the coordinates to numbers
using »
again but this time with .Int()
.
my @coords = @list».split(',')».Int;
Now we calculate the slope of the first two points.
my ($x0, $y0) = @coords[0];
my ($x1, $y1) = @coords[1];
my $dx = $x1 - $x0;
my $dy = $y1 - $y0;
For the third and any subsequent points we can test for collinearity by checking the cross-multiplication of its' coordinates with its' difference to the first point. If they do not match, the slope is different so the current point is not on a straight line with the first point; we print "False" and exit the script.
for @coords[2..*] -> ($x, $y) {
if ($dx * ($y - $y0) != $dy * ($x - $x0)) {
say "False";
exit;
}
}
If all points pass this test, we know we have a straight line so we can print "True".
say "True";
This is the Perl version. We have to do some operations slightly differently to deal with Perls' awkward handling of subarrays but otherwise it is the same as Raku.
my @coords = map { [split q{,}] } @list;
my ($x0, $y0) = @{$coords[0]};
my ($x1, $y1) = @{$coords[1]};
my $dx = $x1 - $x0;
my $dy = $y1 - $y0;
for my $coord (@coords[2 .. $#coords]) {
my ($x, $y) = @{$coord};
if ($dx * ($y - $y0) != $dy * ($x - $x0)) {
say "False";
exit;
}
}
say "True";
Challenge 2:
Duplicate Zeros
You are given an array of integers.
Write a script to duplicate each occurrence of zero, shifting the remaining elements to the right. The elements beyond the length of the original array are not written.
Example 1
Input: @ints = (1, 0, 2, 3, 0, 4, 5, 0)
Output: (1, 0, 0, 2, 3, 0, 0, 4)
Each zero is duplicated.
Elements beyond the original length (like 5 and last 0) are discarded.
Example 2
Input: @ints = (1, 2, 3)
Output: (1, 2, 3)
No zeros exist, so the array remains unchanged.
Example 3
Input: @ints = (1, 2, 3, 0)
Output: (1, 2, 3, 0)
Example 4
Input: @ints = (0, 0, 1, 2)
Output: (0, 0, 0, 0)
Example 5
Input: @ints = (1, 2, 0, 3, 4)
Output: (1, 2, 0, 0, 3)
The Raku solution to this one is one line. Ignoring the bits that are only for formatting the output in the style of the spcc, it works like this:
The input is captured from command-line arguments in @*ARGS
. Using .map()
we iterate through it. If an
element is not 0, it can be converted to boolean True
; if it is 0, it will convert to False
. The problem is
the elements of @*ARGS
are Strings
. We need to force them to be treated as numbers and one way to do that is
to add 0 to them.
say q{(}, @*ARGS.map({ $_ + 0 ?? $_ !! |(0,0) })[^@*ARGS.elems].join(q{, }), q{)}
We can also do this in one line in Perl. In fact, the Perl version is slightly shorter because we don't
need to force numeric context in map()
and syntax such as @ARGV
, $#ARGV
and the ternary operator are shorter.
say q{(}, (join q{, }, (map {$_ ? $_ : (0,0)} @ARGV)[0..$#ARGV]), q{)}