| 04 September 2026 | Challenge 389 |
ZigZag Melodies
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#
Solution
Preliminary Considerations
This section has become much more extensive than I had intended. Indeed, it is disproportionate compared to the terse solutions. Basically, it is about the differences between some implementation details in Perl and J.
Starting with some notations:
- A permutation is a bijection from a finite set onto itself and independent from its representation.
- A permutation can be uniquely represented by its one-line form using the numbers \(1,\ldots,n\). Calling this representation a one-based permutation. This is the format used in this task.
- For the usage in programming languages that use zero-based arrays, permutations in one-line form usually use the numbers \(0,\ldots,n - 1\) as these can be used directly as array indices. Calling this representation a zero-based permutation.
Using the latter two just for convenience: Actually there is no such thing as a X-based permutation. These are abbreviations for “a permutation represented in one-line form starting from index X”
Trying not to restrict the possible solution by a too specific problem description of this task’s core:
Given a permuted list and a corresponding order, find the origin list.
There are several ways to accomplish this. Describing three approaches in terms of Perl. See below for their corresponding J implementations.
Reverse Assignment
Consider a zero-based permutation @p first.
It can be applied to a list @s by using it as slice indices:
@t = @s[@p]
To recover @s from given @t and @p, the operation may be reverted:
@s[@p] = @t
For a one-based permutation @p1 these operations need to be adjusted.
Taking @p1 as indices would exclude $s[0] and would access $s[@s] beyond the end of the array.
To fix this, we may either subtract one from all elements in @p1 or we unshift the elements of @s to their expected positions.
This results in:
unshift @s, undef;
@t = @s[@p1];
These steps can be reversed, too:
@s[@p1] = @t;
shift @s;
To apply @p to @s, its base must be known or determined.
In the reverse operation, the situation is simpler:
shift on @s is required only if $s[0] is undefined.
Inverse Permutation
Consider a zero-based permutation @p and perform an index sort on it:
@q = sort {$p[$a] <=> $p[$b]} 0 .. $#p
Applying @q to @p brings it into ascending order:
@p[@q] # 0 .. $#p
The result represents the identity permutation and
therefore @q is the inverse of @p.
Applying it to @t recovers @s:
@s = @t[@q]
This approach does not require @p to be a permutation at all.
It just defines the order.
Therefore there is no need to differentiate between zero- or one-based @p.
This flexibility has its price: the effort of a sort.
Sort Using
The generation of the inverse permutation of @p may be omitted.
By building pairs of elements from @p and @t, the array @t may be sorted using @p.
Ideally, both arrays would be zipped together.
Without modules, a hash may serve as a simplified substitute.
Sort the pairs by their @p-component and pick the @ts:
@pt{@p} = @t;
@s = map $pt{$_}, sort {$a <=> $b} keys %pt;
This may be viewed as a combination of the first two approaches.
If @p is known to be a zero-based permutation, the result may be simplified to:
@s = @pt{0 .. $#p}
or, for a one-based permutation:
@s = @pt{1 .. @p}
The sort omits the construction of an inverse permutation and is usable on non-permutations.
The requirement for @p are:
- same length as
@t - unique integer values
Perl
Implementing the “reverse assignment” approach.
use v5.24;
use warnings;
sub reorder_notes {
my ($composer, $notes, $perm) = shift()->@*;
(\my @ordered)->@[@$perm] = @$notes;
shift @ordered unless defined $ordered[0];
"@{[uc $composer]} => @ordered";
}
This implementation accepts zero- and one-based permutations.
See the full solution to task 1.
J
A “reverse assignment” can be achieved with the “amend” adverb } in J.
For a zero-based permutation p it may look like
s =: p ]`[ } t
or, for a one-based permutation:
s =: p ]`(<:@[) } t
or by adjusting p to zero-base, a base-agnostic version:
s =: p ]`((- <./)@[) } t
This looks more complex than its Perl counterpart.
Next looking at the “inverse permutation” approach:
J has the bivalent verb /:.
The monad /: is called “grade up” and constructs the permutation that sorts the items of y into ascending order, i.e. it performs an index sort and - if
applied to a permutation - it generates its inverse.
The result has to be applied to t.
Combining both in a hook:
s =: t ({~ /:) p
Already simpler than its (grown) Perl counterpart.
Finally, the dyad /: is called “sort up (using)” and sorts x in the order given by y:
s =: t /: p
It couldn’t be simpler.
Following this approach.
NB. process the given melody that is represented as a list of three
NB. boxed elements:
NB. - composer
NB. - notes: a list of boxed notes
NB. - permutation
reorder_notes =: _(adverb define)
NB. verbs to fetch composer, notes and permutation from melody
'`composer notes perm' =. (0&{::)`(1&{::)`(2&{::)
NB. - sort notes using perm
NB. - join reordered notes with blanks, opening boxes
NB. - prepend composer converted to upper case
(toupper@composer , ' => ' , ' ' joinstring notes /: perm) f. : [:
)
This implementation accepts any list of integers in the length of “notes” as the “permutation”.
reorder_notes 'Bach';('C';'D';'E';'F#';'G';'A';'B');(7 1 6 2 5 3 4)
BACH => D F# A B G E C
The same with a non-permutation order:
reorder_notes 'Bach';('C';'D';'E';'F#';'G';'A';'B');(64 1 32 2 16 4 8)
BACH => D F# A B G E C
See the full solution.
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)
Solution
First compare each pair of adjacent elements and flip the sign of every other result. Then count repeated nonzero values and find the maximum thereof.
This gives the number of zig-zag pairs. The requested count of elements is one more.
Perl
Use PDL’srle to count repeated elements.
use strict;
use warnings;
use PDL;
use PDL::NiceSlice;
sub zig_zag {
return 1 if @_ < 2;
my $arr = long @_;
my $steps = $arr(0:-2) <=> $arr(1:-1);
$steps *= (-1)**sequence $steps;
my ($len, $val) = rle $steps;
($len * $val->abs)->max + 1;
}
See the full solution to task 2.
J
Instead of flipping step signs, uses a “cyclic gerund” to compare adjacent pairs, run length are computed “manually”, but in general it operates in the same way as the Perl solution.
NB. find the maximum length of a zig-zag subarray
zig_zag =: _(adverb define)
NB. alternating compare adjacent pairs as "x cmp y" and "y cmp x"
pair_alt_cmp =. [: * 2 (-/)`(-~/)\ ]
NB. a "1" followed by "1"s at positions where the value in y changes:
NB. this marks the frets for intervals of running equal values
ri =. 1 , 2 ~:/\ ]
NB. find the lengths of intervals specified by x, for nonzero values only
rl_nz =. (# * |@{.);.1
NB. max over a list
max =. >./
NB. increment by one
inc =. >:
NB. - get steps with alternating signs
NB. - get run lengths of non-zero values
NB. - find the maximum
NB. - increment
inc @ max @ (rl_nz~ ri) @ pair_alt_cmp f. : [:
)
zig_zag 9 4 2 10 7 8 8 1 9
5
See the full solution.