Merge pull request #7399 from boblied/master

Week 199 boblied

3 files changed, 171 insertions, 2 deletions

diff --git a/challenge-199/bob-lied/README b/challenge-199/bob-lied/README
index 1f6208e964..5a7d2f0335 100644
--- a/challenge-199/bob-lied/README
+++ b/challenge-199/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 198 by Bob Lied
+Solutions to weekly challenge 199 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-198/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-199/
diff --git a/challenge-199/bob-lied/perl/ch-1.pl b/challenge-199/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..3c256dda17
--- /dev/null
+++ b/challenge-199/bob-lied/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 199, Task 1 Good Pairs
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of integers, @list.
+# Write a script to find the total count of Good Pairs.
+# A pair (i, j) is called good if list[i] == list[j] and i < j.
+# Example 1 Input: @list = (1,2,3,1,1,3) Output: 4
+#   There are 4 good pairs found as below:
+#   (0,3) (0,4) (3,4) (2,5)
+# Example 2 Input: @list = (1,2,3) Output: 0
+# Example 3 Input: @list = (1,1,1,1) Output: 6
+#   Good pairs are below:
+#   (0,1) (0,2) (0,3) (1,2) (1,3) (2,3)
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/sum/;
+use List::MoreUtils qw/frequency/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+(my $lst = "@ARGV") =~ s/[[:punct:]]/ /g;
+say goodPairs [ split ' ' $lst ];
+
+# We don't actually have to enumerate the pairs, so let's
+# work with just counting the partitiions of equal values.
+# Using List::MoreUtils::frequency gives us the count of how
+# often each number occurs.
+sub goodPairs($list)
+{
+    my %f = List::MoreUtils::frequency @$list;
+    # Eliminate things that have no pairs at all
+    my @p = grep { $f{$_} > 1 } keys %f;
+    return 0 unless @p;
+
+    # The count of pairs is the combination of N things taken
+    # 2 at a time, n!/2*(n-2)! = n*(n-1)/2.
+    # Math::Combinatorics has an nCr function, but that's overkill here.
+    my $s = sum map { my $n = $f{$_}; $n*($n-1)/2 } @p;
+    return $s;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( goodPairs( [1,2,3,1,1,3] ), 4, "Example 1");
+    is( goodPairs( [1,2,3      ] ), 0, "Example 2");
+    is( goodPairs( [1,1,1,1    ] ), 6, "Example 2");
+
+    done_testing;
+}
+
diff --git a/challenge-199/bob-lied/perl/ch-2.pl b/challenge-199/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..b4d0f614d1
--- /dev/null
+++ b/challenge-199/bob-lied/perl/ch-2.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 199 Task 2 Good Triplets
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of integers, @array and three integers $x,$y,$z.
+# Write a script to find out total Good Triplets in the given array.
+# A triplet array[i], array[j], array[k] is good if it satisfies the
+# following conditions:
+#   a) 0 <= i < j < k <= n (size of given array)
+#   b) abs(array[i] - array[j]) <= x
+#   c) abs(array[j] - array[k]) <= y
+#   d) abs(array[i] - array[k]) <= z
+#
+# Example 1
+# Input: @array = (3,0,1,1,9,7) and $x = 7, $y = 2, $z = 3
+# Output: 4
+#   Good Triplets are as below:
+#   (3,0,1) where (i=0, j=1, k=2) 3-0 <= 7, 1-0 <= 2, 1-0 <= 3
+#   (3,0,1) where (i=0, j=1, k=3)
+#   (3,1,1) where (i=0, j=2, k=3) 3-1 <= 7, 3-1 <= 2, 1-1 <= 3
+#   (0,1,1) where (i=1, j=2, k=3) 1-0 <= 7, 1-0 <= 2, 1-1 <= 3
+#
+# Example 2
+# Input: @array = (1,1,2,2,3) and $x = 0, $y = 0, $z = 1
+# Output: 0
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/all/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub usage() { "Usage: $0 '1,2,3...' x y z" }
+
+my ($a, $x, $y, $z) = @ARGV;
+die usage() unless all { defined $_ } $a, $x, $y, $z;
+die ( usage() . "x y z positive integers") unless all { m/[0-9]+/ } $x, $y, $z;
+
+$a =~ s/[[:punct:]]/ /g;
+my @array = split ' ', $a;
+
+say "array=[@array] x=$x y=$y z=$z" if $Verbose;
+
+say goodTriplets( \@array, $x, $y, $z);
+
+sub showTriple($a, $i, $j, $k)
+{
+    my $s = sprintf("[%3d, %3d, %3d]", $i, $j, $k);
+    $s .=   sprintf(" %3d  %3d  %3d ", $a->@[$i, $j, $k]);
+    return $s
+}
+
+sub goodTriplets($array, $x, $y, $z)
+{
+    my $len = scalar(@$array);
+    my $count = 0;
+    # We have to leave room for j and k, so we can skip last two
+    for ( my $i = 0 ; $i < ($len-2) ; $i++ )
+    {
+        for (my $j = $i + 1; $j < ($len-1) ; $j++ )
+        {
+            next unless ( abs( $array->[$i] - $array->[$j] ) <= $x );
+            for ( my $k = $j + 1; $k < $len ; $k++ )
+            {
+                if (   abs( $array->[$j] - $array->[$k] ) <= $y
+                    && abs( $array->[$i] - $array->[$k] ) <= $z
+                   )
+                {
+                    say showTriple($array, $i, $j, $k) if $Verbose;
+                    $count++;
+                }
+            }
+        }
+    }
+    return $count;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( goodTriplets( [ 3,0,1,1,9,7 ], 7,2,3 ),   4, "Example 1");
+    is( goodTriplets( [ 1,1,2,2,3   ], 0,0,1 ),   0, "Example 2");
+    is( goodTriplets( [             ], 1,2,3 ),   0, "Empty array");
+    is( goodTriplets( [ 1           ], 1,2,3 ),   0, "array of 1");
+    is( goodTriplets( [ 1,2         ], 1,2,3 ),   0, "array of 2");
+    is( goodTriplets( [ 1,2,3       ], 1,2,3 ),   1, "array of 3");
+    is( goodTriplets( [ 1,2,7       ], 1,2,3 ),   0, "array of 3 fail");
+    is( goodTriplets( [ 1,1,1,1     ], 0,0,0 ),   4, "zero diffs");
+    is( goodTriplets( [ 1,3,5,7,9   ], 2,2,3 ),   0, "two diffs, 0");
+    is( goodTriplets( [ 1,3,5,7,9   ], 2,2,4 ),   3, "two diffs, 2");
+    is( goodTriplets( [ 1,3,5,7,9   ], 2,2,4 ),   3, "two diffs, 3");
+    is( goodTriplets( [ 1 .. 100    ], 2,2,4 ), 388, "one hundred");
+
+    done_testing;
+}
+