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 result 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. The result fits a one-liner.
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 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
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, as it would be useless to shift a 1 unless there is a 0 to its right. The corresponding code is somewhat more complex:
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 $left=substr my $right=$_,0,1,"";
16 my $score=($left==0)+((my $tmp=$right)=~tr/1/0/); # initial score
17 my @scores=($score);
18 push @scores, $score+=length($2)-length($1) while $right=~s/^(1*)(0+)(\d)/$3/;
19 say "$_ -> ", max @scores;
20 }
Examples:
./ch-2a.pl 0011 0000 1111 0101 011101
Results:
0011 -> 4
0000 -> 3
1111 -> 3
0101 -> 3
011101 -> 5
/;
Written on October 6, 2025