Perl Weekly Challenge: Zig Zag Melodies

Posted on by

Perl Weekly Challenge 389‘s tasks are “Reorder Notes” and “ZigZag Subarray”.

There’s a Roy Orbison song called Zig Zag from the soundtrack of a 1970 movie by the same name. It’s not that great compared to other Roy songs, but then again, it’s not that bad, either.

Task 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#

Approach

This task is fairly straightforward. First, we unpack the $melody structure into three variables: $composer for the composer name, which we promptly uppercase, @notes for the notes array, and @order for the permutation array.

Then we zip the two arrays so we get a data structure alternating the notes with the position they’re supposed to move to, and we use a new array @new to hold the reordered melody.

Raku

One of the things I had to do in Raku was add the .flat method to the lists I was extracting, otherwise I wound up with a list of lists, with the list as the first element.

sub reorder(@melody) {
  # unpack data
  my $composer = @melody[0].uc;
  my @notes = @melody[1].flat; # otherwise we get [[notes],]
  my @order = @melody[2].flat;
  # reorder data
  my @new;
  for (@notes Z @order) -> ($note, $i) { @new[$i-1] = $note; }
  "$composer => " ~ @new.join(" ")
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
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

Example 2:
Input: $melody = ['Beethoven', [qw(C D F# G Ab)], [1, 3, 5, 2, 4]]
Output: BEETHOVEN => C G D Ab F#

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#

Perl

Perl actually made things a little easier; since instead of passing lists of lists, I was passing a pointer to a list of scalars, the last two of which were pointers to lists. Importing List::AllUtils’ zip method let me create the interspersed list, and Perl added the ability to loop over multiple variables in a foreach loop as a stable feature in v5.40.0.

use List::AllUtils qw( zip );

sub reorder($melody) {
  # unpack data
  my $composer = uc $melody->[0];
  my @notes = @{$melody->[1]};
  my @order = @{$melody->[2]};
  my @new;
  foreach my ($note, $i) (zip @notes, @order) {
    $new[$i-1] = $note;
  }
  "$composer => " . join(" ", @new)
}

View the entire Perl script for this task on GitHub.

Python

The big thing in Python (and Elixir) are that lists can’t be assigned to randomly if they don’t already have elements. In Raku and Perl, having an empty list @list and then assigning a value to @list[6] will autovivify all the elements between 0 and 5 as undef. In Python and Elixir, we need to create the list with that many elements before we can randomly assign a value to them. Fortunately, in Python the idiom for creating an array of n undefined elements is [None] * n.

def reorder(melody):
  # unpack data
  composer = melody[0].upper()
  notes = melody[1]
  order = melody[2]
  # reorder data
  new = [None] * len(notes)
  for note, i in zip(notes, order): new[i-1] = note
  return f"{composer} => " + ' '.join(new)

View the entire Python script for this task on GitHub.

Elixir

And in Elxir, it’s a list comprehension: for _ <- 1..n, do: nil.

def reorder(melody) do
  # unpack data
  composer = Enum.at(melody, 0) |> String.upcase
  notes = Enum.at(melody, 1)
  order = Enum.at(melody, 2)
  # reorder data
  new = for _ <- 1..length(notes), do: nil
  new = Enum.zip(notes, order)
  |> Enum.reduce(new, fn {note, i}, new ->
    List.replace_at(new, i-1, note)
  end)
  |> Enum.join(" ")
  "#{composer} => #{new}"
end

View the entire Elixir script for this task on GitHub.

Task 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)

Approach

I figured the best way to determine if a subarray was ZigZag was through recursion: a subarray of length n is only ZigZag if the first n-1 elements are ZigZag and the last three elements alternate between greater and lesser. So a recursive check would handle the cases where n = 1 and n = 2 manually, and then recursively check cases where n > 2.

Then we just loop over the @nums array once, building subarrays by adding new elements to the end, checking to see if they’re ZigZag, and if they’re not, pulling elements off the front of the subarray until they are ZigZag again. And keeping track of the longest such subarray we build.

Raku

sub isZigZag(@nums) {
  # base cases
  return True if @nums.elems == 1;
  return @nums[0] != @nums[1] if @nums.elems == 2;

  # it's not ZigZag if the array isn't ZigZag before last element
  return False unless isZigZag(@nums[0..*-2]);
  return (
    (@nums[*-3] > @nums[*-2] && @nums[*-2] < @nums[*-1])
    ||
    (@nums[*-3] < @nums[*-2] && @nums[*-2] > @nums[*-1])
  );
}

sub longestZigZag(@nums) {
  my (@current, @longest);
  for 0..@nums.end -> $i {
    # put the $i-th element onto the current subset
    @current.push(@nums[$i]);
    if (isZigZag(@current)) {
      if (@current.elems > @longest.elems) {
        @longest = @current;
      }
    }
    else {
      # pull elements off the front until it's ZigZag again
      while (! isZigZag(@current)) {
        @current.shift;
      }
    }
  }
  return (@longest.elems, @longest);
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
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

ZigZag subarray: (4)

Example 5:
Input: @nums = (10, 20, 15, 12, 18)
Output: 3

ZigZag subarray: (10, 20, 15)

Perl

Caching subroutine output is still experimental in Raku, but it’s not in Perl, so heck yeah, I’m using it. On my machine, the Raku solution ran in 0.749s, but the Perl solution ran in 0.068s, an order of magnitude faster.

use Memoize;
memoize('isZigZag');

sub isZigZag(@nums) {
  # base cases
  return 1 if @nums == 1;
  return $nums[0] != $nums[1] if @nums == 2;

  # it's not ZigZag if the array isn't ZigZag before last element
  return 0 unless isZigZag(@nums[0..$#nums-1]);
  return (
    ($nums[-3] > $nums[-2] && $nums[-2] < $nums[-1])
    ||
    ($nums[-3] < $nums[-2] && $nums[-2] > $nums[-1])
  );
}

sub longestZigZag(@nums) {
  my (@current, @longest);
  for my $i ( 0..$#nums ) {
    # put the $i-th element onto the current subset
    push @current, $nums[$i];
    if (isZigZag(@current)) {
      if (scalar(@current) > scalar(@longest)) {
        @longest = @current;
      }
    }
    else {
      # pull elements off the front until it's ZigZag again
      while (! isZigZag(@current)) {
        shift @current;
      }
    }
  }
  return (scalar(@longest), \@longest);
}

View the entire Perl script for this task on GitHub.

Python

Python has subroutine caching through functools’ cache, but when I try to use it on is_zig_zag(), I get TypeError: unhashable type: 'list'. The way around that is to pass a tuple into is_zig_zag() instead of a list, since tuples are hashable while lists are not.

from functools import cache

@cache
def is_zig_zag(nums):
  # base cases
  if len(nums) == 1: return True
  if len(nums) == 2: return nums[0] != nums[1]

  # it's not ZigZag if the array isn't ZigZag before last element
  if not is_zig_zag(tuple(nums[0:-1])): return False
  return (
    (nums[-3] > nums[-2] and nums[-2] < nums[-1])
    or
    (nums[-3] < nums[-2] and nums[-2] > nums[-1])
  )

def longest_zig_zag(nums):
  current, longest = [], []
  for i in range(len(nums)):
    # put the $i-th element onto the current subset
    current.append(nums[i])
    if is_zig_zag(tuple(current)):
      if len(current) > len(longest):
        longest = current.copy()
    else:
      # pull elements off the front until it's ZigZag again
      while not is_zig_zag(tuple(current)):
        current.pop(0)
  return len(longest), longest

View the entire Python script for this task on GitHub.

Elixir

In Elixir, there’s a library for memoizing functions, but when I added it, the script ran in 0.850s. Without the library, the script ran in 0.578s.

Since I wanted an unbounded loop for pulling elements off the front of the current subarray if it wasn’t ZigZag, I wrote a recursive function to do it. Elixir has an idiom for getting the first element from a list and the remaining list: [first | remaining] (see line 25). Because I’m not actually using the first element (I’m just discarding it), I’m using the placeholder _ .

# base cases
def is_zig_zag(nums) when length(nums) == 1, do: true
def is_zig_zag(nums) when length(nums) == 2, do:
  Enum.at(nums, 0) != Enum.at(nums, 1)

def is_zig_zag(nums) do
  # it's only ZigZag if the array is ZigZag before last elem
  if is_zig_zag(Enum.slice(nums, 0..length(nums)-2)) do
    (Enum.at(nums, -3) > Enum.at(nums, -2)
      and
     Enum.at(nums, -2) < Enum.at(nums, -1))
    or
    (Enum.at(nums, -3) < Enum.at(nums, -2)
      and
     Enum.at(nums, -2) > Enum.at(nums, -1))
  else
    false
  end
end

# pull elements off the front until it's ZigZag again
def while_not_zig_zag([_ | current]) do
  if is_zig_zag(current) do
    current
  else
    while_not_zig_zag(current)
  end
end

def longest_zig_zag(nums) do
  {_, longest} =
  Enum.reduce(0..length(nums)-1, {[], []},
    fn i, {current, longest} ->
      # put the $i-th element onto the current subset
      current = current ++ [Enum.at(nums, i)]
      if is_zig_zag(current) do
        if length(current) > length(longest) do
          {current, current}
        else
          {current, longest}
        end
      else
        { while_not_zig_zag(current), longest}
      end
    end)
  { length(longest), longest }
end

View the entire Elixir script for this task on GitHub.

Here’s all my solutions in GitHub: https://github.com/packy/perlweeklychallenge-club/tree/challenge-389-packy-anderson/challenge-389/packy-anderson

Leave a Reply