The weekly challenge 389 - Task 1: Reorder Notes

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-389/#TASK1
 3 #
 4 # Task 1: Reorder Notes
 5 # =====================
 6 #
 7 # You are given an array [composer, notes, permutation], reconstruct the melody
 8 # by using each permutation value as the destination position of the
 9 # corresponding note. Use no explicit for, foreach, or while loops. Output each
10 # result as COMPOSER => reordered notes.
11 #
12 ##    ASSUMPTION: Input is valid; the notes array and permutation array have
13 ##    identical lengths, and the permutation contains each position from 1 to N
14 ##    exactly once.
15 #
16 ## Example 1
17 ##
18 ## Input: $melody = ['Bach', [qw(C D E F# G A B)], [7, 1, 6, 2, 5, 3, 4]]
19 ## Output: BACH => D F# A B G E C
20 ##
21 ## Note 1 (C)  moves to position 7.
22 ## Note 2 (D)  moves to position 1.
23 ## Note 3 (E)  moves to position 6.
24 ## Note 4 (F#) moves to position 2.
25 ## Note 5 (G)  moves to position 5.
26 ## Note 6 (A)  moves to position 3.
27 ## Note 7 (B)  moves to position 4.
28 #
29 ## Example 2
30 ##
31 ## Input: $melody = ['Beethoven', [qw(C D F# G Ab)], [1, 3, 5, 2, 4]]
32 ## Output: BEETHOVEN => C G D Ab F#
33 ##
34 ## Note 1 (C)  stays at position 1.
35 ## Note 2 (D)  moves to position 3.
36 ## Note 3 (F#) moves to position 5.
37 ## Note 4 (G)  moves to position 2.
38 ## Note 5 (Ab) moves to position 4.
39 #
40 ## Example 3
41 ##
42 ## Input: $melody = [ 'Brahms', [qw(C Db Eb F G Ab Bb C D)], [9, 3, 7, 1, 8, 5, 2, 6, 4] ]
43 ## Output: BRAHMS => F Bb Db D Ab C Eb G C
44 #
45 ## Example 4
46 ##
47 ## Input: $melody = [ 'Bruckner', [qw(G F# Bb C D Eb F)], [4, 7, 2, 6, 1, 5, 3] ]
48 ## Output: BRUCKNER => D Bb F G Eb C F#
49 #
50 ## Example 5
51 ##
52 ## Input: $melody = ['Berg', [qw(C#)], [1]]
53 ## Output: BERG => C#
54 #
55 ############################################################
56 ##
57 ## discussion
58 ##
59 ############################################################
60 #
61 # We need to loop somehow, so we use map() on the possible indices
62 # in the two arrays. We just need to map everything into an output
63 # array. Since the permutation gives a 1-based array, we add an
64 # unnecessary element to the output array first, which we then
65 # remove before the final output.
66 
67 use v5.36;
68 
69 reorder_notes(['Bach', [qw(C D E F# G A B)], [7, 1, 6, 2, 5, 3, 4]]);
70 reorder_notes(['Beethoven', [qw(C D F# G Ab)], [1, 3, 5, 2, 4]]);
71 reorder_notes([ 'Brahms', [qw(C Db Eb F G Ab Bb C D)], [9, 3, 7, 1, 8, 5, 2, 6, 4] ]);
72 reorder_notes([ 'Bruckner', [qw(G F# Bb C D Eb F)], [4, 7, 2, 6, 1, 5, 3] ]);
73 reorder_notes(['Berg', [qw(C#)], [1]]);
74 
75 sub reorder_notes($melody) {
76     my ($composer, $notes, $permutation) = @$melody;
77     my @P = @$permutation;
78     my @out = ("X");
79     map { $out[$permutation->[$_]] = $notes->[$_] } 0..$#P;
80     shift @out;
81     say "Output: " . uc($composer) . " => " . join(" ", @out);
82 }