Solve 211: Toeplitz Matrix & Split Same Average by E. Choroba

2 files changed, 119 insertions, 0 deletions

diff --git a/challenge-211/e-choroba/perl/ch-1.pl b/challenge-211/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..90ae514e7b
--- /dev/null
+++ b/challenge-211/e-choroba/perl/ch-1.pl
@@ -0,0 +1,47 @@
+#! /usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub toeplitz_matrix($m) {
+    my $x = 0;
+    my $y = $#$m;
+    while ($x <= $#{ $m->[0] }) {
+        my ($u, $v) = ($x, $y);
+        while (++$u <= $#{ $m->[0] } && ++$v <= $#$m) {
+            return if $m->[$v][$u] != $m->[$y][$x];
+        }
+    } continue {
+        if ($y) {
+            --$y;
+        } else {
+            ++$x;
+        }
+    }
+    return 1
+}
+
+use Test::More tests => 4;
+
+ok toeplitz_matrix([ [4, 3, 2, 1],
+                     [5, 4, 3, 2],
+                     [6, 5, 4, 3],
+                 ]), 'Example 1';
+
+ok ! toeplitz_matrix([ [1, 2, 3],
+                       [3, 2, 1],
+                   ]), 'Example 2';
+
+ok toeplitz_matrix([[1]]), '1x1';
+ok toeplitz_matrix([[1,2,3,4,5,6,7],
+                    [8,1,2,3,4,5,6],
+                    [9,8,1,2,3,4,5],
+                    [10,9,8,1,2,3,4],
+                    [11,10,9,8,1,2,3],
+                    [12,11,10,9,8,1,2],
+                    [13,12,11,10,9,8,1],
+                    [14,13,12,11,10,9,8],
+                    [15,14,13,12,11,10,9],
+                    [16,15,14,13,12,11,10],
+                    [17,16,15,14,13,12,11],
+                ]), 'Larger';
diff --git a/challenge-211/e-choroba/perl/ch-2.pl b/challenge-211/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..02942855f9
--- /dev/null
+++ b/challenge-211/e-choroba/perl/ch-2.pl
@@ -0,0 +1,72 @@
+#! /usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+use List::Util qw{ sum };
+
+sub split_same_average_brute_force(@list) {
+    my $avg = sum(@list) / @list;
+    my @mask = (0) x @list;
+    $mask[-1] = 1;
+    while (1) {
+        my $s = sum(@list[grep $mask[$_], 0 .. $#mask]);
+        return 1 if abs($s / (grep $_, @mask) - $avg) < 1e-9;
+
+        my $pos = $#mask;
+        while ($mask[$pos]) {
+            $mask[$pos] = 0;
+            return if --$pos < 1;
+        }
+        $mask[$pos] = 1;
+    }
+
+}
+
+sub split_same_average(@list) {
+    my $sum = sum(@list);
+    my $avg = $sum / @list;
+    my $max_length = (@list + 1) / 2;
+    --$max_length if $max_length >= @list - 1;
+
+    my %possible;  # {sum}{length}
+    $possible{0}{0} = 1;
+    for my $e (@list) {
+        # Sort is needed so we don't process the added sum again in
+        # the same step.
+        for my $s (sort { $b <=> $a } keys %possible) {
+            for my $length (keys %{ $possible{$s} }) {
+                next if $length == @list - 1;
+
+                $possible{ $s + $e }{ $length + 1 } = 1;
+                return 1 if abs(($s + $e) / ($length+1) - $avg) < 1e-9;
+            }
+        }
+    }
+    return
+}
+
+use Test::More;
+
+ok split_same_average(1, 2, 3, 4, 5, 6, 7, 8), 'Example 1';
+ok ! split_same_average(1, 3), 'Example 2';
+
+ok split_same_average(-2, 0, 2), 'Avg 0';
+ok split_same_average(1, 5, 5, 1), 'Duplicates';
+
+for (1 .. 200) {
+    my @list = map int rand 20, 1 .. 2 + rand 10;
+    is split_same_average(@list), split_same_average_brute_force(@list),
+        "same @list";
+}
+
+my @l = map int rand 50, 1 .. 12;
+is split_same_average(@l), split_same_average_brute_force(@l),
+        "same @l";
+done_testing();
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    brute_force => sub { split_same_average_brute_force(@l) },
+    fast        => sub { split_same_average(@l) },
+});