This post is part of a series on Mohammad Anwar’s excellent Weekly Challenge, where hackers submit solutions in Perl, Raku, or any other language, to two different challenges every week. (It’s a lot of fun, if you’re into that sort of thing.)

Task 1: Balanced Strings

Our first task this week is to take a string matching /^[a-z0-9]$/ and produce the lexicographically smallest string with alternating letters and numbers. If it’s not possible to produce a string without two letters or numbers in a row, return ''.

For example, 1bca2 should return a1b2c, whereas 1a23 returns the empty string because there are too many numbers vs. letters.

Easy enough. For this I’ll use mesh() from the core module List::Util. mesh() takes two (or more) arrays and gives you alternating values from each of them. Perfect for what we need. We just need to make sure we have the same number of letters and numbers (or one more).

use List::Util qw< mesh >;
no warnings 'uninitialized';

sub balanced {
    die "`$_[0]' must contain [a-z0-9]" if $_[0] !~ /^[a-z0-9]*$/;
    my ($one, $two) = ([], []);

    push @{ /\d/ ? $one : $two }, $_ for sort split '', $_[0];
    return "" if abs(@$one - @$two) > 1; # Unbalanced

    join '', mesh sort { @$b <=> @$a } $one, $two;
}

That last sort { @$b <=> @$a } $one, $two is not sorting the elements of $one and $two! It’s sorting the order of the arrays themselves, putting the one with more elements first. This ensures we don’t have to have two numbers or letters in a row. For example, if we have abc and 1234, we had better start with a number, or we’d end up with a1b2c34, which is invalid.

Task 2: Max Score

This task is a partitioning problem. Given a string of 1s and 0s, we’re to split it into two non-empty substrings. The score is the sum of 0s in the left string, plus 1s in the right string.

For example, given 0011, the best possible split would be 00 | 11 for a score of 2 + 2 = 4. We don’t need to return the substrings, just the best possible score.

use List::Util qw< max >;

sub max_score {
    return 0 if $_[0] eq '';
    my ($l, $r) = split //, $_[0], 2;
    my $s = !$l + $r =~ tr/1//;
    max 0+$s, map { $s += $_ ? -1 : 1 } split //,substr $r,0,-1;
}

What I do here is split the input into $l and $r ($l is just the first character, $r is the rest.) The 3rd argument to split limits the number of strings returned, which is why I don’t get all of the individual characters.

After that I calculate an initial $s (score) by adding !$l (since 0s on the left are worth 1, and vice-versa), plus $r =~ tr/1//, which counts the number of 1s in $r. This is a well-known Perl idiom. sum split '', $r, or any number of other options would also work.

The last line returns the max of the initial score and the score for each possible partition. (We need to do something like 0+$s here to convince Perl to look at the initial value of $s, rather than whatever it ends up as when Perl evaluates it.)

Sometimes you get significantly faster results using string manipulation directly (substr, in this case), so I tried that:

sub max_score_ugly_fast {
    return 0 if $_[0] eq '';
    my $s = !substr($_[0],0,1) + substr($_[0],1) =~ tr/1//;
    max 0+$s, map { $s += substr($_[0],$_,1) ? -1 : 1 } 1..length($_[0])-2;
}

However, I find this to be rather ugly, and it’s only a few percent faster on average, so I wouldn’t use this. The algorithm for both of these is already linear, which is the best we can do, so only constant overhead can be improved.

Usually I try to write readable code, or if something with a lot of tight looping needs optimizing, I might use Inline::C, but we’ve seen that movie before on this blog, more than once, and it’s not particularly interesting in this case.

Tests

I’ve included tests again this week. To run them, run prove from the ryan-thompson/perl directory.