Merge pull request #7879 from boblied/w211

W211

4 files changed, 199 insertions, 3 deletions

diff --git a/challenge-211/bob-lied/README b/challenge-211/bob-lied/README
index 9dcb79147f..f0a2cbdf2a 100644
--- a/challenge-211/bob-lied/README
+++ b/challenge-211/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 210 by Bob Lied
+Solutions to weekly challenge 211 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-210/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-210/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-211/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-211/bob-lied
diff --git a/challenge-211/bob-lied/blog.txt b/challenge-211/bob-lied/blog.txt
new file mode 100644
index 0000000000..70c913b0ca
--- /dev/null
+++ b/challenge-211/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-211-2-geared-to-the-average-rather-than-the-exceptional-2hcg
diff --git a/challenge-211/bob-lied/perl/ch-1.pl b/challenge-211/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..e6ead271b7
--- /dev/null
+++ b/challenge-211/bob-lied/perl/ch-1.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 211 Task 1 Toeplitz Matrix
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a matrix m x n.
+# Write a script to find out if the given matrix is Toeplitz Matrix.
+# A matrix is Toeplitz if every diagonal from top-left to bottom-right has
+# the same elements.
+# Example 1 Input: @matrix = [ [4, 3, 2, 1],
+#                              [5, 4, 3, 2],
+#                              [6, 5, 4, 3],
+#                 ]
+#   Output: true
+#
+# Example 2 Input: @matrix = [ [1, 2, 3],
+#                              [3, 2, 1],
+#                  ]
+#   Output: false
+#=============================================================================
+
+use v5.36;
+
+no warnings "experimental::builtin";
+use builtin qw(true false);
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub checkDiagonal($matrix, $N, $M, $r, $c)
+{
+    my $first = $matrix->[$r][$c];
+    while ( ++$r <= $N && ++$c <= $M )
+    {
+        return false if $matrix->[$r][$c] != $first;
+    }
+    return true;
+}
+
+# This solution checks every diagonal.
+sub isToeplitz_A($matrix)
+{
+    my $maxRow = $matrix->$#*;
+    my $maxCol = $matrix->[0]->$#*;
+
+    # Trivially true for n X 1 or 1 X m
+    return true if $maxRow == 0  ||  $maxCol == 0;
+
+    # Diagonals from the left edge.  Bottom left corner can be skipped
+    for my $left ( 0 .. $maxRow-1 )
+    {
+        return false unless checkDiagonal($matrix, $maxRow, $maxCol, $left, 0);
+    }
+
+    # Diagonals from the top row. We already did main diagonal, and 
+    # we can skip the top right corner.
+    for my $top ( 1 .. $maxCol-1 )
+    {
+        return false unless checkDiagonal($matrix, $maxRow, $maxCol, 0, $top);
+    }
+    return true;
+}
+
+# If a matrix is Toeplitz, then every internal element of the matrix will
+# be equal to its upper left and lower right neighbor.  Slightly more efficient.
+sub isToeplitz($matrix)
+{
+    my $maxRow = $matrix->$#*;
+    my $maxCol = $matrix->[0]->$#*;
+
+    for ( my $r = 1 ; $r <= $maxRow ; $r++ )
+    {
+        for ( my $c = 1 ; $c <= $maxCol ; $c++ )
+        {
+            my $val = $matrix->[$r][$c];
+            return false if $matrix->[$r-1][$c-1] != $val;
+        }
+    }
+    return true;
+}
+
+sub runTest
+{
+    use Test2::V0;
+    no warnings "experimental::builtin";
+    use builtin qw(true false);
+
+    my @matrix;
+    @matrix = ( [4, 3, 2, 1],
+                [5, 4, 3, 2],
+                [6, 5, 4, 3], );
+    is( isToeplitz(\@matrix), true, "Example 1");
+
+    @matrix = ( [1, 2, 3],
+                [3, 2, 1], );
+    is( isToeplitz(\@matrix), false, "Example 2");
+
+    @matrix = ( [1, 2, 3] );
+    is( isToeplitz(\@matrix), true, "One row");
+
+    @matrix = ( [1], [2], [3] );
+    is( isToeplitz(\@matrix), true, "One column");
+
+    done_testing;
+}
diff --git a/challenge-211/bob-lied/perl/ch-2.pl b/challenge-211/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..9a3ff1c3a2
--- /dev/null
+++ b/challenge-211/bob-lied/perl/ch-2.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 211 Task 2 Split Same Average 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of integers.
+# Write a script to find out if the given can be split into two separate
+# arrays whose average are the same.
+# Example 1: Input: @nums = (1, 2, 3, 4, 5, 6, 7, 8)
+#           Output: true
+#   We can split the given array into (1, 4, 5, 8) and (2, 3, 6, 7).
+#   The average of the two arrays are the same i.e. 4.5.
+# Example 2: Input: @list = (1, 3)
+#            Output: false
+#=============================================================================
+
+use v5.36;
+
+no warnings "experimental::builtin";
+use builtin qw(true false ceil);
+
+use List::Util qw/sum0/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub canSplitAvg(@nums)
+{
+    my $n = @nums;
+    my $totalSum = 0;
+    $totalSum += $_ for @nums;
+
+    for ( my $Na = 1; $Na <= int($n / 2); $Na++ )
+    {
+        if ( ($totalSum * $Na) % $n == 0 )
+        {
+            my $Sa = $totalSum * $Na / $n;
+            say "canSplit: totalSum=$totalSum Sa=$Sa, Na=$Na" if $Verbose;
+            return true if ( canMakeSum(\@nums, $Sa, $Na, 0, "") )
+        }
+    }
+    return false;
+}
+
+sub canMakeSum($nums, $targetSum, $targetLength, $start, $indent)
+{
+    say "${indent}canMakeSum([$nums->@*]), $targetSum, $targetLength, $start)" if $Verbose;
+    return ($targetSum == 0) if ( $targetLength == 0 );
+
+    return 0 if ($start >= @$nums);
+
+    for ( my $i = $start; $i < @$nums; $i++ )
+    {
+        if ( $nums->[$i] <= $targetSum
+            && canMakeSum($nums, $targetSum - $nums->[$i], $targetLength - 1, $i + 1, "  $indent") )
+        {
+            return true;
+        }
+    }
+    return false;
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+    no warnings "experimental::builtin";
+    use builtin qw(true false);
+
+    is( canSplitAvg(1, 3), false, "Example 2");
+    is( canSplitAvg(3, 3), true,  "Obviously");
+    is( canSplitAvg(1..8), true,  "Example 1");
+    is( canSplitAvg(1,1,2,2,3,3,4,4), true, "why duplicate");
+    is( canSplitAvg(1,4,3,4,3,2,1,2), true, "no duplicate");
+
+    done_testing;
+}
+