Merge pull request #7857 from MatthiasMuth/muthm-211

Challenge 211 solutions in Perl by Matthias Muth

3 files changed, 137 insertions, 1 deletions

diff --git a/challenge-211/matthias-muth/README.md b/challenge-211/matthias-muth/README.md
index 8714e996a1..fe15f8d3d3 100644
--- a/challenge-211/matthias-muth/README.md
+++ b/challenge-211/matthias-muth/README.md
@@ -1,4 +1,4 @@
-**Challenge 210 solutions in Perl by Matthias Muth**
+**Challenge 211 solutions in Perl by Matthias Muth**
 <br/>
 (no blog post this time...)
 
diff --git a/challenge-211/matthias-muth/perl/ch-1.pl b/challenge-211/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..a91b0f973e
--- /dev/null
+++ b/challenge-211/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 211 Task 1: Toeplitz Matrix
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+use feature 'say';
+
+use Data::Dump qw( pp );
+use List::Util qw( min max any all );
+
+sub is_toeplitz_by_diagonals {
+    my ( $matrix ) = @_;
+
+    my ( $m, $n) = ( scalar @$matrix, scalar @{$matrix->[0]} );
+
+    die "all rows must have the same length"
+        unless all { @{$matrix->[$_]} == $n } 1..$#$matrix;
+
+    for my $d ( -( $m - 1 ) .. +( $n - 1 ) ) {
+        my $i0 = - min( $d, 0 );
+        my $j0 = max( 0, $d );
+        my $imax = min( $m - 1, $m - $d );
+        # say "    i0:$i0 imax:$imax";
+        return "false"
+            if any {
+                my ( $i, $j ) = ( $_, $_+ $d );
+                $matrix->[$i][$j] != $matrix->[$i0][$j0]
+            } $i0 .. $imax;
+    }
+    return "true";
+}
+
+sub is_toeplitz_by_elements {
+    my ( $matrix ) = @_;
+
+    die "all rows must have the same length"
+        unless all { $#{$matrix->[$_]} == $#{$matrix->[0]} } 1..$#$matrix;
+
+    # For every row, starting from the second one,
+    # check all fields in that row to contain the same value as the element
+    # diagonally above and left. Start with the second field, as the first one
+    # doesn't have another field to compare with.
+    for my $i ( 1..$#$matrix ) {
+        return "false"
+            if any { $matrix->[$i][$_] != $matrix->[ $i - 1 ][ $_ - 1 ] }
+                1..$#{$matrix->[$i]};
+    }
+
+    # All elements fulfill that criteria, so the matrix is a Toeplitz matrix.
+    return "true";
+}
+
+
+use Test::More;
+use Data::Dump qw( pp );
+
+do {
+    is is_toeplitz_by_diagonals( $_->{INPUT} ), $_->{EXPECTED},
+        "is_toeplitz_by_diagonals(" . pp( $_->{INPUT} ) . " == $_->{EXPECTED}";
+    is is_toeplitz_by_elements( $_->{INPUT} ), $_->{EXPECTED},
+        "is_toeplitz_by_elements(" . pp( $_->{INPUT} ) . " == $_->{EXPECTED}";
+} for (
+    { INPUT => [ [ 4,3,2,1 ], [ 5,4,3,2 ], [ 6,5,4,3 ] ], EXPECTED => "true" },
+    { INPUT => [ [ 1,2,3 ], [ 3,2,1 ] ], EXPECTED => "false" },
+    { INPUT =>  [ [1, 2, 3, 4],
+                  [5, 1, 2, 3],
+                  [9, 5, 1, 2]
+                ], EXPECTED => "true" },
+);
+
+done_testing;
diff --git a/challenge-211/matthias-muth/perl/ch-2.pl b/challenge-211/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..b367b65418
--- /dev/null
+++ b/challenge-211/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 210 Task 2: Split Same Average
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+use feature 'say';
+
+use List::Util qw( sum );
+
+sub find_sum {
+    my ( $target_sum, @list ) = @_;
+    for ( 0..$#list ) {
+        return 1
+            if $list[$_] == $target_sum
+            || ( $list[$_] < $target_sum
+                && find_sum(
+                    $target_sum - $list[$_],
+                    @list[ $_ + 1 .. $#list ] ) );
+    }
+    return 0;
+}
+
+sub split_same_average {
+    my ( @list ) = @_;
+    my $sum = sum @list;
+    return "false"
+        unless $sum % 2 == 0;
+    my $target_sum = $sum / 2;
+    return find_sum( $target_sum, @list ) ? "true" : "false";
+}
+
+use Test::More;
+
+do {
+    is find_sum( @{$_->{INPUT}} ), $_->{EXPECTED},
+        "find_sum(" . join( ",", @{$_->{INPUT}} )
+            . ") == " . $_->{EXPECTED};
+} for (
+    { INPUT => [ 6, 8,1,7,3,4,2,6,7 ], EXPECTED => 1 },
+);
+
+do {
+    is_deeply split_same_average( @{$_->{INPUT}} ), $_->{EXPECTED},
+        "split_same_average(" . join( ",", @{$_->{INPUT}} )
+            . ") == " . $_->{EXPECTED};
+} for (
+    { INPUT => [ 1..8 ], EXPECTED => "true" },
+    { INPUT => [ 1,3 ], EXPECTED => "false", },
+);
+
+done_testing;