Perl Weekly Challenge: Alternate Tune, Alternate View

Posted on by

Perl Weekly Challenge 394‘s tasks are “Alternate Case” and “Alternating Vowels Consonants”.

The word isn’t a major part of the song, but “alternate” does get repeated and repeated at the end of side two of Tales from Topographic Oceans: “The Remembering (High the Memory)“. So, sure, have 20+ minutes of Yes from 1973 while we work on this challenge…

Task 1: Alternate Case

You are given a string containing an equal number of uppercase and lowercase English letters.

Write a script to the minimum number of adjacent character swaps needed to turn the given string into an alternate case string.

Example 1

Input: $str = "aAbB"
Output: 0

Example 2

Input: $str = "AAbb"
Output: 1

Swap 1: "AbAb"

Example 3

Input: $str = "AAAbbb"
Output: 3

Swap 1: "AAbAbb"
Swap 2: "AbAAbb"
Swap 3: "AbAbAb"

Example 4

Input: $str = "aABb"
Output: 1

Swap 1: "aAbB"

Example 5

Input: $str = "bBBAaa"
Output: 2

Swap 1: "BbBAaa"
Swap 2: "BbBaAa"

Approach

The way I’m approaching this is to look for runs of equal numbers of uppercase and lowercase characters, and then swapping the two middle characters, and repeating the process until we get a string of just alternating characters. To find the runs of equal numbers of uppercase and lowercase characters, I’m building a regex using a repetition quantifier (in Raku, **n, in PCREs, {n}), then compiling the regex. My method produces the same number of swaps as the examples, but in example 5 it performs the swap later in the string first, rather than second.

For checking whether the string is strictly alternating, I’m using the regex
/^(?:[a-z]?(?:[A-Z][a-z])+|[A-Z]?(?:[a-z][A-Z])+)$/.

Raku

Of course, Raku’s regex language is different from Perl’s (and Python and Elixir use Perl’s syntax). Non-capturing grouping is [ ], not (?: ). We can easily specify upper and lowercase characters with <:Lu> and <:Ll>, and whitespace is ignored by default.

Also, you can pass parameters to named regexes in Raku, as you can see on lines 8-10 and 18. This is how I’m building the regex that finds the runs of equal numbers of uppercase and lowercase characters.

my regex isAlternating {
  ^[ <:Ll>?[<:Lu><:Ll>]+ | <:Lu>?[<:Ll><:Lu>]+ ]$
}

my regex noalt($i) {
  (<:Lu> ** {$i} <:Ll> ** {$i} | <:Ll> ** {$i} <:Lu> ** {$i})
}

sub alternateCase($str is copy) {
  return (0, []) if $str ~~ /<isAlternating>/;
  my @swaps;
  loop {
    my $i = $str.chars div 2;
    for (1 .. $i).reverse -> $j {
      if (my $m = $str ~~ /<noalt($j)>/) {
        my $match = $m.Str;
        my $start = $m.from + (($m.chars div 2) - 1);
        my $flip = $str.substr($start, 2).flip;
        $str.substr-rw($start, 2) = $flip;
        @swaps.push($str);
        last;
      }
    }
    return (@swaps.elems, @swaps) if $str ~~ /<isAlternating>/;
  }
}

View the entire Raku script for this task on GitHub.

$ raku/ch-1.raku
Example 1:
Input: $str = "aAbB"
Output: 0

Example 2:
Input: $str = "AAbb"
Output: 1

Swap 1: "AbAb"

Example 3:
Input: $str = "AAAbbb"
Output: 3

Swap 1: "AAbAbb"
Swap 2: "AbAAbb"
Swap 3: "AbAbAb"

Example 4:
Input: $str = "aABb"
Output: 1

Swap 1: "AaBb"

Example 5:
Input: $str = "bBBAaa"
Output: 2

Swap 1: "bBBaAa"
Swap 2: "BbBaAa"

Perl

In Perl, I’m not naming the regular expressions, I’m putting them in subroutines. Also, because the information about where the match occurred is localized, I returned a hashref that emulated the information I was using from a Raku Match object.

sub isAlternating($s) {
  $s =~ /^(?: [a-z]?(?:[A-Z][a-z])+ | [A-Z]?(?:[a-z][A-Z])+ )$/x;
}

sub noalt($s, $i) {
  if ($s =~ /([A-Z]{$i} [a-z]{$i} | [a-z]{$i} [A-Z]{$i})/x) {
    # emulate raku match object
    { match => $1, from => $-[0], chars => length($1) }
  }
}

sub alternateCase($str) {
  return 0 if isAlternating($str);
  my @swaps;
  do {
    my $i = int(length($str) / 2);
    for my $j (reverse 1 .. $i) {
      next unless my $m = noalt($str, $j);
      my $start = $m->{from} + (int($m->{chars} / 2) - 1);
      my $flip = reverse substr($str, $start, 2);
      substr($str, $start, 2) = $flip;
      push @swaps, $str;
      last;
    }
  } until isAlternating($str);
  return (scalar(@swaps), @swaps);
}

View the entire Perl script for this task on GitHub.

Python

Python had built-in match objects, but in order to compile the regular expression with the repetition quantifier, I needed to build the regex as a string. I thought about using an f-string to interpolate the value for the repetition, but because the curly braces are used for interpolation in f-strings, I would have to specify the curly braces for repetition using Unicode, and it would look like this

  noalt = (f'([A-Z]\u007b{i}\u007d[a-z]\u007b{i}\u007d|' +
           f'[a-z]\u007b{i}\u007d[A-Z]\u007b{i}\u007d)')

So I ditched interpolation and just built the string with +str(i)+.

import re

is_alternating = re.compile('^(?:[a-z]?(?:[A-Z][a-z])+|' +
                            '[A-Z]?(?:[a-z][A-Z])+)$')

def no_alt(s, i):
  noalt = ('([A-Z]{'+str(i)+'}[a-z]{'+str(i)+'}|' +
            '[a-z]{'+str(i)+'}[A-Z]{'+str(i)+'})')
  noalt = re.compile(noalt)
  return noalt.search(s)

def alternate_case(s):
  if is_alternating.match(s): return 0, []
  swaps = []
  while True:
    i = len(s) // 2
    for j in range(i, 0, -1):
      m = no_alt(s, j)
      if m:
        start = m.start() + (len(m.group()) // 2) - 1
        flip = s[start:start+2][::-1]
        s = s[:start] + flip + s[start+2:]
        swaps.append(s)
        break
    if is_alternating.match(s): return len(swaps), swaps

View the entire Python script for this task on GitHub.

Elixir

Elixir’s Regex.run/3 can return either the matched string or a tuple indicating the byte index and match length, so we’re using the latter form, since we’re not actually using the matched string. I could have built an emulation of Raku’s match object, but since the info I needed was in the tuple, I didn’t bother. I did, however, emulate Perl’s substr function so make substituting a string in the middle of another string by position look a little cleaner.

def is_alternating(str) do
  Regex.match?(
    ~r/^(?:[a-z]?(?:[A-Z][a-z])+|[A-Z]?(?:[a-z][A-Z])+)$/,
    str
  )
end

def no_alt(str, i) do
  Regex.compile!("([A-Z]{#{i}}[a-z]{#{i}}|" <>
                  "[a-z]{#{i}}[A-Z]{#{i}})")
  |> Regex.run(str, [return: :index])
end

# approximate perl's substr
def substr(str, start, replace) do
  len  = String.length(replace)
  head = String.slice(str, 0, start)
  tail = String.slice(str, start+len, String.length(str))
  head <> replace <> tail
end

def alternate_case(str, swaps) do
  if is_alternating(str) do
    {length(swaps), swaps}
  else
    i = div(String.length(str), 2)
    {str, swaps} = Enum.reduce_while(i..1//-1, {str, swaps},
    fn j, {str, swaps} ->
      m = no_alt(str, j)
      if m do
        {from, chars} = hd(m) # de-listify and unpack tuple
        start = from + div(chars, 2) - 1
        flip  = String.slice(str, start, 2)
        str   = substr(str, start, String.reverse(flip))
        {:halt, {str, swaps ++ [str]}}
      else
        {:cont, {str, swaps}}
      end
    end)
    if is_alternating(str) do
      {length(swaps), swaps}
    else
      alternate_case(str, swaps)
    end
  end
end

def alternate_case(str) do
  alternate_case(str, [])
end

View the entire Elixir script for this task on GitHub.

Task 2: Alternating Vowels Consonants

You are given three strings containing English alphabetic characters.

Find all the longest contiguous substrings common to all three strings that strictly alternate between vowels and consonants.

Example 1

Input: @str = ("relocate", "delocate", "allocate")
Output: ("locate")

Example 2

Input: @str = ("apple", "banana", "cherry")
Output: ()

Example 3

Input: @str = ("navigate", "cavity", "gravity")
Output: ("avi")

Example 4

Input: @str = ("pedalgia", "pedalboard", "pedantic")
Output: ("peda")

Example 5

Input: @strings = ("schoolmaster", "schoolhouse", "schooling")
Output: ("ho", "ol")

Approach

The approach is simple: for each string, generate all the substrings, and only keep the ones that have alternating vowels and consonants. Put those in a set/bag/hash structure that will allow us to perform an intersection, and then use that to determine the substrings that are common to all the provided strings. Sort by length to find the longest substring, and then filter the list to return all strings of that length.

Raku

This gave me a chance to play with Raku regular expressions. One of the things I found was that Raku’s enumerated character classes allow you to define a character class and then remove characters from that class. The usual way to define a match for consonants is <-[aeiou]>, which matches any character that isn’t a vowel. Which is fine if the input is always lowercase alphabetic characters… but that also matches numbers and punctuation, as well as a bunch of unicode characters. However, if I defined the class to be lowercase alphabetic characters, and then remove the vowels from that class, I’m left with just lowercase consonants.

I then define a regex to match strings with alternating vowels and consonants of at least two characters in length; and create a function to create an empty BagHash, loop over all the two-char or longer substrings of a given string, and to add the substrings matching that regex to the BagHash. After its processed all the substrings, it returns the BagHash.

Then the main function just uses that function to get a BagHash for the first string, and then loop over the remaining strings, taking an intersection of the BagHashes until we have just the common substrings. After sorting to get the longest substring, and filtering to get all substrings of the same length as the longest, I sort that list again so the output is consistent across implementations.

my regex vowels     { <[aeiou]> }
my regex consonants { <[a..z] - [aeiou]> }

my regex isAlternating {
  ^[ <vowels>?    [ <consonants> <vowels> ]+ |
     <consonants>?[ <vowels> <consonants> ]+ ]$
}

sub altSubstrings($s) {
  my $substrings = BagHash.new;
  for 0 .. $s.chars -> $i  {
    for (2 .. $s.chars - $i).reverse -> $j {
      my $sub = $s.substr($i, $j);
      $substrings.add($sub) if $sub ~~ /<isAlternating>/;
    }
  }
  $substrings;
}

sub lcs(@arr) {
  my $bag = altSubstrings(shift @arr);
  $bag ∩= altSubstrings($_) for @arr;
  my $longest = $bag.keys.sort(*.chars).reverse.first;
  $bag.keys.grep( *.chars == $longest.chars ).sort;
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: @arr = ("relocate", "delocate", "allocate")
Output: ("locate")

Example 2:
Input: @arr = ("apple", "banana", "cherry")
Output: ()

Example 3:
Input: @arr = ("navigate", "cavity", "gravity")
Output: ("avi")

Example 4:
Input: @arr = ("pedalgia", "pedalboard", "pedantic")
Output: ("peda")

Example 5:
Input: @arr = ("schoolmaster", "schoolhouse", "schooling")
Output: ("ho", "ol")

Perl

The big thing I learned doing the Perl version is that Perl has Extended Bracketed Character Classes (Also called regex_sets), which allow you to do the same thing as I was doing in Raku: defining a set of characters, and then intersecting that set with another set. See line 7 for the syntax.

I used Set::Bag to give myself an intersection function. The rest of the solution reads like the Raku version.

use Set::Bag;

my $vowels     = qr/[aeiou]/;
my $consonants = qr/(?[ [a-z] & [^aeiou] ])/;

sub isAlternating($s) {
  $s =~ /^(?: $vowels?    (?: $consonants $vowels )+ |
              $consonants?(?: $vowels $consonants )+ )$/x;
}

sub altSubstrings($s) {
  my %substrings;
  for my $i (0..length($s)-1) {
    for my $j (reverse 2 .. length($s)-$i) {
      my $sub = substr($s, $i, $j);
      $substrings{$sub} = 1 if isAlternating($sub);
    }
  }
  Set::Bag->new(%substrings);
}

sub lcs(@arr) {
  my $bag = altSubstrings(shift @arr);
  $bag &= altSubstrings($_) for @arr;
  my ($longest) = sort {length($b)<=>length($a)} $bag->elements;
  sort grep { length($_) == length($longest)} $bag->elements;
}

View the entire Perl script for this task on GitHub.

Python

When I was coding the Python solution, I ran into another snag: Python didn’t like sorting an empty list, so I added a clause to bail from my main function early once I knew there weren’t any common substrings.

import re
from collections import Counter

vowels     = '[aeiou]'
consonants = '[^aeiou]'

is_alternating = re.compile(
  '^(?:' + vowels + '?(?:' + consonants + vowels + ')+|' +
       consonants + '?(?:' + vowels + consonants + ')+)$'
)

def alt_substrings(s):
  substrings = Counter()
  for i in range(len(s)):
    for j in range(len(s), 1, -1):
      sub = s[i:j]
      if is_alternating.match(sub): substrings[sub] = 1
  return substrings

def lcs(arr):
  bag = alt_substrings(arr.pop(0))
  while arr:
    bag = bag & alt_substrings(arr.pop(0))
  if not list(bag): return [] # bail early
  longest = sorted(list(bag), key=len, reverse=True)[0]
  return sorted([ s for s in list(bag) if len(s)==len(longest) ])

View the entire Python script for this task on GitHub.

Elixir

And in Elixir, rather than dealing with nested Enum.reduce/3 calls to handle the nested for loops, I implemented them through recursion.

@vowels     "[aeiou]"
@consonants "[^aeiou]"
@is_alternating Regex.compile!(
  "^(?:"<>@vowels<>"?(?:"<>@consonants<>@vowels<>")+|" <>
      @consonants<>"?(?:"<>@vowels<>@consonants<>")+)$"
)

def alt_substrings(s, i, j, substrings) do
  sub = String.slice(s, i, j-i)
  substrings =
    if Regex.match?(@is_alternating, sub),
      do: Map.put(substrings, sub, 1),
      else: substrings
  cond do
    j > i ->
      alt_substrings(s, i, j-1, substrings)
    i < String.length(s) ->
      alt_substrings(s, i+1, String.length(s), substrings)
    true ->
      substrings
  end
end

def alt_substrings(s) do
  alt_substrings(s, 0, String.length(s), %{})
end

def lcs(arr) do
  bag = alt_substrings(hd(arr))
  list = Enum.reduce(tl(arr), bag, fn s, bag ->
    Map.intersect(bag, alt_substrings(s))
  end) |> Map.keys
  if Enum.empty?(list) do
    []
  else
    sorted = Enum.sort(
      list, &( String.length(&1) >= String.length(&2))
    )
    longest = hd(sorted)
    Enum.filter(sorted, fn s ->
      String.length(s) == String.length(longest)
    end) |> Enum.sort
  end
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-394-packy-anderson/challenge-394/packy-anderson

Leave a Reply