Perl Weekly Challenge: Week 342
Challenge 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"
This turned out to be a bit more involved than I initially thought it would be. For the longest time my code gave a different answer for example 2. I was ready to blame the answer in the example being wrong but I figured it all outin the end.
The script takes a string input as a command-line argument. It splits the input string into two sorted arrays:
@letters containing only lowercase letters and @digits containing only digits.
my @letters = $str.comb.grep({ /<lower>/ }).sort;
my @digits = $str.comb.grep({ /<digit>/ }).sort;
Then we determine if the answer should begin with a digit or letter. Digits go first if we have fewer letters than digits.
my $digitFirst = @digits.elems >= @letters.elems;
If the difference in lengths between @letters and @digits is greater than one, proper solution
is not possible so we print an empty string and exit.
if (@letters.elems - @digits.elems).abs > 1 {
say "";
exit;
}
my $result = "";
my $lindex = 0;
my $dindex = 0;
Then we build the result by alternating between digits and letters starting with whichever group (digit/letter) was determined earlier and continuing until all characters are used.
while $lindex < @letters.elems || $dindex < @digits.elems {
if $digitFirst {
if $dindex < @digits.elems {
$result ~= @digits[$dindex++];
}
if $lindex < @letters.elems {
$result ~= @letters[$lindex++];
}
} else {
if $lindex < @letters.elems {
$result ~= @letters[$lindex++];
}
if $dindex < @digits.elems {
$result ~= @digits[$dindex++];
}
}
}
Finally, we print the result.
say $result;
The Perl version works the same as Raku.
my @letters = sort grep { /[[:lower:]]/ } split //, $str;
my @digits = sort grep { /[[:digit:]]/ } split //, $str;
my $digitFirst = scalar @digits >= scalar @letters;
if (abs(scalar @letters - scalar @digits) > 1) {
say "";
exit;
}
my $result = "";
my $lindex = 0;
my $dindex = 0;
while ($lindex < scalar @letters || $dindex < scalar @digits) {
if ($digitFirst) {
if ($dindex < scalar @digits) {
$result .= $digits[$dindex++];
}
if ($lindex < scalar @letters) {
$result .= $letters[$lindex++];
}
} else {
if ($lindex < scalar @letters) {
$result .= $letters[$lindex++];
}
if ($dindex < scalar @digits) {
$result .= $digits[$dindex++];
}
}
}
say $result;
Challenge 2:
Max Score
You are given a string,
$str, containing0and1only.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
Usually, the second challenge is harder than the first but this time it was easier.
First we set up storage for the maximum score. It is initialized to the lowest possible number, negative infinity.
my $max = -∞;
From 1 to one less then the length of $str, we split $str into two. We count the 0s in the first part
and 1s in the second part and them together to form the $score.
for (1 ..^ $str.chars) -> $i {
my $score = $str.substr(0, $i).match(/(0)/, :g).elems +
$str.substr($i).match(/(1)/, :g).elems;
If the current score is greater than the current maximum score, it becomes the new maximum score.
if ($score > $max) {
$max = $score;
}
}
Finally, we print the maximum score.
say $max;
Once again, the Perl code tracks the Raku version quite closely except to count 1s and 0s, I used the tr/// operator
rather than m/// as it is slightly more efficient.
my $max = -"Inf";
for my $i (1 .. (length $str) - 1) {
my $score = substr($str, 0, $i) =~ tr/0/0/ + substr($str, $i) =~ tr/1/1/;
if ($score > $max) {
$max = $score;
}
}
say $max;