Add polettix's solution to challenge-211

6 files changed, 152 insertions, 0 deletions

diff --git a/challenge-211/polettix/blog.txt b/challenge-211/polettix/blog.txt
new file mode 100644
index 0000000000..cc264f1cba
--- /dev/null
+++ b/challenge-211/polettix/blog.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/04/06/pwc211-toepliz-matrix/
diff --git a/challenge-211/polettix/blog1.txt b/challenge-211/polettix/blog1.txt
new file mode 100644
index 0000000000..180b88d60d
--- /dev/null
+++ b/challenge-211/polettix/blog1.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/04/07/pwc211-split-same-average/
diff --git a/challenge-211/polettix/perl/ch-1.pl b/challenge-211/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..43c94fde0e
--- /dev/null
+++ b/challenge-211/polettix/perl/ch-1.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+my $m1 = [ [4, 3, 2, 1],
+           [5, 4, 3, 2],
+           [6, 5, 4, 3],
+         ];
+say 'm1: ', is_toepliz_matrix($m1) ? 'true' : 'false';
+
+my $m2 = [ [1, 2, 3],
+           [3, 2, 1],
+         ];
+say 'm2: ', is_toepliz_matrix($m2) ? 'true' : 'false';
+
+
+sub is_toepliz_matrix ($m) {
+   for my $i (1 .. $m->$#*) {
+      my ($r0, $r1) = $m->@[$i - 1, $i];
+      my $end = $r1->$#*;
+      return 0 if $end != $r0->$#*;
+      for my $j (1 .. $end) {
+         return 0 if $r0->[$j - 1] != $r1->[$j];
+      }
+   }
+   return 1;
+}
diff --git a/challenge-211/polettix/perl/ch-2.pl b/challenge-211/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..fcea34b5a7
--- /dev/null
+++ b/challenge-211/polettix/perl/ch-2.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+my @args = @ARGV ? @ARGV : 1 .. 8;
+say split_same_average(@args) ? 'true' : 'false';
+
+sub split_same_average (@list) {
+
+   # pre-massage the list to only cope with non-negative integers
+   (my $min, @list) = sort { $a <=> $b } @list;
+   my @partial_sums = (0);
+   push @partial_sums, $partial_sums[-1] + ($list[$_] -= $min)
+      for 0 .. $#list;
+   unshift @list, 0; # put "min" back
+
+   my %cache;
+   my $has_subset = sub ($sum, $k, $i = $#list) {
+      return 1 if ($sum == 0) && ($k == 0);  # found!
+      return 0
+         if ($sum < 0)                 # removed more than needed
+         || ($i < 0)                   # nothing more to look at
+         || ($sum > $partial_sums[$i]) # cannot remove as much as needed
+         ;
+
+      # caching on subset size $k and end cursor position $i only, the $sum
+      # is a consequence of $k
+      return $cache{$k}{$i} //=
+            __SUB__->($sum - $list[$i], $k - 1, $i - 1) # try greedy first
+         || __SUB__->($sum, $k, $i - 1);                # fallback
+   };
+
+   # calculate p and q (average for modified list is p/q)
+   my $n = @list;
+   my $sum = $partial_sums[-1];
+   my $gcd = gcd($sum, $n);
+   my ($p, $q) = ($sum / $gcd, $n / $gcd);
+
+   # iterate finding subsets of multiples of q, starting at q itself
+   my $k = $q;
+   while ($k <= $n / 2) {
+      my $S = $p * $k / $q; # target sum
+      return 1 if $has_subset->($S, $k);
+      $k += $q;
+   }
+
+   # nothing found, fail
+   return 0;
+}
+
+sub gcd ($A, $B) { ($A, $B) = ($B % $A, $A) while $A; return $B }
diff --git a/challenge-211/polettix/raku/ch-1.raku b/challenge-211/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..c8b551d15c
--- /dev/null
+++ b/challenge-211/polettix/raku/ch-1.raku
@@ -0,0 +1,22 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN {
+   my $m1 = [ [4, 3, 2, 1],
+              [5, 4, 3, 2],
+              [6, 5, 4, 3],
+            ];
+   put 'm1: ', is-toepliz-matrix($m1);
+
+   my $m2 = [ [1, 2, 3],
+              [3, 2, 1],
+            ];
+   put 'm2: ', is-toepliz-matrix($m2);
+}
+
+sub is-toepliz-matrix ($m) {
+   for 1 .. $m.end -> $i {
+      my ($r0, $r1) = $m[$i - 1, $i];
+      return False unless all($r0[0 .. *-2] «==» $r1[1 .. *-1]);
+   }
+   return True;
+}
diff --git a/challenge-211/polettix/raku/ch-2.raku b/challenge-211/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..c7dfd3861d
--- /dev/null
+++ b/challenge-211/polettix/raku/ch-2.raku
@@ -0,0 +1,48 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (*@args) {
+   @args = 1 .. 8 unless @args;
+   put split-same-average(@args);
+}
+
+sub split-same-average (@list) {
+   (my $min, @list) = @list.sort.Slip;
+   my @partial-sums = 0;
+   @partial-sums.push: @partial-sums[*-1] + (@list[$_] -= $min) for ^@list;
+   @list.unshift: 0; # put "min" back
+
+   my %cache;
+   sub has_subset ($sum, $k, $i = @list.end) {
+      return True if ($sum == 0) && ($k == 0);
+      return False
+         if ($sum < 0)                 # removed more than needed
+         || ($i < 0)                   # nothing more to look at
+         || ($sum > @partial-sums[$i]) # cannot remove as much as needed
+         ;
+
+      # caching on subset size $k and end cursor position $i only, the $sum
+      # is a consequence of $k
+      return %cache{$k}{$i} //=
+            samewith($sum - @list[$i], $k - 1, $i - 1)
+         || samewith($sum, $k, $i - 1);
+   }
+
+   # calculate p and q (average for modified list is p/q)
+   my $n = @list.elems;
+   my $sum = @partial-sums[*-1];
+   my $gcd = gcd($sum, $n);
+   my ($p, $q) = $sum div $gcd, $n div $gcd;
+
+   # iterate finding subsets of multiples of q, starting at q itself
+   my $k = $q;
+   while $k <= $n div 2 {
+      my $S = $p * $k / $q; # target sum
+      return True if has_subset($S, $k);
+      $k += $q;
+   }
+
+   # nothing found, fail
+   return False;
+}
+
+sub gcd ($A is copy, $B is copy) { ($A, $B) = ($B % $A, $A) while $A; $B }