Merge pull request #12803 from wlmb/challenges

Solve PWC342

3 files changed, 62 insertions, 0 deletions

diff --git a/challenge-342/wlmb/blog.txt b/challenge-342/wlmb/blog.txt
new file mode 100644
index 0000000000..969ef21126
--- /dev/null
+++ b/challenge-342/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2025/10/06/PWC342/
diff --git a/challenge-342/wlmb/perl/ch-1.pl b/challenge-342/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..cb78322275
--- /dev/null
+++ b/challenge-342/wlmb/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 342
+# Task 1:  Balance String
+#
+# See https://wlmb.github.io/2025/10/06/PWC342/#task-1-balance-string
+use v5.36;
+use feature qw(try);
+die <<~"FIN" unless @ARGV;
+    Usage: $0 S1 S2...
+    to balance each string S1 so that letters and lower case characters
+    intermingle.
+    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;
+    }
+    catch($e){
+	warn $e;
+    }
+}
diff --git a/challenge-342/wlmb/perl/ch-2.pl b/challenge-342/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..e9b0aec994
--- /dev/null
+++ b/challenge-342/wlmb/perl/ch-2.pl
@@ -0,0 +1,22 @@
+#!/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 @right = split "";
+    my $score = grep {/1/} @right;
+    pop @right;
+    # Add 1 for each 0 transfered to the left
+    # Subtract 1 for each 1 transfered from the right
+    say "$_ -> ", max map{$score += (/0/-/1/)} @right;
+}