Merge pull request #8374 from boblied/master

Week 225 solutions from Bob Lied

3 files changed, 152 insertions, 3 deletions

diff --git a/challenge-225/bob-lied/README b/challenge-225/bob-lied/README
index 169a7cc554..552c202c4f 100644
--- a/challenge-225/bob-lied/README
+++ b/challenge-225/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 222 by Bob Lied
+Solutions to weekly challenge 225 by Bob Lied
 
-https://perlweeklychallenge.222org/blog/perl-weekly-challenge-222/
-https://github.com/boblied/perlweeklychallenge-222club/tree/master/challenge-222/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-225/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-222/bob-lied
diff --git a/challenge-225/bob-lied/perl/ch-1.pl b/challenge-225/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..431f56e78a
--- /dev/null
+++ b/challenge-225/bob-lied/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Task 1 Max Words
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of sentences, @list.
+# A sentence is a list of words that are separated by a single space with
+# no leading or trailing spaces.
+# Write a script to find out the maximum number of words that appear in a
+# single sentence.
+# Example 1 Input: @list = ("Perl and Raku belong to the same family.",
+#                           "I love Perl.",
+#                           "The Perl and Raku Conference.")
+#          Output: 8
+# Example 2 Input: @list = ("The Weekly Challenge.",
+#                           "Python is the most popular guest language.",
+#                           "Team PWC has over 300 members.")
+#       Output: 7
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/max/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say maxWords(\@ARGV);
+
+sub maxWords($list)
+{
+    return List::Util::max map { scalar(split(" ", $_)) } @$list;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( maxWords(
+[ "Perl and Raku belong to the same family.",
+  "I love Perl.",
+  "The Perl and Raku Conference." ]
+            ), 8, "Example 1");
+
+    is( maxWords(
+[ "The Weekly Challenge.",
+  "Python is the most popular guest language.",
+  "Team PWC has over 300 members." ],
+            ), 7, "Example 2");
+
+    done_testing;
+}
+
diff --git a/challenge-225/bob-lied/perl/ch-2.pl b/challenge-225/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..f106571178
--- /dev/null
+++ b/challenge-225/bob-lied/perl/ch-2.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Task 2 Left Right Sum Diff 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of integers, @ints.
+# Write a script to return left right sum diff array as shown below:
+#   @ints = (a, b, c, d, e)
+#   @left  = (0, a, (a+b), (a+b+c), (a+b+c+d))
+#   @right = ((b+(c+d+e), (d+e), e, 0)
+#   @left_right_sum_diff = ( | 0         - (b+c+d+e) |,
+#                            | a         - (c+d+e)   |,
+#                            | (a+b)     - (d+e)   |,
+#                            | (a+b+c)   - e |,
+#                            | (a+b+c+d) - 0 | )
+######
+# This is kind of an awkward description of the problem. Another way to look
+# at it is that, for every index k, there is a sum of the elements to the
+# left, and a sum of the elements to the right. We want a vector of the
+# differences at each k. At the edges, for k=1, left=0; and for k=n, right=0.
+# _________________________________________
+# |1| <--left-sum--  |k| --right-sum--> |n|
+# -----------------------------------------
+######
+#
+# Example 1: Input: @ints = (10, 4, 8, 3)
+#           Output: (15, 1, 11, 22)
+#   @left  = (0, 10, 14, 22)
+#   @right = (15, 11, 3, 0)
+#   @left_right_sum_diff = ( |0-15|, |10-11|, |14-3|, |22-0|)
+#                          = (15, 1, 11, 22)
+# Example 2: Input: @ints = (1)
+#           Output: (0)
+#   @left  = (0)
+#   @right = (0)
+#   @left_right_sum_diff = ( |0-0| ) = (0)
+#
+# Example 3: Input: @ints = (1, 2, 3, 4, 5)
+#           Output: (14, 11, 6, 1, 10)
+#   @left  = (0, 1, 3, 6, 10)
+#   @right = (14, 12, 9, 5, 0)
+#   @left_right_sum_diff = ( |0-14|, |1-12|, |3-9|, |6-5|, |10-0|)
+#                        = (14, 11, 6, 1, 10)
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/sum0/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say "(", join(", ", lrsd(@ARGV)->@*), ")";
+
+sub lrsd(@ints)
+{
+    my $left = 0;
+    my $right = sum0(@ints);
+
+    # Accumulate the differences in this array.  Pre-allocate to be the
+    # same size as the input array.
+    my @diff; $#diff = $#ints;
+
+    # Walk the array. At each step, add a term to the left sum
+    # and subtract a term from the right sum.
+    for my $i ( 0 .. $#ints )
+    {
+        $right -= $ints[$i];
+        $diff[$i] = abs($left - $right);
+        $left += $ints[$i];
+    }
+    return \@diff;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( lrsd(10,4,8,3 ), [ 15,  1, 11, 22     ], "Example 1");
+    is( lrsd(1        ), [  0                 ], "Example 2");
+    is( lrsd(1,2,3,4,5), [ 14, 11,  6,  1, 10 ], "Example 3");
+
+    done_testing;
+}