Merge pull request #7848 from wlmb/challenges

Solve PWC211

3 files changed, 48 insertions, 0 deletions

diff --git a/challenge-211/wlmb/blog.txt b/challenge-211/wlmb/blog.txt
new file mode 100644
index 0000000000..5d17477df3
--- /dev/null
+++ b/challenge-211/wlmb/blog.txt
@@ -0,0 +1,2 @@
+https://wlmb.github.io/2023/04/03/PWC211/
+
diff --git a/challenge-211/wlmb/perl/ch-1.pl b/challenge-211/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..0e2873fda2
--- /dev/null
+++ b/challenge-211/wlmb/perl/ch-1.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 211
+# Task 1:  Toeplitz Matrix
+#
+# See https://wlmb.github.io/2023/04/03/PWC211/#task-1-toeplitz-matrix
+use v5.36;
+use List::Util qw(max min uniq);
+my @matrix;
+my $N=0; # number of rows
+while(<>){ # read the matrix, a space separated row at a time
+    $matrix[$N++]=[split " "];
+}
+my $M=@{$matrix[0]}; # Number of columns
+@{$matrix[$_]}==$M || die "Not rectangular"  for(1..$N-1);
+my $largest=max($N,$M);
+my $toeplitz=1;      # matrix is toeplitz
+for my $diagonal(-$M+1..$N-1){
+    $toeplitz &&=    # unless it is not
+        1==uniq
+	map {$matrix[$diagonal+$_][$_]}
+        max(0, -$diagonal)..min($M-1,$N-$diagonal-1);
+}
+say "@{$matrix[$_]}" for 0..$N-1;
+say " -> ", $toeplitz?"true":"false";
diff --git a/challenge-211/wlmb/perl/ch-2.pl b/challenge-211/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..ae25ceea91
--- /dev/null
+++ b/challenge-211/wlmb/perl/ch-2.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 211
+# Task 2:  Split Same Average
+#
+# See https://wlmb.github.io/2023/04/03/PWC211/#task-2-split-same-average
+use v5.36;
+use Algorithm::Combinatorics qw(subsets);
+use List::Util qw(sum);
+die <<~"FIN" unless @ARGV;
+    Usage: $0 N1 [N2...]
+    to test if the set N1 N2... may be split into two proper subsets
+    with the same average
+    FIN
+my $avg=sum(@ARGV)/@ARGV;
+my $subsets=subsets(\@ARGV);
+$subsets->next; # Throw away the complete set
+my $candidate;
+while($candidate=$subsets->next){
+    next if @$candidate==0;  # Throw away the empty set
+    last if sum(@$candidate)==$avg*@$candidate; # success
+}
+say("@ARGV -> ", $candidate && @$candidate? "True: @$candidate" : "False")