Perl Weekly Challenge: Balanced Adagio for Strings

Posted on by

I’m stretching the musical theme for Perl Weekly Challenge 342. Task 1 is “Balanced String”, and when I was thinking about strings, I thought of Samuel Barber’s Adagio for Strings.

But don’t cry—we’ll have fun with “Balanced String” and “Max Score”.

Task 1: Balance String

You are given a string made up of lowercase English letters and digits only.

Write a script to format the give string where no letter is followed by another letter and no digit is followed by another digit. If there are multiple valid rearrangements, always return the lexicographically smallest one. Return empty string if it is impossible to format the string.

Example 1

Input: $str = "a0b1c2"
Output: "0a1b2c"

Example 2

Input: $str = "abc12"
Output: "a1b2c"

Example 3

Input: $str = "0a2b1c3"
Output: "0a1b2c3"

Example 4

Input: $str = "1a23"
Output: ""

Example 5

Input: $str = "ab123"
Output: "1a2b3"

Approach

The addendum “If there are multiple valid rearrangements, always return the lexicographically smallest one” was what made this task clear to me. What we’re going to do is separate the list into two lists, one of letters and one of numbers. If the lists’ lengths are different by more than 1, it’s impossible to format a string where no letter is followed by another letter and no digit is followed by another digit (for example, if there were one letter and three numbers).

Once we have the lists, we sort them lowest to highest, and then start building the output string starting with taking a character from the longer list (if both are the same length, we start with the numeric list), and then alternating lists until we’ve exhausted both.

Elixir

For funsies, I decided to tackle the Elixir problem first, so my other solutions would use recursion, since I always need to use recursion in Elixir. But when I sat down, I wondered if I would need recursion. Getting the list of letters and numbers (lines 14-19) was easy enough, and then getting the lengths of those lists was also straightforward.

Elixir has an Enum.zip_reduce/4 function which I could use to interleave the two lists, but the catch is that it stops once one of the enumerables has run out of elements. In our use case, we need to be able to take that last element from the longer list and append it to the end of the output string, so there’s where I had to roll my own zip routine to handle that.

  def my_zip([], [], str), do: str

  def my_zip([a], [], str), do: str <> a

  def my_zip([a | longer], [b | shorter], str) do
    str = str <> a <> b
    my_zip(longer, shorter, str)
  end

  def balance_str(str) do
    letters = String.graphemes(str)
      |> Enum.filter(fn c -> c =~ ~r/[a-z]/ end)
      |> Enum.sort
    numbers = String.graphemes(str)
      |> Enum.filter(fn c -> c =~ ~r/\d/ end)
      |> Enum.sort

    numlen = length(numbers)
    letlen = length(letters)

    cond do
      abs(numlen - letlen) > 1 ->
        ""
      letlen > numlen ->
        my_zip(letters, numbers, "")
      true ->
        my_zip(numbers, letters, "")
    end
  end

View the entire Elixir script for this task on GitHub.

$ elixir/ch-1.exs
Example 1:
Input: $str = "a0b1c2"
Output: "0a1b2c"

Example 2:
Input: $str = "abc12"
Output: "a1b2c"

Example 3:
Input: $str = "0a2b1c3"
Output: "0a1b2c3"

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

Example 5:
Input: $str = "ab123"
Output: "1a2b3"

Raku

In Raku, the Zip metaoperator has the same problem, it stops when it runs out of elements in one of the lists:

$ raku
Welcome to Rakudo™ Star v2025.04.
Implementing the Raku® Programming Language v6.d.
Built on MoarVM version 2025.04.

To exit type 'exit' or '^D'
[0] > my @letters = "0a2b1c3".comb(/<[a..z]>/).sort;
[a b c]
[1] > my @numbers = "0a2b1c3".comb(/\d/).sort;
[0 1 2 3]
[2] > (@numbers Z~ @letters).join
0a1b2c

So in order to get that last element off the longer list, we need to roll our own. Plus, this gives me the chance to show off Raku’s multi-dispatch functionality!

multi my_zip([], [], $str) { $str }

multi my_zip(@longer, [], $str) {
  $str ~ @longer.shift
}

multi my_zip(@longer, @shorter, $str is copy) {
  $str ~= @longer.shift ~ @shorter.shift;
  my_zip(@longer, @shorter, $str);
}

sub balance_str($str) {
  my @letters = $str.comb(/<[a..z]>/).sort;
  my @numbers = $str.comb(/\d/).sort;

  return "" if abs(@letters - @numbers) > 1;
  if (@letters > @numbers) {
    return my_zip(@letters, @numbers, "");
  }
  else {
    return my_zip(@numbers, @letters, "");
  }
}

View the entire Raku script for this task on GitHub.

Perl

Perl, however, doesn’t have multiple dispatch functionality, so I can’t define functions that have different code depending on what arguments they’re called with. Fortunately, the code is fairly easy to translate back into an if–elsif structure. I’m still doing the recursion, though.

sub my_zip($longer, $shorter, $str) {
  $str .= shift(@$longer) . shift(@$shorter);
  if (@$shorter) {
    return my_zip($longer, $shorter, $str);
  }
  elsif (@$longer) {
    $str .= shift(@$longer);
  }
  return $str;
}

sub balance_str($str) {
  my @letters = sort grep { /[a-z]/ } split //, $str;
  my @numbers = sort grep { /\d/    } split //, $str;

  return "" if abs(@letters - @numbers) > 1;
  if (@letters > @numbers) {
    return my_zip(\@letters, \@numbers, "");
  }
  else {
    return my_zip(\@numbers, \@letters, "");
  }
}

View the entire Perl script for this task on GitHub.

Python

And Python has the same lack of multiple dispatch in the core libraries (I see a few external libraries that claim to do it, but I’m not that attached to multiple dispatch).

def my_zip(longer, shorter, mystr):
  mystr += longer.pop(0) + shorter.pop(0)
  if len(shorter) > 0:
    return my_zip(longer, shorter, mystr)
  elif len(longer) > 0:
    return mystr + longer.pop(0)
  return mystr

def balance_str(mystr):
  letters = sorted([
    c for c in list(mystr) if not c.isnumeric()
  ])
  numbers = sorted([
    c for c in list(mystr) if     c.isnumeric()
  ])
  if abs(len(letters) - len(numbers)) > 1:
    return ""
  if len(letters) > len(numbers):
    return my_zip(letters, numbers, "")
  else:
    return my_zip(numbers, letters, "")

View the entire Python script for this task on GitHub.

Task 2: Max Score

You are given a string, $str, containing 0 and 1 only.

Write a script to return the max score after splitting the string into two non-empty substrings. The score after splitting a string is the number of zeros in the left substring plus the number of ones in the right substring.

Example 1

Input: $str = "0011"
Output: 4

1: left = "0", right = "011" => 1 + 2 => 3
2: left = "00", right = "11" => 2 + 2 => 4
3: left = "001", right = "1" => 2 + 1 => 3

Example 2

Input: $str = "0000"
Output: 3

1: left = "0", right = "000" => 1 + 0 => 1
2: left = "00", right = "00" => 2 + 0 => 2
3: left = "000", right = "0" => 3 + 0 => 3

Example 3

Input: $str = "1111"
Output: 3

1: left = "1", right = "111" => 0 + 3 => 3
2: left = "11", right = "11" => 0 + 2 => 2
3: left = "111", right = "1" => 0 + 1 => 1

Example 4

Input: $str = "0101"
Output: 3

1: left = "0", right = "101" => 1 + 2 => 3
2: left = "01", right = "01" => 1 + 1 => 2
3: left = "010", right = "1" => 2 + 1 => 3

Example 5

Input: $str = "011101"
Output: 5

1: left = "0", right = "11101" => 1 + 4 => 5
2: left = "01", right = "1101" => 1 + 3 => 4
3: left = "011", right = "101" => 1 + 2 => 3
4: left = "0111", right = "01" => 1 + 1 => 2
5: left = "01110", right = "1" => 2 + 1 => 3

Approach

I’m sure there’s some clever way to do this, but really, if we just run through the string and generate all the splits: for each character in the string after the first, we try splitting the string at that character, generate a list of the 0s in the left and a list of the 1s in the right, and sum the length of the lists.

Raku

But I still wanted to play around with multi… this time, however, I needed to have the max_score function work differently when the value in $split was equal to (or greater than) the number of characters in $str, meaning that the split had run off the end of the string. I had to go digging through the Raku docs, but I found it in the where clause in the Functions docs.

multi max_score($str, $split where $split >= $str.chars, $count,
                $max, $explain) {
  # there's no more to split!
  return ($max, $explain);
}

multi max_score($str, $split, $count,
                $max is copy, $explain is copy) {
  my $left  = $str.substr(0, $split);
  my $right = $str.substr($split);
  my $zeros = $left.comb(/0/).elems;
  my $ones  = $right.comb(/1/).elems;
  my $sum   = $zeros + $ones;
  $explain ~= qq{\n$count: left = "$left", right = "$right"}
           ~  qq{ => $zeros + $ones => $sum};
  $max = max($max, $sum);
  return max_score($str, $split+1, $count+1, $max, $explain);
}

multi max_score($str) {
  max_score($str, 1, 1, 0, "");
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
Example 1:
Input: $str = "0011"
Output: 4

1: left = "0", right = "011" => 1 + 2 => 3
2: left = "00", right = "11" => 2 + 2 => 4
3: left = "001", right = "1" => 2 + 1 => 3


Example 2:
Input: $str = "0000"
Output: 3

1: left = "0", right = "000" => 1 + 0 => 1
2: left = "00", right = "00" => 2 + 0 => 2
3: left = "000", right = "0" => 3 + 0 => 3


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

1: left = "1", right = "111" => 0 + 3 => 3
2: left = "11", right = "11" => 0 + 2 => 2
3: left = "111", right = "1" => 0 + 1 => 1


Example 4:
Input: $str = "0101"
Output: 3

1: left = "0", right = "101" => 1 + 2 => 3
2: left = "01", right = "01" => 1 + 1 => 2
3: left = "010", right = "1" => 2 + 1 => 3


Example 5:
Input: $str = "011101"
Output: 5

1: left = "0", right = "11101" => 1 + 4 => 5
2: left = "01", right = "1101" => 1 + 3 => 4
3: left = "011", right = "101" => 1 + 2 => 3
4: left = "0111", right = "01" => 1 + 1 => 2
5: left = "01110", right = "1" => 2 + 1 => 3

Perl

But Perl still doesn’t have multi (damn!) so I had to make one of the functions have a different name and put the stopping criterion into that function:

sub max_score2($str, $split, $count,
                $max, $explain) {
  my $left  = substr($str, 0, $split);
  my $right = substr($str, $split);
  my $zeros = scalar(grep { /0/ } split //, $left);
  my $ones  = scalar(grep { /1/ } split //, $right);
  my $sum   = $zeros + $ones;
  $explain .= qq{\n$count: left = "$left", right = "$right"}
           .  qq{ => $zeros + $ones => $sum};
  $max = max($max, $sum);
  if (length($right) == 1) {
    # there's no more to split!
    return ($max, $explain);
  }
  return max_score2($str, $split+1, $count+1, $max, $explain);
}

sub max_score($str) {
  max_score2($str, 1, 1, 0, "");
}

View the entire Perl script for this task on GitHub.

Python

Really, the Python solution is just the Perl solution in Python syntax. To me, the big differences are extracting the substring with slicing notation and using list comprehension to build the list of 0s and 1s instead of a function like grep.

def max_score2(mystr, split, count, maxval, explain):
  left  = mystr[0:split]
  right = mystr[split:]
  zeros = len([ c for c in list(left)  if c == "0" ])
  ones  = len([ c for c in list(right) if c == "1" ])
  mysum = zeros + ones
  explain += (
    f'\n{count}: left = "{left}", right = "{right}"' +
    f' => {zeros} + {ones} => {mysum}'
  )
  maxval = max(maxval, mysum)
  if len(right) == 1:
    # there's no more to split!
    return maxval, explain
  return max_score2(mystr, split+1, count+1, maxval, explain)

def max_score(mystr):
 return max_score2(mystr, 1, 1, 0, "")

View the entire Python script for this task on GitHub.

Elixir

The Elixir solution looks like the multiple dispatch Raku version, with one big difference: because only certain expressions are allowed in guard clauses, I couldn’t have when split > String.length(str) as the guard clause. Fortunately, I don’t change the length of str throughout the script, so I could just pass String.length(str) in as another parameter len, and then the guard became when split >= len. Also, I don’t know if I’ve mentioned it before, but if a parameter isn’t used in a particular instance of a multiple dispatch function, but you need to have the parameter there because the function needs to have the same arity as another function, you need either prepend the parameter name with _ or just make the name of the parameter the character _. I usually just use the single underscore because I don’t need to document what that parameter is called in another version of the function, I just want to indicate it’s not being used here.

def max_score(_, len, split, _, max, explain)
  when split >= len, do: {max, explain}

def max_score(str, len, split, count, max, explain) do
  left  = String.slice(str, 0, split)
  right = String.slice(str, split, len)
  zeros = left |> String.graphemes
    |> Enum.filter(fn c -> c == "0" end) |> length
  ones  = right|> String.graphemes
    |> Enum.filter(fn c -> c == "1" end) |> length
  sum   = zeros + ones
  explain = explain
    <> "\n#{count}: left = \"#{left}\", right = \"#{right}\""
    <> " => #{zeros} + #{ones} => #{sum}"
  max = max(max, sum)
  max_score(str, len, split+1, count+1, max, explain)
end

def max_score(str) do
  max_score(str, String.length(str), 1, 1, 0, "")
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/master/challenge-342/packy-anderson

Leave a Reply