Merge pull request #12972 from wlmb/challenges

Solve PWC346

3 files changed, 59 insertions, 0 deletions

diff --git a/challenge-346/wlmb/blog.txt b/challenge-346/wlmb/blog.txt
new file mode 100644
index 0000000000..a6af4e4005
--- /dev/null
+++ b/challenge-346/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2025/11/02/PWC346/
diff --git a/challenge-346/wlmb/perl/ch-1.pl b/challenge-346/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..0e00e83dc9
--- /dev/null
+++ b/challenge-346/wlmb/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 346
+# Task 1:  Longest Parenthesis
+#
+# See https://wlmb.github.io/2025/11/02/PWC346/#task-1-longest-parenthesis
+use v5.36;
+use feature qw(try);
+use List::Util qw(max);
+die <<~"FIN" unless @ARGV;
+    Usage: $0 S0 S1...
+    to find the longest sequence of correctly nested parenthesis, where
+    Si is a string formed of any number of parenthesis "(" and ")".
+    FIN
+for(@ARGV){
+    try {
+	die "Expected only round parenthesis" unless /^[()]*$/;
+	my $input=$_;
+	1 while s/((\d*)\((\d*)\))/+($2||0)+($3||0)+2/e;
+	say "$input -> ", max 0, /\d+/g;
+    }
+    catch($e){warn $e}
+}
diff --git a/challenge-346/wlmb/perl/ch-2.pl b/challenge-346/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..926411ddc9
--- /dev/null
+++ b/challenge-346/wlmb/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 346
+# Task 2:  Magic Expression
+#
+# See https://wlmb.github.io/2025/11/02/PWC346/#task-2-magic-expression
+use v5.36;
+use feature qw(try);
+use Algorithm::Combinatorics qw(tuples_with_repetition);
+die <<~"FIN" unless @ARGV && @ARGV%2==0;
+    Usage: $0 S0 T0 S1 T1...
+    to intercalate arithmetic operators among the digits of string Sn
+    to produce target Tn
+    FIN
+for my($string, $target)(@ARGV){
+    try {
+	die "Only digits accepted in string: $string" unless $string=~/^\d*$/;
+        # Deal with marginal cases
+	say("$string -> "), next if length $string == 0 && $string==$target;
+	say("$string -> $target"), next if length $string == 1 && $string==$target;
+	# Two or more digits
+	my @digits=split "", $string;
+	my $iterator=tuples_with_repetition(["",qw(+ - * /)], @digits-1);
+	my @results=();
+	while(my $intercalate=$iterator->next){
+	    my $expression=join "",
+		map({($digits[$_], $intercalate->[$_])} 0..@digits-2),
+		$digits[-1];
+	    next if $expression=~/0\d/; # forbid leading zeros
+	    my $value = eval $expression;
+	    next unless defined $value; # ignore illegal expressions
+	    push @results, $expression if $value==$target;
+	}
+	say "$string,  $target -> @results";
+    }
+    catch($e){warn $e;}
+}