Merge pull request #7667 from boblied/master

Week 206

4 files changed, 165 insertions, 3 deletions

diff --git a/challenge-206/bob-lied/README b/challenge-206/bob-lied/README
index 2f7d2577c4..4dcb1ff367 100644
--- a/challenge-206/bob-lied/README
+++ b/challenge-206/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 205 by Bob Lied
+Solutions to weekly challenge 206 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-205/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-205/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-206/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-206/bob-lied
diff --git a/challenge-206/bob-lied/blog.txt b/challenge-206/bob-lied/blog.txt
new file mode 100644
index 0000000000..2709e8dfda
--- /dev/null
+++ b/challenge-206/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/max-sum-of-minimum-pairs-35i7
diff --git a/challenge-206/bob-lied/perl/ch-1.pl b/challenge-206/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..b803fb3d44
--- /dev/null
+++ b/challenge-206/bob-lied/perl/ch-1.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 206 Task 1 Shortest Time
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of time points, at least 2, in the 24-hour clock format
+# HH:MM. Write a script to find out the shortest time in minutes between any
+# two time points.
+# Example 1 Input: @time = ("00:00", "23:55", "20:00") Output: 5
+#   Since the difference between "00:00" and "23:55" is the shortest
+# Example 2 Input: @array = ("01:01", "00:50", "00:57") Output: 4
+# Example 3 Input: @array = ("10:10", "09:30", "09:00", "09:55") Output: 15
+##
+# Example 1 implies that 00:00 can represent midnight either at the start
+# of the day, or at the end of the day.  Ambiguous if 24:00 is allowed.
+#
+# All the interesting times involve midnight.  If all the
+# points were within the same day, then a pair like 00:10, 23:50 would be
+# 23 hours and 40 minutes long.  But if we allow wrapping around midnight,
+# there's only 20 minutes between them.  The problem specification is
+# ambiguously silent, except that example with 00:00 kind of implies that
+# we should wrap around.
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/min/;
+
+use constant  {
+    MINPERDAY => 24 * 60
+};
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+# Map a string in HH:MM format to the minute past midnight.
+sub hhmmToMin($hhmm)
+{
+    my ($hour, $min) = split(':', $hhmm);
+    my $minOfDay = $hour * 60 + $min;
+    return ($minOfDay == MINPERDAY ? 0 : $minOfDay);
+}
+
+sub shortestTime($moments)
+{
+    my @minutes =  map { hhmmToMin($_) } $moments->@*;
+
+    my $least = MINPERDAY;
+
+    # Do a full NxN scan of every possible pair.  Getting the difference
+    # in either direction will wash away the ambiguity of 00:00.
+    for ( my $beg = 0 ; $beg <= $#minutes ; $beg++ )
+    {
+        for ( my $end = 0; $end <= $#minutes ; $end++ )
+        {
+            next if $end == $beg;
+            my $d1 = ( $minutes[$end] - $minutes[$beg] ) % MINPERDAY;
+            $least = min($least, $d1 );
+        }
+    }
+    return $least;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( shortestTime( [ "00:00", "23:55", "20:00" ] ),           5, "Example 1");
+    is( shortestTime( [ "01:01", "00:50", "00:57" ] ),           4, "Example 2");
+    is( shortestTime( [ "10:10", "09:30", "09:00", "09:55" ] ), 15, "Example 3");
+
+    is( shortestTime( [ "00:02", "23:58", "00:57" ] ),           4, "'round midnight");
+    is( shortestTime( [ "00:02", "00:57", "00:02" ] ),           0, "Zero");
+    is( shortestTime( [ "23:55", "24:00", "00:02" ] ),           2, "24:00");
+    is( shortestTime( [ "23:55", "24:00", "00:07" ] ),           5, "24:00 again");
+
+    done_testing;
+}
+
diff --git a/challenge-206/bob-lied/perl/ch-2.pl b/challenge-206/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..084b481d5a
--- /dev/null
+++ b/challenge-206/bob-lied/perl/ch-2.pl
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 206 Task 2 Array Pairings
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of integers having even number of elements.
+# Write a script to find the maximum sum of the minimum of each pairs.
+# Example 1 Input: @array = (1,2,3,4) Output: 4
+#   Possible Pairings are as below:
+#   a) (1,2) and (3,4). So min(1,2) + min(3,4) => 1 + 3 => 4
+#   b) (1,3) and (2,4). So min(1,3) + min(2,4) => 1 + 2 => 3
+#   c) (1,4) and (2,3). So min(1,4) + min(2,3) => 2 + 1 => 3
+#   So the maxium sum is 4.
+#
+# Example 2 Input: @array = (0,2,1,3) Output: 2
+#   Possible Pairings are as below:
+#   a) (0,2) and (1,3). So min(0,2) + min(1,3) => 0 + 1 => 1
+#   b) (0,1) and (2,3). So min(0,1) + min(2,3) => 0 + 2 => 2
+#   c) (0,3) and (2,1). So min(0,3) + min(2,1) => 0 + 1 => 1
+#   So the maximum sum is 2.
+#
+# The eager programer immediately jumps to a literal interpretation
+# and generates all pairs, then reduces the list by adding all
+# possible pairs.
+#
+# But this is more of a brain-teaser than a programming challenge.
+# After looking at a couple of examples, you notice that the maximum
+# sum is the sum of the largest numbers in the list that could be
+# selected.
+#
+# If we sort the list descending, then the first four numbers will be the
+# two pairs with the largest values, and the maximum sum is elements 1 plus 3.
+#   a  >  b  >  c  >  d  > ...
+#   min(a,b) + min(c,d)
+#      b     +    d
+#
+# The examples show lists with only two pairs, so I originally made a bad
+# assumption that the answer was the sum of the two largest pairs.  But the
+# description actually says "sum of of the minimum of each pair."  So it's
+# not just the first two pairs in the sort, but the sum of the minima of
+# all the pairs in the sort.
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/sum/;
+
+use Getopt::Long;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest);
+exit(!runTest()) if $DoTest;
+
+say arrayPairs(\@ARGV);
+
+sub arrayPairs($list)
+{
+    my @oddIndex = map { $_ * 2 + 1 } 0 .. int( $#{$list} / 2 );
+    return sum(  (sort { $b <=> $a } $list->@*)[@oddIndex] );
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( arrayPairs([1,2,3,4]), 4, "Example 1");
+    is( arrayPairs([0,2,1,3]), 2, "Example 1");
+
+    is( arrayPairs([3,3,3,3]), 6, "All same");
+    is( arrayPairs([1,2,3,4,5,6,7,8]), 16, "1..8");
+
+    done_testing;
+}