Week 242 solutions and blog

4 files changed, 208 insertions, 3 deletions

diff --git a/challenge-242/bob-lied/README b/challenge-242/bob-lied/README
index 9391e2c242..d0794a2840 100644
--- a/challenge-242/bob-lied/README
+++ b/challenge-242/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 241 by Bob Lied
+Solutions to weekly challenge 242 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-241/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-241/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-242/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-242/bob-lied
diff --git a/challenge-242/bob-lied/blog.txt b/challenge-242/bob-lied/blog.txt
new file mode 100644
index 0000000000..e2fdfee0af
--- /dev/null
+++ b/challenge-242/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-242-flip-the-script-3p9k
diff --git a/challenge-242/bob-lied/perl/ch-1.pl b/challenge-242/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..57c3fc48d7
--- /dev/null
+++ b/challenge-242/bob-lied/perl/ch-1.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 242 Task 1 Missing Members
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given two arrays of integers.
+# Write a script to find out the missing members in each other arrays.
+# Example 1 Input: @arr1 = (1, 2, 3) @arr2 = (2, 4, 6)
+#           Output: ([1, 3], [4, 6])
+#   (1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).
+#   (2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).
+#
+# Example 2 Input: @arr1 = (1, 2, 3, 3) @arr2 = (1, 1, 2, 2)
+#           Output: ([3])
+#   (1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2).
+#   Since they are same, keep just one.
+#   (1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).
+# -----
+# In example 2, it seems like there should be an empty array to show that
+# the first array has no missing members, but instead the emtpy array is
+# suppressed. Taking that as the requirement.
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+# Supply two arguments as quoted strings.
+my @Arr1 = split(" ", $ARGV[0]);
+my @Arr2 = split(" ", $ARGV[1]);
+die qq(Usage: $0 "1 2 3" "3 4 5") unless @Arr1 && @Arr2;
+say toString( missingMembers(\@Arr1, \@Arr2) );
+
+# Turn an array-of-arrays reference into a bracketed string
+sub toString($aoa)
+{
+    my $str = "("
+            . join(", ", map { "[" . join(", ", $_->@*) . "]" } $aoa->@*)
+            . ")";
+}
+
+sub missingMembers($arr1, $arr2)
+{
+    # For each element of both arrays, note whether it occurs in
+    # the first array or the second by setting a bit.
+    # Each value of the hash will be 1, 2, or 3 if the member
+    # is in both arrays.
+    my %memberOf;
+    $memberOf{$_} |= 1 for $arr1->@*;
+    $memberOf{$_} |= 2 for $arr2->@*;
+
+    # Create an array of arrays, with four rows.
+    my @missing;
+
+    # Move each member to one of the arrays, using the bits we set above.
+    # $missing[0] will be unused
+    # $missing[1] has the members that are only in arr1
+    # $missing[2] has the members that are only in arr2
+    # $missing[3] has the members that are in both.
+    # The sort is here so that the result matches the example order.
+    for my $m ( sort { $a <=> $b } keys %memberOf )
+    {
+        push @{$missing[$memberOf{$m}]}, $m;
+    }
+
+    # Using a hash slice, return an array of array references for
+    # the members that are exclusively in one array or the other.
+    # Example 2 shows that we suppress empty arrays, hence the grep.
+    return [ grep { defined } @missing[1,2] ];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( toString([[]]), "([])", "a of a one empty");
+    is( toString([[5,6,7]]), "([5, 6, 7])", "a of a not empty");
+    is( toString([[],[]]), "([], [])", "a of a empties");
+    is( toString([[1],[2]]), "([1], [2])", "a of a singles");
+    is( toString([[1,2],[3,4]]), "([1, 2], [3, 4])", "a of a doubles");
+
+    is( missingMembers( [1,2,3], [2,4,6] ), [[1,3],[4,6]], "Example 1");
+    is( missingMembers( [1,2,3,3], [1,1,2,2] ), [[3]], "Example 2");
+
+    is( missingMembers( [1,1,2,2],[1,2,3,3] ), [[3]], "First empty");
+
+    done_testing;
+}
diff --git a/challenge-242/bob-lied/perl/ch-2.pl b/challenge-242/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..89b7e519d9
--- /dev/null
+++ b/challenge-242/bob-lied/perl/ch-2.pl
@@ -0,0 +1,108 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 242 Task 2 Flip Matrix 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given n x n binary matrix.
+# Write a script to flip the given matrix as below.
+# Original  a) Reverse each row b) Invert each member
+# 1 1 0        0 1 1               1 0 0
+# 0 1 1        1 1 0               0 0 1
+# 0 0 1        1 0 0               0 1 1
+#
+# Example 1 Input: @matrix = ([1, 1, 0], [1, 0, 1], [0, 0, 0])
+#           Output: ([1, 0, 0], [0, 1, 0], [1, 1, 1])
+# Example 2 Input: @matrix = ([1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0])
+#           Output: ([1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0])
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+my $DoBenchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$DoBenchmark);
+exit(!runTest()) if $DoTest;
+exit(benchmark($DoBenchmark)) if $DoBenchmark;
+
+sub flipMatrix($m)
+{
+    for my $row ( $m->@* )
+    {
+        for ( my ($front, $back) = (0, $row->$#*); $front <= $back ; $front++, $back-- )
+        {
+            $row->@[$front, $back] = map { ( $_ + 1 ) & 1 } $row->@[$back, $front];
+        }
+    }
+    return $m;
+}
+
+sub flipMatrix_B($m)
+{
+    my @result;
+    for my $row ( $m->@* )
+    {
+        push @result, [ map { $_ == 1 ? 0 : 1 } reverse $row->@* ];
+    }
+    return \@result;
+}
+
+sub flipMatrix_S($m)
+{
+    my @result;
+    for my $row ( $m->@* )
+    {
+        (my $s = reverse qq($row->@*)) =~ tr/01/10/;
+        push @result, [ split(" ", $s) ];
+    }
+    return \@result;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( flipMatrix([[1, 1, 0], [1, 0, 1], [0, 0, 0]]),
+        [[1, 0, 0], [0, 1, 0], [1, 1, 1]], "Example 1");
+
+    is( flipMatrix([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]]),
+        [[1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0]], "Example 2");
+
+    is( flipMatrix( [[]]),          [[]],          "0x0");
+    is( flipMatrix( [[1]]),         [[0]],         "1x1");
+    is( flipMatrix( [[1,0],[1,0]]), [[1,0],[1,0]], "2x2");
+
+    is( flipMatrix_B([[1, 1, 0], [1, 0, 1], [0, 0, 0]]),
+        [[1, 0, 0], [0, 1, 0], [1, 1, 1]], "B Example 1");
+
+    is( flipMatrix_B([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]]),
+        [[1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0]], "B Example 2");
+
+    is( flipMatrix_S([[1, 1, 0], [1, 0, 1], [0, 0, 0]]),
+        [[1, 0, 0], [0, 1, 0], [1, 1, 1]], "S Example 1");
+
+    is( flipMatrix_S([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]]),
+        [[1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0]], "S Example 2");
+
+    is( flipMatrix_B( [[]]),          [[]],          "0x0");
+    is( flipMatrix_B( [[1]]),         [[0]],         "1x1");
+    is( flipMatrix_B( [[1,0],[1,0]]), [[1,0],[1,0]], "2x2");
+    done_testing;
+}
+
+sub benchmark($repeat)
+{
+    use Benchmark qw/:all/;
+
+    cmpthese($repeat, {
+        'my reverse' => sub { flipMatrix([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]]) },
+        'builtin reverse' => sub { flipMatrix_B([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]]) },
+        'string tr' => sub { flipMatrix_S([[1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0]]) },
+    } );
+    return 0;
+}