Perl Weekly Challenge 389.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 389.
Task 1: Reorder Notes
Submitted by: Reinier Maliepaard
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#
Instead of explicit loops I could use tail recursion. I use a
recursive function to walk over @ARGV, three terms at a
time, taking advantage of the old parameter style, and I
make another recursive function to build the output array,
one note at a time. The result fits a two-liner.
Examples:
perl -E '
sub f{($C,$N,$P,@R)=@_;say("$C -> ",join " ",g([],map{[split" "]}$N,$P)->@*),
f(@R)if$C;}sub g($C,$N,$P){$C->[pop @$P]=pop@$N,g($C,$N,$P)if @$N;$C}f(@ARGV);
' 'Bach' 'C D E F# G A B' '7 1 6 2 5 3 4' \
'Beethoven' 'C D F# G Ab' '1 3 5 2 4' \
'Brahms' 'C Db Eb F G Ab Bb C D' '9 3 7 1 8 5 2 6 4' \
'Bruckner' 'G F# Bb C D Eb F' '4 7 2 6 1 5 3' \
'Berg' 'C#' '1'
Results:
Bach -> D F# A B G E C
Beethoven -> C G D Ab F#
Brahms -> F Bb Db D Ab C Eb G C
Bruckner -> D Bb F G Eb C F#
Berg -> C#
The full code is:
1 # Perl weekly challenge 389
2 # Task 1: Reorder Notes
3 #
4 # See https://wlmb.github.io/2026/08/31/PWC389/#task-1-reorder-notes
5 use v5.36;
6 use feature qw(try);
7 use List::Util qw(all);
8 die <<~"FIN" unless @ARGV and @ARGV%3==0;
9 Usage: $0 C0 N0 P0 C1 N1 P1...
10 to arrange the notes Ni of the composition by composer Ci
11 applying the permutation Pi
12 FIN
13
14 sub walk{
15 my ($composer, $notes, $permutations, @rest) = @_;
16 if($composer){
17 try {
18 my @notes = split " ", $notes;
19 my @permutations = split " ", $permutations;
20 die "Number of notes should equal number of permutations"
21 unless @notes==@permutations;
22 die "Index out of range" unless all {1<=$_<=@permutations} @permutations;
23 say "$composer -> ",
24 join " ",
25 permute_notes([], [@notes], [@permutations])->@*;
26 }
27 catch($e){
28 warn "${e}Composer=$composer, Notes=$notes, Permutation=$permutations";
29 }
30 walk(@rest);
31 }
32 }
33
34 sub permute_notes($current, $notes, $permutations){
35 if(@$notes){
36 my $note=pop @$notes;
37 my $place=pop @$permutations;
38 die "Repeated destination: $place" if defined $current->[$place-1];
39 $current->[$place-1]=$note;
40 permute_notes($current, $notes, $permutations)
41 }
42 return $current;
43 }
44
45 walk(@ARGV);
Examples:
./ch-1.pl 'Bach' 'C D E F# G A B' '7 1 6 2 5 3 4' \
'Beethoven' 'C D F# G Ab' '1 3 5 2 4' \
'Brahms' 'C Db Eb F G Ab Bb C D' '9 3 7 1 8 5 2 6 4' \
'Bruckner' 'G F# Bb C D Eb F' '4 7 2 6 1 5 3' \
'Berg' 'C#' '1'
Results:
Bach -> D F# A B G E C
Beethoven -> C G D Ab F#
Brahms -> F Bb Db D Ab C Eb G C
Bruckner -> D Bb F G Eb C F#
Berg -> C#
Examples with errors:
./ch-1.pl 2>&1 'Bach' 'C D E F# G A B' '1 6 2 5 3 4' \
'Beethoven' 'C D F# G Ab' '1 1 5 2 4' \
'Brahms' 'C Db Eb F G Ab Bb C D' '10 3 7 1 8 5 2 6 4' \
'Bruckner' 'G F# Bb C D Eb F' '0 7 2 6 1 5 3' \
Results:
Number of notes should equal number of permutations at ./ch-1.pl line 21.
Composer=Bach, Notes=C D E F# G A B, Permutation=1 6 2 5 3 4 at ./ch-1.pl line 29.
Repeated destination: 1 at ./ch-1.pl line 39.
Composer=Beethoven, Notes=C D F# G Ab, Permutation=1 1 5 2 4 at ./ch-1.pl line 29.
Index out of range at ./ch-1.pl line 23.
Composer=Brahms, Notes=C Db Eb F G Ab Bb C D, Permutation=10 3 7 1 8 5 2 6 4 at ./ch-1.pl line 29.
Index out of range at ./ch-1.pl line 23.
Composer=Bruckner, Notes=G F# Bb C D Eb F, Permutation=0 7 2 6 1 5 3 at ./ch-1.pl line 29.
Task 2: ZigZag Subarray
Submitted by: Roger Bell_West
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 use the spaceship operator <=> to compare succesive
terms in the array. I change sign to each second comparison
result. A zigzag sequence corresponds to a sequence of 1’s
or of -1’s. Thus I count all such sequences and chose the
largest using the max function from List::Util. The
result fits a 2.5-liner.
Examples:
perl -MList::Util=max -E '
for(@ARGV){($c,@r)=split" ";push(@s,$c<=>($d=shift @r)),$c=$d while(@r);$s[2*$_]*=-1
for 0..(@s-1)/2;my @r;while(@s){$c=1;$d=shift@s;++$c if$d;++$c,shift @s while$s[0]*$d==1;
push@r,$c;}say "$_ -> ", max @r}
' "9 4 2 10 7 8 8 1 9" "1 7 4 9 2 5" "1 2 3 4 5" "4 4 4" "10 20 15 12 18"
Results:
9 4 2 10 7 8 8 1 9 -> 5
1 7 4 9 2 5 -> 6
1 2 3 4 5 -> 2
4 4 4 -> 1
10 20 15 12 18 -> 3
The full code is:
1 # Perl weekly challenge 389
2 # Task 2: ZigZag Subarray
3 #
4 # See https://wlmb.github.io/2026/08/31/PWC389/#task-2-zigzag-subarray
5 use v5.36;
6 use List::Util qw(max);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S0 S1...
9 to find the longest zigzag subsequence of the space separated
10 sequence Si="N0 N1..." where Nj are numbers.
11 FIN
12
13 for(@ARGV){
14 my ($current, @rest)=split" ";
15 my @signs;
16 while(@rest){
17 push(@signs, $current <=> (my $next = shift @rest));
18 $current = $next;
19 }
20 $signs[2*$_] *= -1 for 0..(@signs-1)/2;
21 my @lengths;
22 while(@signs){
23 my $count = 1;
24 my $first_sign = shift @signs;
25 ++$count if $first_sign;
26 ++$count, shift @signs while @signs && $signs[0]*$first_sign==1;
27 push @lengths, $count;
28 }
29 say "$_ -> ", max @lengths;
30 }
Example:
./ch-2.pl "9 4 2 10 7 8 8 1 9" "1 7 4 9 2 5" "1 2 3 4 5" "4 4 4" "10 20 15 12 18"
Results:
9 4 2 10 7 8 8 1 9 -> 5
1 7 4 9 2 5 -> 6
1 2 3 4 5 -> 2
4 4 4 -> 1
10 20 15 12 18 -> 3
/;
Written on August 31, 2026