Perl Weekly Challenge: Week 389
Challenge 1:
Reorder Notes
You are given an array [composer, notes, permutation], reconstruct the melody by using each permutation value as the destination position of the corresponding note. Use no explicit for, foreach, or while loops. Output each result as COMPOSER => reordered notes.
ASSUMPTION: Input is valid; the notes array and permutation array have identical lengths, and the permutation contains each position from 1 to N exactly once.
Example 1
Input: $melody = ['Bach', [qw(C D E F# G A B)], [7, 1, 6, 2, 5, 3, 4]]
Output: BACH => D F# A B G E C
Note 1 (C) moves to position 7.
Note 2 (D) moves to position 1.
Note 3 (E) moves to position 6.
Note 4 (F#) moves to position 2.
Note 5 (G) moves to position 5.
Note 6 (A) moves to position 3.
Note 7 (B) moves to position 4.
Example 2
Input: $melody = ['Beethoven', [qw(C D F# G Ab)], [1, 3, 5, 2, 4]]
Output: BEETHOVEN => C G D Ab F#
Note 1 (C) stays at position 1.
Note 2 (D) moves to position 3.
Note 3 (F#) moves to position 5.
Note 4 (G) moves to position 2.
Note 5 (Ab) moves to position 4.
Example 3
Input: $melody = [ 'Brahms', [qw(C Db Eb F G Ab Bb C D)], [9, 3, 7, 1, 8, 5, 2, 6, 4] ]
Output: BRAHMS => F Bb Db D Ab C Eb G C
Example 4
Input: $melody = [ 'Bruckner', [qw(G F# Bb C D Eb F)], [4, 7, 2, 6, 1, 5, 3] ]
Output: BRUCKNER => D Bb F G Eb C F#
Example 5
Input: $melody = ['Berg', [qw(C#)], [1]]
Output: BERG => C#
We take the input in as three command-line arguments assigned to $composer, $notes and $permutation. E.g. 'Brahms' 'C Db Eb F G Ab Bb C D' '9 3 7 1 8 5 2 6 4' for example 3. Basically we are going to use this data to populate a
hash and print it out in a certain format.
The hash part consists of splitting the $permutation into individual elements with
.words() and equating them as keys to elements of $notes (also split) as values
with the Z=> operator.
my %reorder = $permutation.words Z=> $notes.words;
To format this hash in the style requested by the spec we first convert $composer
to all caps using .uc. The '=>' is just a simple string and can be copied as is.
Then we sort the keys of the hash (the $permutation) in ascending numeric order
and get the values associated with them (the $notes,) with .map() and.join() them all by spaces and print the result with say().
say $composer.uc, ' => ',
%reorder.keys.sort({ $^a <=> $^b }).map({ %reorder{$_} }).join(q{ });
For Perl we need to do things slightly differently.
We still get the input data from the command-line but we split the last to parameters there and then, giving us the arrays @notes and @permutations.
my $composer = $ARGV[0];
my @notes = split /\s+/, $ARGV[1];
my @permutation = split /\s+/, $ARGV[2];
We don't have Z=> but we can achieve the same result by map()ing the elements of @permutation to the elements of @notes using the indices of `@permutation.
This will work because the spec assures us that both arrays will be of the same length.
my %reorder = map { $permutation[$_] => $notes[$_] } keys @permutation;
say uc $composer, ' => ',
(join q{ }, map { $reorder{$_} } sort { $a <=> $b } keys %reorder );
Challenge 2:
ZigZag Subarray
You are given an array of integers.
Write a script to find the length of the longest contiguous subarray where the numbers alternate between strictly increasing and strictly decreasing (a ZigZag pattern).
A sequence of numbers $A = [a0, a1, …, ak]$ with length $k >= 1 is considered a ZigZag sequence if every adjacent pair alternates direction:
a_0 < a_1 > a_2 < a_3 > ...
OR
a_0 > a_1 < a_2 > a_3 < ...
NOTE: A single element (length 1) or any two distinct elements (length 2) are automatically valid ZigZag sequences. Equal adjacent numbers (e.g., 5, 5) break the pattern.
Example 1
Input: @nums = (9, 4, 2, 10, 7, 8, 8, 1, 9)
Output: 5
ZigZag subarray: (4, 2, 10, 7, 8)
Example 2
Input: @nums = (1, 7, 4, 9, 2, 5)
Output: 6
ZigZag subarray: (1, 7, 4, 9, 2, 5)
Example 3
Input: @nums = (1, 2, 3, 4, 5)
Output: 2
ZigZag subarray: (1, 2)
Example 4
Input: @nums = (4, 4, 4)
Output: 1
Example 5
Input: @nums = (10, 20, 15, 12, 18)
Output: 3
ZigZag subarray: (10, 20, 15)
I'll start with the Perl version first because that is where <=> or 'spaceship`
operator, which is the centerpiece of this solution, originally came from. Now
many other languages have adopted it including Raku and even C++. This operator
compares two numeric values and returns -1 if the first operand is less than the
second, 0 if both are equal or 1 if the second is greater than the first.
We start the script by defining storage for the length of the subarray we are currently analyzing.
my $current = 1;
Another scalar holds the length of the longest zigzag subarray found so far.
my $longest = $current;
And a third, will hold the result of the last application of the spaceship operator or, in other words, if we are zigging or zagging.
my $direction = 0;
Then for each element starting from the second (index 1) to the end, we compare
it to the element before it assigning the result to $difference.
for my $i (1 .. scalar @nums - 1) {
my $difference = $nums[$i] <=> $nums[$i - 1];
If the two elements are equal, we have to start a new subarray by setting
$current to 1. $direction is 0 for sameness.
if ($difference == 0) {
$current = 1;
$direction = 0;
If $difference is the opposite of $direction it means we are zigging after
zagging or zagging after zigging. In that case we increment the length of the
$current subarray and set $direction to $difference.
} elsif ($difference == -$direction) {
$current++;
$direction = $difference;
The last scenario is where the $difference is the same as $direction. In
this case we have a zig followed by another zig or a zag followed by another zag
but unlike the first case, the two elements are not equal. This makes a subarray
of length 2 and $direction is set to $difference.
} else {
$current = 2;
$direction = $difference;
}
If the current subarray is longer than the longest subarray found so far, it becomes
the new $longest.
if ($current > $longest) {
$longest = $current;
}
}
Finally, we print $longest.
say $longest;
In Raku, <=> returns one of the three values in the enumaration, Less, Same, More. Otherwise the Raku version works exactly the same as in Perl.
my $current = 1;
my $longest = $current;
my $direction = Same;
for 1 .. @nums.end -> $i {
my $difference = @nums[$i] <=> @nums[$i - 1];
if $difference == Same {
$current = 1;
$direction = Same;
} elsif $difference == -$direction {
$current++;
$direction = $difference;
} else {
$current = 2;
$direction = $difference;
}
if $current > $longest {
$longest = $current;
}
}
say $longest;