Perl Weekly Challenge: Week 396
Challenge 1:
Finishing Order
You are given two array of integers,
@orderand@friends.The
@order(sizen) contains every integer from 1 tonexactly once. The@friendscontains ID in sorted in strictly increasing order.Write a script to return the array containing IDs in finishing order.
Example 1
Input: @order = (3, 1, 4, 2, 5)
@friends = (1, 2, 4)
Output: (1, 4, 2)
ID 1 finished 2nd.
ID 4 finished 3rd.
ID 2 finished 4th.
Example 2
Input: @order = (5, 4, 3, 2, 1)
@friends = (1, 3, 5)
Output: (5, 3, 1)
ID 5 finished 1st.
ID 3 finished 3rd.
ID 1 finished 5th.
Example 3
Input: @order = (2, 4, 1, 3)
@friends = (1, 2, 3, 4)
Output: (2, 4, 1, 3)
ID 2 finished 1st.
ID 4 finished 2nd.
ID 1 finished 3rd.
ID 3 finished 4th.
Example 4
Input: @order = (4, 1, 3, 2)
@friends = (3)
Output: (3)
Example 5
Input: @order = (1, 3, 2, 6, 5, 4)
@friends = (1, 2, 3)
Output: (1, 3, 2)
ID 1 finished 1st.
ID 3 finished 2nd.
ID 2 finished 3rd.
Getting the input into the script requires two command-line arguments each containing
space separated elements. E.g. for example 3, the input would look like this: "3 4 1 3" "1 2 3 4
These are reconstituted into the @orders and @friends arrays by splitting them with
.words().
my @order = $order.words;
my @friends = $friends.words;
Then all we really need to do is find the position in @orders of each element in @friends and .sort() them into ascending numeric order. I intially thought of
using .index() which does this type of find but that only works on Strings. Fortunately
the List class has a method .first() which does the equivalent. And more actually so we
pass it the :k parameter to only return the position of the found element. The rest of
the code is only for formatting the output in the same way as in the spec.
say q{(},
@friends.sort({ @order.first($^a, :k) <=> @order.first($^b, :k) }).join(q{, }),
q{)};
For Perl, we will need a replacement for .first(). This is my attempt at creating one.
first() takes two parameters, $needle is an element to search for and @haystack
is an array to search in.
sub first($needle, @haystack) {
The current position in @haystack is stored in $index
my $index = 0;
We go through each element in @haystack incrementing $index each time.
for my $i (@haystack) {
$index++;
if the current element is the same as the $needle, we return $index.
if ($i == $needle) {
return $index;
}
}
If we have gone through the entire @haystack and not found the $needle, we
return undef.
return undef;
}
Now the rest of the script is just like the Raku version.
my @order = split /\s+/, $order;
my @friends = split /\s+/, $friends;
say q{(},
(join q{, }, sort { first($a, @order) <=> first($b, @order) } @friends),
q{)};
Challenge 2:
Trionic Array
Write a script to return true if the given array is Trionic otherwise return false.
An array is trionic if there exist indices 0 < p < q < n − 1 such that arr[0 … p] is strictly increasing, arr[p … q] is strictly decreasing, and arr[q … n − 1] is strictly increasing.
Example 1
Input: @arr = (1, 3, 5, 4, 2, 6, 8)
Output: true
Choose p = 2 and q = 4
$arr[0..2] = (1, 3, 5) (strictly increasing)
$arr[2..4] = (5, 4, 2) (strictly decreasing)
$arr[4..6] = (2, 6, 8) (strictly increasing)
Valid indices: 0 < p (2) < q (4) < n-1 (6).
Example 2
Input: @arr = (1, 4, 4, 2, 1, 3, 5)
Output: false
The first segment (1, 4, 4) contains duplicate adjacent values, so it is not strictly increasing.
No valid p and q exist to satisfy all three strictly monotonic conditions.
Example 3
Input: @arr = (2, 10, 3, 1, 9)
Output: true
Choose p = 1 and q = 3.
$arr[0..1] = (2, 10) (strictly increasing)
$arr[1..3] = (10, 3, 1) (strictly decreasing)
$arr[3..4] = (1, 9) (strictly increasing)
Example 4
Input: @arr = (1, 2, 3, 4, 3, 2, 1)
Output: false
This is a standard mountain array (strictly increasing, then strictly decreasing).
There is no second valley (q) that transitions back into a strictly increasing third segment before reaching the end of the array.
Example 5
Input: @arr = (1, 3, 6, 4, 2, 7, 8, 4)
Output: false
We need to define three bits of information before proceeding.
First is the length of @arr which I am calling $n.
my $n = @arr.elems;
The second is the position of the current element in @arr we are looking at.
it defaults to 1 because we start from the second element (i.e. @arr[1].)
my $index = 1;
Finally a flag to record whether @arr is trionic.
my $isTrionic = False;
Now we consume the first strictly increasing run until it starts decreasing or
we reach the end of @arr.
while $index < $n && @arr[$index] > @arr[$index - 1] {
$index++;
}
We have to back up one element and, this time, start a run of strictly decreasing
elements until it starts increasing or we reach the end of @arr.
my $peakIndex = $index - 1;
if $peakIndex > 0 && $index < $n {
while $index < $n && @arr[$index] < @arr[$index - 1] {
$index++;
}
If we haven't reached the and of @arr, we have to back up one element and start
a final run of strictly increasing elements. This one must reach the end of @arr.
my $valleyIndex = $index - 1;
if $valleyIndex > $peakIndex && $index < $n {
while $index < $n && @arr[$index] > @arr[$index - 1] {
$index++;
}
If all three of these runs are non-zrro and we are at the end of @arr, @arr is
trionic otherwise $isTrionic remains false.
$isTrionic = $index == $n;
}
}
We print the value of $isTrionic.
say $isTrionic;
For once we don't need any extra code to emulate Raku; Perl has everything we need.
my $n = scalar @arr;
my $index = 1;
my $isTrionic = false;
while ($index < $n && $arr[$index] > $arr[$index - 1]) {
$index++;
}
my $peakIndex = $index - 1;
if ($peakIndex > 0 && $index < $n) {
while ($index < $n && $arr[$index] < $arr[$index - 1]) {
$index++;
}
my $valleyIndex = $index - 1;
if ($valleyIndex > $peakIndex && $index < $n) {
while ($index < $n && $arr[$index] > $arr[$index - 1]) {
$index++;
}
$isTrionic = $index == $n;
}
}
say $isTrionic ? 'true' : 'false';