Perl Weekly Challenge 342.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 342.

Task 1: Balance String

Submitted by: Mohammad Sajid Anwar
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"

I may split the sting into letters and digits. The resulting string starts with a digit and ends with a letter if the number of digits and letters are equal, it starts with a digit and ends with a digit if there is one more digit than letters, and it starts with a letter and ends with a letter if there is one more letter than digits. Otherwise, the reuslt is the null string. I used here that digits come before letters lexicographically. This yields a three-liner

perl -E '
for(@ARGV){my(@d,@l,@o);((/\d/&&push@d,$_)||push @l,$_)for split"";print"$_ -> ";
say(""),next unless abs(@d-@l)<=1;@d=sort@d; @l=sort@l;if(@d>=@l){push@o,shift@d,
shift@l while@l;push@o,@d;say(@o);next}push@o,shift@l,shift@d while@d; say@o,@l;}
' a0b1c2 abc12 0a2b1c3 1a23 ab123

Results:

a0b1c2 -> 0a1b2c
abc12 -> a1b2c
0a2b1c3 -> 0a1b2c3
1a23 ->
ab123 -> 1a2b3

The full code is:

 1  # Perl weekly challenge 342
 2  # Task 1:  Balance String
 3  #
 4  # See https://wlmb.github.io/2025/10/06/PWC342/#task-1-balance-string
 5  use v5.36;
 6  use feature qw(try);
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 S1 S2...
 9      to balance each string S1 so that letters and lower case characters
10      intermingle.
11      FIN
12  for(@ARGV){
13      try {
14          my(@digits, @letters, @output);
15          for(split ""){
16              die "Expected only digits or lowercase letters: $_" unless /\d|[a-z]/;
17              push @digits, $_ if /\d/;
18              push @letters, $_ if /[a-z]/;
19          }
20          #print"$_ -> ";
21          say("$_ ->"),next unless abs(@digits - @letters) <= 1;
22          @digits = sort {$a cmp $b} @digits;
23          @letters = sort {$a cmp $b} @letters;
24          if(@digits >= @letters){
25              push @output, shift @digits, shift @letters while @letters;
26              push @output, @digits; # if there were one more digit than letters
27              say "$_ -> ", join "", @output;
28              next
29          }
30          # @digits < @letters
31          push @output, shift @letters, shift @digits  while @digits;
32          push @output, @letters; # remaining letter
33          say "$_ -> ", join "", @output;
34      }
35      catch($e){
36          warn $e;
37      }
38  }
39  

Example:

./ch-1.pl a0b1c2 abc12 0a2b1c3 1a23 ab123

Results:

a0b1c2 -> 0a1b2c
abc12 -> a1b2c
0a2b1c3 -> 0a1b2c3
1a23 ->
ab123 -> 1a2b3

Task 2: Max Score

Submitted by: Mohammad Sajid Anwar
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

A straightforward, not too efficient solution, is to start with all digits on the right and shift digits one by one to the left while keeping the score, and choosing the maximum.

perl -MList::Util=max -E '
for(@ARGV){@r=split"";$s=grep{/1/}@r;pop@r;say"$_ -> ",max map{$s+=(/0/-/1/)}@r;}
' 0011 0000  1111 0101 011101

Results:

0011 -> 4
0000 -> 3
1111 -> 3
0101 -> 3
011101 -> 5

The procedure may be slightly more efficient if I shift into the left side groups of an arbitrary block of ones followed by one or more zeroes, as many as possible, at a time, instead of shifting digits one by one. But in this case, I prefered simplicity.

The full code is:

 1  # Perl weekly challenge 342
 2  # Task 2:  Max Score
 3  #
 4  # See https://wlmb.github.io/2025/10/06/PWC342/#task-2-max-score
 5  use v5.36;
 6  use List::Util qw(max);
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 B1 B2...
 9      to split the binary strings Bi maximizing the number of zeroes
10      on the left side plus the number of ones on the right side.
11      FIN
12  for(@ARGV){
13      warn("Only 0's and 1's permitted in binary string: $_"), next unless /^(0|1)*$/;
14      warn("Need at least two digits in string: $_"), next unless length >= 2;
15      my @right = split "";
16      my $score = grep {/1/} @right;
17      pop @right;
18      # Add 1 for each 0 transfered to the left
19      # Subtract 1 for each 1 transfered from the right
20      say "$_ -> ", max map{$score += (/0/-/1/)} @right;
21  }

Example:

./ch-2.pl 0011 0000  1111 0101 011101

Results:

0011 -> 4
0000 -> 3
1111 -> 3
0101 -> 3
011101 -> 5

/;

Written on October 6, 2025