Merge pull request #12891 from wlmb/challenges

Solve PWC344

4 files changed, 107 insertions, 0 deletions

diff --git a/challenge-344/wlmb/blog.txt b/challenge-344/wlmb/blog.txt
new file mode 100644
index 0000000000..efd7294fa4
--- /dev/null
+++ b/challenge-344/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2025/10/20/PWC344/
diff --git a/challenge-344/wlmb/perl/ch-1.pl b/challenge-344/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..8b8ead517a
--- /dev/null
+++ b/challenge-344/wlmb/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 344
+# Task 1:  Array Form Compute
+# Array form->number->array form version
+#
+# See https://wlmb.github.io/2025/10/20/PWC344/#task-1-array-form-compute
+use v5.36;
+use feature qw(try);
+use PDL;
+die <<~"FIN" unless @ARGV && @ARGV%2==0;
+    Usage: $0 A0 I0 A1 I1...
+    to add the integer Ij to the integer in array form An
+    and print the array form of the result.
+    FIN
+for my($string, $integer)(@ARGV){
+    try {
+	die "Input should be space separated positive integers within square brackets: $string"
+	    unless $string =~ /^\[(\d|\s)*]$/;
+	die "Input should be a positive integer" unless $integer=~/^\d+$/;
+	my $array=pdl($string);
+	my $number=($array*10**($array->nelem-1-$array->xvals))->sumover+$integer;
+	my $result=pdl([split "", $number]);
+	say "$string, $number -> $result";
+    }
+    catch($e){ warn $e;}
+}
diff --git a/challenge-344/wlmb/perl/ch-1a.pl b/challenge-344/wlmb/perl/ch-1a.pl
new file mode 100755
index 0000000000..79421e9f58
--- /dev/null
+++ b/challenge-344/wlmb/perl/ch-1a.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 344
+# Task 1:  Array Form Compute
+# Number -> array form version
+#
+# See https://wlmb.github.io/2025/10/20/PWC344/#task-1-array-form-compute
+use v5.36;
+use feature qw(try);
+use PDL;
+die <<~"FIN" unless @ARGV && @ARGV%2==0;
+    Usage: $0 A0 I0 A1 I1...
+    to add the integer Ij to the integer in array form An
+    and print the array form of the result.
+    FIN
+for my($string, $integer)(@ARGV){
+    try {
+	die "Input should be space separated positive integers within square brackets: $string"
+	    unless $string =~ /^\[(\d|\s)*]$/;
+	die "Input should be a positive integer" unless $integer=~/^\d+$/;
+	my @array=pdl($string)->list;
+	my @other=split "", $integer;
+	my @result=();
+	my $carry=0;
+	while(@array||@other){
+	    my $sum=((pop @array)//0)+((pop @other)//0)+$carry;
+	    $carry=floor($sum/10);
+	    unshift @result, $sum%10;
+	}
+	unshift @result, $carry if $carry;
+	say "$string, $integer -> [@result]";
+    }
+    catch($e){ warn $e;}
+}
diff --git a/challenge-344/wlmb/perl/ch-2.pl b/challenge-344/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..a6b58fe0f2
--- /dev/null
+++ b/challenge-344/wlmb/perl/ch-2.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 344
+# Task 2:  Array Formation
+#
+# See https://wlmb.github.io/2025/10/20/PWC344/#task-2-array-formation
+use v5.36;
+use feature qw(try);
+use PDL;
+use PDL::NiceSlice;
+die <<~"FIN" unless @ARGV && @ARGV%2==0;
+    Usage: $0 S0 T0 S1 T1...
+    to match the source arrays Si to the target array Ti.
+    The sources are comma separated strings of the form "s0, s1..." where
+    each string contains an array of space separated numbers within square brackets
+    of the form "[n0 n1...]"
+    FIN
+my $result;
+for my($sources, $target)(@ARGV){
+    try {
+	my @sources = map {pdl($_)} split /\s*,\s*/, $sources;
+	my $ptarget = pdl($target);
+	do{die "Expected 1D arrays of numbers: $_" unless $_->ndims==1;} for @sources, $ptarget;
+	$result=0, next unless pdl(map{$_->nelem} @sources)->sum == $ptarget->nelem;
+	my @tested=();
+	while(@sources){
+	    $result = test([@tested],[@sources],$ptarget) and last;
+	    push @tested, shift @sources;
+	}
+    }
+    catch($e){ warn $e; }
+}
+continue{
+    say "$sources, $target -> ", $result?"True":"False";
+}
+sub test($tested, $untested, $target){
+    my @tested=@$tested;
+    my @untested=@$untested;
+    return 1 unless @untested;
+    while(@untested){
+        my $current=shift @untested;
+	my $result=all($current==$target(0:$current->nelem-1));  # assume target is large enough
+	$result=test([], [@tested, @untested], $target($current->nelem:-1)) if $result;
+        return 1 if $result;
+        push @tested, $current;
+    }
+    return 0;
+}