Merge pull request #7407 from boblied/master

Backlog week 187 and 188 from bob-lied

6 files changed, 377 insertions, 4 deletions

diff --git a/challenge-187/bob-lied/README b/challenge-187/bob-lied/README
index c231e3a589..63f6ba869f 100644
--- a/challenge-187/bob-lied/README
+++ b/challenge-187/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 187 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-187/
diff --git a/challenge-187/bob-lied/perl/ch-1.pl b/challenge-187/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..0f6d3335e1
--- /dev/null
+++ b/challenge-187/bob-lied/perl/ch-1.pl
@@ -0,0 +1,125 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 187 Task 1 Days Together
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# Two friends, Foo and Bar gone on holidays seperately to the same city.
+# You are given their schedule i.e. start date and end date.
+# To keep the task simple, the date is in the form DD-MM and all dates belong
+# to the same calendar year i.e. between 01-01 and 31-12. Also the year is
+# non-leap year and both dates are inclusive.
+# Write a script to find out for the given schedule, how many days they spent
+# together in the city, if at all.
+#
+# Example 1 Input: Foo => SD: '12-01' ED: '20-01'
+#                  Bar => SD: '15-01' ED: '18-01'
+#   Output: 4 days
+#
+# Example 2 Input: Foo => SD: '02-03' ED: '12-03'
+#                  Bar => SD: '13-03' ED: '14-03'
+#   Output: 0 day
+#
+# Example 3 Input: Foo => SD: '02-03' ED: '12-03'
+#                  Bar => SD: '11-03' ED: '15-03'
+#   Output: 2 days
+#
+# Example 4 Input: Foo => SD: '30-03' ED: '05-04'
+#                  Bar => SD: '28-03' ED: '02-04'
+#   Output: 4 days
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+my %Schedule = (
+    example1 => { Foo => { SD => '12-01', ED => '20-01' },
+                  Bar => { SD => '15-01', ED => '18-01' },
+              },
+    example2 => { Foo => { SD => '02-03', ED => '12-03' },
+                  Bar => { SD => '13-03', ED => '14-03' },
+              },
+    example3 => { Foo => { SD => '02-03', ED => '12-03' },
+                  Bar => { SD => '11-03', ED => '15-03' },
+              },
+    example4 => { Foo => { SD => '30-03', ED => '05-04' },
+                  Bar => { SD => '28-03', ED => '02-04' },
+              },
+);
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+if ( @ARGV )
+{
+    my ($fooSD, $fooED, $barSD, $barED) = @ARGV;
+    say _together($fooSD, $fooED, $barSD, $barED);
+}
+else
+{
+    my $Sched="
+    Foo => SD: '12-01' ED: '20-01'
+    Bar => SD: '15-01' ED: '18-01'
+    ";
+
+    my $sch = parseSched($Sched);
+    say together('Foo', 'Bar', $sch);
+
+    $sch = parseSched( qq(X => SD: '02-03' ED: '12-03' Y => SD: '13-03' ED: '14-03') );
+    say together('X', 'Y', $sch);
+}
+
+sub parseSched($s)
+{
+    my %sched;
+    while ( $s =~ m/(\w+) => SD: '([-0-9]+)' ED: '([-0-9]+)'/g )
+    {
+        $sched{$1} = { SD => $2, ED => $3 };
+    }
+    return \%sched;
+}
+
+sub dayOfYear($ddmm)
+{
+    use Time::Piece;
+
+    # Use a non-leap year as default
+    return Time::Piece->strptime("$ddmm-2023", "%d-%m-%Y")->day_of_year;
+}
+
+sub _together($aSD, $aED, $bSD, $bED)
+{
+    my $days = 0;
+    # Test for overlapping ranges
+    if ( $aED >= $bSD && $bSD <= $aED )
+    {
+        use List::Util qw/min max/;
+        $days = min($aED, $bED) - max($aSD, $bSD) + 1;
+    }
+    return $days;
+}
+
+sub together($friendA, $friendB, $sched)
+{
+    my ($aSD, $aED) = map { dayOfYear($_) } $sched->{$friendA}->@{qw/SD ED/};
+    my ($bSD, $bED) = map { dayOfYear($_) } $sched->{$friendB}->@{qw/SD ED/};
+
+    return _together($aSD, $aED, $bSD, $bED);
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( together( "Foo", "Bar", $Schedule{example1} ), 4, "Example 1");
+    is( together( "Foo", "Bar", $Schedule{example2} ), 0, "Example 1");
+    is( together( "Foo", "Bar", $Schedule{example3} ), 2, "Example 1");
+    is( together( "Foo", "Bar", $Schedule{example4} ), 4, "Example 1");
+
+    done_testing;
+}
+
diff --git a/challenge-187/bob-lied/perl/ch-2.pl b/challenge-187/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..d77e0d27ad
--- /dev/null
+++ b/challenge-187/bob-lied/perl/ch-2.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 187 Task 2 Magical Triplets
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of positive numbers, @n, having at least 3 numbers.
+# Write a script to find the triplets (a, b, c) from the given list that
+# satisfies the following rules.
+#   1. a + b > c
+#   2. b + c > a
+#   3. a + c > b
+#   4. a + b + c is maximum.
+# In case, you end up with more than one triplet having the maximum then
+# pick the triplet where a >= b >= c.
+#
+# Example 1 Input: @n = (1, 2, 3, 2); Output: (3, 2, 2)
+# Example 2 Input: @n = (1, 3, 2);    Output: ()
+# Example 3 Input: @n = (1, 1, 2, 3); Output: ()
+# Example 4 Input: @n = (2, 4, 3);    Output: (4, 3, 2)
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+use Memoize;
+memoize('_check');
+sub _check($a, $b, $c)
+{
+    if ( $a + $b > $c && $b + $c > $a && $a + $c > $b )
+    {
+        say "CHECK: ($a $b $c)" if $Verbose;
+        return $a + $b + $c;
+    }
+    return -1;
+}
+
+sub magic($list)
+{
+    my $n = scalar(@$list);
+    my @result = ();
+    my $max = 0;
+
+    my ($a, $b, $c);
+    for ( my $i = 0 ; $i < $n ; $i++ )
+    {
+        for ( my $j = 0; $j < $n ; $j++ )
+        {
+            next if $j == $i;
+            ($a, $b) = $list->@[$i,$j];
+
+            for ( my $k = 0 ; $k < $n ; $k++ )
+            {
+                next if $k == $i || $k == $j;
+
+                $c = $list->[$k];
+                if ( (my $sum = _check($a, $b, $c)) > $max )
+                {
+                    say "  CHOSE: [$a,$b,$c] = $sum" if $Verbose;
+                    @result = ($a, $b, $c);
+                    $max = $sum;
+                }
+                elsif ( $sum == $max )
+                {
+                    if ( $a >= $b && $b >= $c )
+                    {
+                        say "  CHOSE: [$a,$b,$c] = $sum" if $Verbose;
+                        @result = ( $a, $b, $c );
+                    }
+                }
+            }
+        }
+    }
+
+    return \@result;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( magic( [ 1,2,3,2] ), [3,2,2], "Example 1");
+    is( magic( [ 1,3,2  ] ), [     ], "Example 2");
+    is( magic( [ 1,1,2,3] ), [     ], "Example 3");
+    is( magic( [ 2,4,3  ] ), [4,3,2], "Example 4");
+
+    done_testing;
+}
diff --git a/challenge-188/bob-lied/README b/challenge-188/bob-lied/README
index c231e3a589..1b18892e54 100644
--- a/challenge-188/bob-lied/README
+++ b/challenge-188/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 188 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-188/
diff --git a/challenge-188/bob-lied/perl/ch-1.pl b/challenge-188/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..b67fbc6902
--- /dev/null
+++ b/challenge-188/bob-lied/perl/ch-1.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 188 Task 1 Divisible Pairs
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given list of integers @list of size $n and divisor $k.
+# Write a script to find out count of pairs in the given list that satisfies
+# the following rules.
+#
+# The pair (i, j) is eligible if and only if
+# a) 0 <= i < j < len(list)
+# b) list[i] + list[j] is divisible by k
+#
+# Example 1 Input: @list = (4, 5, 1, 6), $k = 2 Output: 2
+# Example 2 Input: @list = (1, 2, 3, 4), $k = 2 Output: 2
+# Example 3 Input: @list = (1, 3, 4, 5), $k = 3 Output: 2
+# Example 4 Input: @list = (5, 1, 2, 3), $k = 4 Output: 2
+# Example 5 Input: @list = (7, 2, 4, 5), $k = 4 Output: 1
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub divPair($list, $k)
+{
+    my $n = scalar(@$list);
+    my $count = 0;
+
+    for ( my $i = 0 ; $i < ($n-1) ; $i++ )
+    {
+        for ( my $j = $i + 1 ; $j < $n ; $j++ )
+        {
+            $count++ if ( ($list->[$i] + $list->[$j]) % $k) == 0;
+        }
+    }
+    return $count;
+}
+
+sub divPair2($list, $k)
+{
+    my $n = scalar(@$list);
+    my $count = 0;
+
+    for ( my $i = 0 ; $i < ($n-1) ; $i++ )
+    {
+        my $x = $list->[$i];
+        # Array slice of elements after i
+        # map -- perform the arithmetic on each element
+        # grep -- choose the ones where remainder is zero
+        #   scalar context returns count of matches
+        $count += grep { $_ == 0 } map { ( $_ + $x ) % $k } $list->@[$i+1 .. $n-1];
+    }
+    return $count;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( divPair( [ 4,5,1,6 ], 2), 2, "Example 1");
+    is( divPair( [ 1,2,3,4 ], 2), 2, "Example 2");
+    is( divPair( [ 1,3,4,5 ], 3), 2, "Example 3");
+    is( divPair( [ 5,1,2,3 ], 4), 2, "Example 4");
+    is( divPair( [ 7,2,4,5 ], 4), 1, "Example 5");
+
+    is( divPair2( [ 4,5,1,6 ], 2), 2, "Example 1");
+    is( divPair2( [ 1,2,3,4 ], 2), 2, "Example 2");
+    is( divPair2( [ 1,3,4,5 ], 3), 2, "Example 3");
+    is( divPair2( [ 5,1,2,3 ], 4), 2, "Example 4");
+    is( divPair2( [ 7,2,4,5 ], 4), 1, "Example 5");
+
+    done_testing;
+}
+
diff --git a/challenge-188/bob-lied/perl/ch-2.pl b/challenge-188/bob-lied/perl/ch-2.pl
new file mode 100755
index 0000000000..e145ecbe23
--- /dev/null
+++ b/challenge-188/bob-lied/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 188 Task 2 Total Zero
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given two positive integers $x and $y.
+# Write a script to find out the number of operations needed to make both ZERO.
+# Each operation is made up either of the followings:
+#    $x = $x - $y if $x >= $y
+# or
+#   $y = $y - $x if $y >= $x (using the original value of $x)
+#
+# Example 1 Input: $x = 5, $y = 4 Output: 5
+# Example 2 Input: $x = 4, $y = 6 Output: 3
+# Example 3 Input: $x = 2, $y = 5 Output: 4
+# Example 4 Input: $x = 3, $y = 1 Output: 3
+# Example 5 Input: $x = 7, $y = 4 Output: 5
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub usage { "Usage: $0 x y   # x and y positive integers" }
+
+my ($x, $y) = @ARGV;
+die usage() unless $x > 0 && $y > 0;
+
+say totalZero($x, $y);
+
+sub totalZero($x, $y)
+{
+    my $count = 0;
+    while ( ! ($x == 0 && $y == 0 ) )
+    {
+        my $x0 = $x;
+        if ( $x >= $y )
+        {
+            $x = $x - $y;
+        }
+        if ( $y >= $x && $y >= $x0 )
+        {
+            $y = $y - $x0;
+        }
+        $count++;
+        say "$count: x=$x y=$y" if $Verbose;
+    }
+    return $count;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is(totalZero(0,0), 0, "Example 0");
+    is(totalZero(5,4), 5, "Example 1");
+    is(totalZero(4,6), 3, "Example 2");
+    is(totalZero(2,5), 4, "Example 3");
+    is(totalZero(3,1), 3, "Example 4");
+    is(totalZero(7,4), 5, "Example 5");
+
+    done_testing;
+}
+