Perl Weekly Challenge: Week 328

Challenge 1:

Replace All ?

You are given a string containing only lower case English letters and ?.

Write a script to replace all ? in the given string so that the string doesn’t contain consecutive repeating characters.

Example 1

Input: $str = "a?z"
Output: "abz"

There can be many strings, one of them is "abz".
The choices are 'a' to 'z' but we can't use either 'a' or 'z' to replace the '?'.

Example 2

Input: $str = "pe?k"
Output: "peak"

Example 3

Input: $str = "gra?te"
Output: "grabte"

We take the input string from the command-line and as command-line arguments. Using the .subst() method, we find all instances of a ? character in the string. We also need to know the characters on either side of the ?. The enclosing characters are passed to a function newChar() which will be explained below. The return values of this function are substituted for the matched characters. The modified string is printed out with .say().

$str.subst(/(.) \? (.)/, { newChar($0, $1) }, :g ).say;

The spec just says we need to replace ? with any lower-case letter except the ones around it. I decided to make it a random letter just because. The newChar() function makes it all happen.

It takes two parameters $left and $right which are the two characters adjoining the ?.

sub newChar($left, $right) {

The replacement character is set to the left one so the following loop will run at least once. I could have used $right too.

    my $replacement = $left;

While the replacement character is equal to the left or right one...

    while $replacement eq $left || $replacement eq $right {

...we randomly select a lower-case letter using the .pick() method.

        $replacement = ('a' .. 'z').pick;
    }

When we have one which is not $left or $right, the loop ends and we return a string concatenating $left, $replacement and $right which will be substituted into the result.

    return "$left$replacement$right";
}

(Full code on Github.)

For the Perl version, we have to provide a replacement for .pick(). My implementation looks like this:

sub pick(@array) {
    return $array[int(rand(@array))];
}

Other than that, the rest is pretty much a straight translation of the Raku code.

sub newChar($left, $right) {
    my $replacement = $left;

    while ($replacement eq $left || $replacement eq $right) {
        $replacement = pick('a' .. 'z');
    }

    return "$left$replacement$right";
}

$_ = shift; s/(.) \? (.)/newChar($1, $2)/egx; say;

(Full code on Github.)

Challenge 2:

Good String

You are given a string made up of lower and upper case English letters only.

Write a script to return the good string of the given string. A string is called good string if it doesn’t have two adjacent same characters, one in upper case and other is lower case.

UPDATE [2025-07-01]: Just to be explicit, you can only remove pair if they are same characters, one in lower case and other in upper case, order is not important.

Example 1

Input: $str = "WeEeekly"
Output: "Weekly"

We can remove either, "eE" or "Ee" to make it good.

Example 2

Input: $str = "abBAdD"
Output: ""

We remove "bB" first: "aAdD"
Then we remove "aA": "dD"
Finally remove "dD".

Example 3

Input: $str = "abc"
Output: "abc"

We can do this task as a one-liner in both Raku and Perl.

I'll start with Perl. We get the input from the first command-line argument with shift(). It is assigned to $_ so we can shave off a few characters.

In a while loop, we use s/// to look for instances of a lower-case character followed by the same character but upper-case or vice-versa and remove it. I feel my regular expression could be optimized but what I have works. Why a loop and not s///g? Because that would have failed for example 2.

When all such substitutions have been made, we have a good string so we print it with say().

$_ = shift; while ( s/([a-z])(??{uc $1}) | ([A-Z])(??{lc $2})// ) {} say

(Full code on Github.)

The Raku version is for once less compact. One thing which always trips me up is that if you have a capture group reference like $0 and you want to use it within the regular expression itself, you need to insert a code block (even an empty one) behind the match. So annoying.

$_ = @*ARGS[0]; while s/( (<[a..z]>) {} $($0.uc) ) || ( (<[A..Z]>) {} $($0.lc) ) // {}; .say

(Full code on Github.)