Add second solution

2 files changed, 42 insertions, 21 deletions

diff --git a/challenge-342/wlmb/perl/ch-1.pl b/challenge-342/wlmb/perl/ch-1.pl
index cb78322275..5e669f7dfe 100755
--- a/challenge-342/wlmb/perl/ch-1.pl
+++ b/challenge-342/wlmb/perl/ch-1.pl
@@ -12,28 +12,28 @@ die <<~"FIN" unless @ARGV;
     FIN
 for(@ARGV){
     try {
-	my(@digits, @letters, @output);
-	for(split ""){
-	    die "Expected only digits or lowercase letters: $_" unless /\d|[a-z]/;
-	    push @digits, $_ if /\d/;
-	    push @letters, $_ if /[a-z]/;
-	}
-	#print"$_ -> ";
-	say("$_ ->"),next unless abs(@digits - @letters) <= 1;
-	@digits = sort {$a cmp $b} @digits;
-	@letters = sort {$a cmp $b} @letters;
-	if(@digits >= @letters){
-	    push @output, shift @digits, shift @letters while @letters;
-	    push @output, @digits; # if there were one more digit than letters
-	    say "$_ -> ", join "", @output;
-	    next
-	}
-	# @digits < @letters
-	push @output, shift @letters, shift @digits  while @digits;
-	push @output, @letters; # remaining letter
-	say "$_ -> ", join "", @output;
+        my(@digits, @letters, @output);
+        for(split ""){
+            die "Expected only digits or lowercase letters: $_" unless /\d|[a-z]/;
+            push @digits, $_ if /\d/;
+            push @letters, $_ if /[a-z]/;
+        }
+        #print"$_ -> ";
+        say("$_ ->"),next unless abs(@digits - @letters) <= 1;
+        @digits = sort {$a cmp $b} @digits;
+        @letters = sort {$a cmp $b} @letters;
+        if(@digits >= @letters){
+            push @output, shift @digits, shift @letters while @letters;
+            push @output, @digits; # if there were one more digit than letters
+            say "$_ -> ", join "", @output;
+            next
+        }
+        # @digits < @letters
+        push @output, shift @letters, shift @digits  while @digits;
+        push @output, @letters; # remaining letter
+        say "$_ -> ", join "", @output;
     }
     catch($e){
-	warn $e;
+        warn $e;
     }
 }
diff --git a/challenge-342/wlmb/perl/ch-2a.pl b/challenge-342/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..a464d763cc
--- /dev/null
+++ b/challenge-342/wlmb/perl/ch-2a.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 342
+# Task 2:  Max Score
+#
+# See https://wlmb.github.io/2025/10/06/PWC342/#task-2-max-score
+use v5.36;
+use List::Util qw(max);
+die <<~"FIN" unless @ARGV;
+    Usage: $0 B1 B2...
+    to split the binary strings Bi maximizing the number of zeroes
+    on the left side plus the number of ones on the right side.
+    FIN
+for(@ARGV){
+    warn("Only 0's and 1's permitted in binary string: $_"), next unless /^(0|1)*$/;
+    warn("Need at least two digits in string: $_"), next unless length >= 2;
+    my $left=substr my $right=$_,0,1,"";
+    my $score=($left==0)+((my $tmp=$right)=~tr/1/0/); # initial score
+    my @scores=($score);
+    push @scores, $score+=length($2)-length($1) while $right=~s/^(1*)(0+)(\d)/$3/;
+    say "$_ -> ", max @scores;
+}