Merge pull request #9003 from boblied/master

Week 241 solutions Bob Lied

4 files changed, 135 insertions, 3 deletions

diff --git a/challenge-241/bob-lied/README b/challenge-241/bob-lied/README
index 152add2898..9391e2c242 100644
--- a/challenge-241/bob-lied/README
+++ b/challenge-241/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 240 by Bob Lied
+Solutions to weekly challenge 241 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-240/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-240/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-241/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-241/bob-lied
diff --git a/challenge-241/bob-lied/blog.txt b/challenge-241/bob-lied/blog.txt
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/challenge-241/bob-lied/blog.txt
diff --git a/challenge-241/bob-lied/perl/ch-1.pl b/challenge-241/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..efb05edce9
--- /dev/null
+++ b/challenge-241/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 241 Task 1 Arithmetic Triplets
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array (3 or more members) of integers in increasing
+# order and a positive integer.  Write a script to find out the number
+# of unique Arithmetic Triplets satisfying the following rules:
+# a) i < j < k
+# b) nums[j] - nums[i] == diff
+# c) nums[k] - nums[j] == diff
+# Example 1 Input: @nums = (0, 1, 4, 6, 7, 10) $diff = 3
+#           Output: 2
+#   Index (1, 2, 4) is an arithmetic triplet
+#   because both  7 - 4 == 3 and 4 - 1 == 3.
+#   Index (2, 4, 5) is an arithmetic triplet
+#   because both 10 - 7 == 3 and 7 - 4 == 3.
+# Example 2 Input: @nums = (4, 5, 6, 7, 8, 9) $diff = 2
+#           Output: 2
+#   (0, 2, 4) is an arithmetic triplet with difference 2
+#   (1, 3, 5) is an arithmetic triplet with difference 2
+#=============================================================================
+
+use v5.38;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+my $Diff;
+
+GetOptions("diff:i" => \$Diff, "test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+die "Usage: $0 -d DIFF m n o ..." unless defined $Diff && @ARGV > 0;
+
+say triplet($Diff, @ARGV);
+
+sub triplet($diff, @nums)
+{
+    my $count = 0;
+    my @show;
+    for ( my $i = 0 ; $i <= $#nums-2; $i++ )
+    {
+        for ( my $j = $i+1; $j <= $#nums-1; $j++ )
+        {
+            my $dj = $nums[$j] - $nums[$i];
+
+            # Input is sorted, so stop once the difference is too big.
+            last if $dj > $diff;
+            next unless $dj == $diff;
+
+            for ( my $k = $j+1; $k <= $#nums ; $k++ )
+            {
+                my $dk = $nums[$k] - $nums[$j];
+                last if $dk > $diff;
+                if ( $dk == $diff )
+                {
+                    $count++;
+                    push @show, [ $i, $j, $k ] if $Verbose;
+                }
+            }
+        }
+    }
+    if ( $Verbose )
+    {
+        for my $triplet ( @show )
+        {
+            say "\@nums[$triplet->@*] = ( @nums[$triplet->@*] )";
+        }
+    }
+    return $count;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( triplet(3, 0,1,4,6,7,10), 2, "Example 1");
+    is( triplet(2, 4,5,6,7,8,9 ), 2, "Example 2");
+
+    done_testing;
+}
diff --git a/challenge-241/bob-lied/perl/ch-2.pl b/challenge-241/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..ee37342218
--- /dev/null
+++ b/challenge-241/bob-lied/perl/ch-2.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 241 Task 2 Prime Order 
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of unique positive integers greater than 2.
+# Write a script to sort them in ascending order of the count of their
+# prime factors, tie-breaking by ascending value.
+# Example 1 Input: @int = (11, 8, 27, 4)
+#           Output: (11, 4, 8, 27))
+#   Prime factors of 11 => 11
+#   Prime factors of  4 => 2, 2
+#   Prime factors of  8 => 2, 2, 2
+#   Prime factors of 27 => 3, 3, 3
+#=============================================================================
+
+use v5.38;
+
+use Math::Prime::Util qw/factor/;
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say "(", join(", ", primeOrder(@ARGV)->@*), ")";
+
+sub primeOrder(@int)
+{
+    [
+        map { $_->[0] }
+            sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] }
+                map { [ $_, scalar(factor($_)) ] } @int
+    ]
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( primeOrder(11, 8, 27, 4), [ 11, 4, 8, 27 ], "Example 1");
+
+    done_testing;
+}