Merge pull request #11505 from wlmb/challenges

Solve PWC306

3 files changed, 58 insertions, 0 deletions

diff --git a/challenge-306/wlmb/blog.txt b/challenge-306/wlmb/blog.txt
new file mode 100644
index 0000000000..4a115fe0cd
--- /dev/null
+++ b/challenge-306/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2025/01/27/PWC306/
diff --git a/challenge-306/wlmb/perl/ch-1.pl b/challenge-306/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..85f2ea6f05
--- /dev/null
+++ b/challenge-306/wlmb/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 306
+# Task 1:  Odd Sum
+#
+# See https://wlmb.github.io/2025/01/27/PWC306/#task-1-odd-sum
+use v5.36;
+use PDL;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 A1 A2...
+    to compute the sum of all odd contiguous subarrays of the arrays
+    A1, A2.... The inputs A1 are strings of the form
+    ¨[N1 N2...Nn]" to be interpreted as arrays by PDL.
+    FIN
+for(@ARGV){
+    my $input = pdl($_);
+    my $N = $input->dim(0);
+    my $zeroes = zeroes($N, $N); # indexed by d,g
+    my $d=$zeroes->xvals;             # number positions
+    my $g=1+$zeroes->yvals;           # group sizes
+    my $repetitions =
+	pdl(
+	    $d+1,
+	    $N-$d,
+	    $g,
+	    $N+1-$g                           # bounds of number of repetitions
+	)->mv(-1,0)->minover                  # number of repetitions for each term for each group size
+	->mv(1,0)->slice([0,-1,2])            # restrict to odd group sizes
+	->sumover;                            # actual number of repetitions for each term
+    my $output = $repetitions->inner($input); # multiply and sum
+    say "$input -> $output"
+}
diff --git a/challenge-306/wlmb/perl/ch-2.pl b/challenge-306/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..7d4e16dab7
--- /dev/null
+++ b/challenge-306/wlmb/perl/ch-2.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 306
+# Task 2:  Last Element
+#
+# See https://wlmb.github.io/2025/01/27/PWC306/#task-2-last-element
+use v5.36;
+die <<~"FIN" unless @ARGV;
+    Usage: $0 N1 N2 ...
+    to repeatedly replace the two largest numbers of an array
+    by their differernce, starting from N1 N2...
+    FIN
+my @array = @ARGV;
+while(@array > 1){
+    my $max = remove_max(\@array);
+    my $almost_max= remove_max(\@array);
+    push @array,$max-$almost_max
+}
+my $result = $array[0];
+say "@ARGV -> $result";
+
+sub remove_max($a){
+    my @a=@$a;
+    my $m=$a[my $i=0];
+    ($m<$a[$_])&&($m=$a[$i=$_]) for(1..@a-1);
+    return splice @$a, $i, 1;
+}