Merge pull request #12696 from boblied/w339

Week 339 solutions from Bob Lied

4 files changed, 289 insertions, 4 deletions

diff --git a/challenge-339/bob-lied/README.md b/challenge-339/bob-lied/README.md
index 5247e8d471..373adf6206 100644
--- a/challenge-339/bob-lied/README.md
+++ b/challenge-339/bob-lied/README.md
@@ -1,5 +1,5 @@
-# Solutions to weekly challenge 338 by Bob Lied
+# Solutions to weekly challenge 339 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-338/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-338/bob-lied)
-[Blog](https://dev.to/boblied/pwc-338-maximal-maximization-of-maximums-4jm1)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-339/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-339/bob-lied)
+[Blog](https://dev.to/boblied/pwc-339-max-diff-sorting-for-the-win-43c8)
diff --git a/challenge-339/bob-lied/blog.txt b/challenge-339/bob-lied/blog.txt
new file mode 100644
index 0000000000..41aa667439
--- /dev/null
+++ b/challenge-339/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-339-max-diff-sorting-for-the-win-43c8
diff --git a/challenge-339/bob-lied/perl/ch-1.pl b/challenge-339/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..4c06115fec
--- /dev/null
+++ b/challenge-339/bob-lied/perl/ch-1.pl
@@ -0,0 +1,178 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 339 Task 1  Max Diff
+#=============================================================================
+# You are given an array of integers having four or more elements. Write a
+# script to find two pairs of numbers from this list (four numbers total)
+# so that the difference between their products is as large as possible.
+# In the end return the max difference. With Two pairs (a, b) and (c, d),
+# the product difference is (a * b) - (c * d).
+# Example 1 Input: @ints = (5, 9, 3, 4, 6)
+#           Output: 42
+#   Pair 1: (9, 6)  Pair 2: (3, 4)
+#   Product Diff: (9 * 6) - (3 * 4) => 54 - 12 => 42
+# Example 2 Input: @ints = (1, -2, 3, -4)
+#           Output: 10
+#   Pair 1: (1, -2) Pair 2: (3, -4)
+# Example 3 Input: @ints = (-3, -1, -2, -4)
+#           Output: 10
+#   Pair 1: (-1, -2) Pair 2: (-3, -4)
+# Example 4 Input: @ints = (10, 2, 0, 5, 1)
+#           Output: 50
+#   Pair 1: (10, 5) Pair 2: (0, 1)
+# Example 5 Input: @ints = (7, 8, 9, 10, 10)
+#           Output: 44
+#   Pair 1: (10, 10) Pair 2: (7, 8)
+#=============================================================================
+
+use v5.42;
+
+use List::Util qw/max min/;
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say maxDiff(@ARGV);
+
+#=============================================================================
+sub maxDiff_BF(@int)
+{
+    my $max = 0;
+    for my $w ( 0 .. $#int )
+    {
+        for my $x ( 0 .. $#int )
+        {
+            next if $x == $w;
+            for my $y ( 0 .. $#int )
+            {
+                next if $y == $x || $y == $w;
+                for my $z ( 0  .. $#int )
+                {
+                    next if $z == $y || $z == $x || $z == $w;
+                    my ($a, $b, $c, $d) = @int[$w,$x,$y,$z];
+
+                    my $diff = max( $a*$b - $c*$d, $c*$d - $a*$b );
+                    $max = $diff if $diff > $max;
+                }
+            }
+        }
+    }
+    return $max;
+}
+
+sub maxDiff(@int)
+{
+    @int = sort { $a <=> $b } @int;
+
+    # Possibilities for maximum product: biggest positive numbers, biggest
+    # negative numbers, or biggest positive X biggest negative.
+    # Find the biggest magnitude, then discard that pair from the list.
+    my $nn = $int[0] * $int[1];
+    my $pp = $int[-1] * $int[-2];
+    my $np = $int[0] * $int[-1];
+    my $largest;
+    if ( abs($nn) > abs($pp) )
+    {
+        if ( abs($nn) > abs($np) )
+        {
+            $largest = $nn;
+            shift @int; shift @int;
+        }
+        else
+        {
+            $largest = $np;
+            shift @int; pop @int;
+        }
+    }
+    else # pp >= nn
+    {
+        if ( abs($pp) > abs($np) )
+        {
+            $largest = $pp;
+            pop @int; pop @int;
+        }
+        else
+        {
+            $largest = $np;
+            shift @int; pop @int;
+        }
+    }
+
+    if ( $largest < 0 )
+    {
+        # Make it the second pair (because negating it will add a big number),
+        # and find the largest product for the first pair. Again, because the
+        # list is sorted, the largest magnitude must come from the pairs on
+        # the ends of the list.
+        my $aXb = max( $int[0]*$int[1], $int[0]*$int[-1], $int[-2]*$int[-1] );
+        return $aXb - $largest;
+    }
+ 
+    # Use largest as the first pair for maximum positive contribution.
+    # Find the smallest product pair to subtract away.
+
+=begin  BlockComment  # BlockCommentNo_1
+    my $cXd = $int[0] * $int[1];
+    while ( defined(my $c = shift @int) )
+    {
+        for my $d ( @int )
+        {
+            $cXd = $c*$d if ( $c*$d < $cXd );
+        }
+    }
+
+=end    BlockComment  # BlockCommentNo_1
+
+=cut
+    # Sort so smallest integers are on the outside of the array.
+    @int = sort { ($a == 0 ? 2 : 1/$a) <=> ($b == 0 ? 2 : 1/$b) } @int;
+    # -1/2  - 1/3 -1/4   0  1/4   1/3   1/2
+    # ----|------|----|----|---|-----|-----|---
+    
+    my $cXd = min( $int[0]*$int[1], $int[0]*$int[-1], $int[-2]*$int[-1] );
+    return $largest - $cXd;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( maxDiff( 5,  9,  3,  4,  6),   42, "Example 1");
+    is( maxDiff( 1, -2,  3, -4),       10, "Example 2");
+    is( maxDiff(-3, -1, -2, -4),       10, "Example 3");
+    is( maxDiff(10,  2,  0,  5,  1),   50, "Example 4");
+    is( maxDiff( 7,  8,  9, 10, 10),   44, "Example 5");
+
+    is( maxDiff(10, 2, 1, 5, 1), 49, "Example 4 + 1");
+    is( maxDiff(10, 2, -1, 5, 1), 52, "Example 4 - 1");
+    is( maxDiff(-10, 2, -1, 5, 1), 52, "Example 4 - 10");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
diff --git a/challenge-339/bob-lied/perl/ch-2.pl b/challenge-339/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..896460d2dd
--- /dev/null
+++ b/challenge-339/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:
+#=============================================================================
+# Copyright (c) 2025, Bob Lied
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 339 Task 2  Peak Point
+#=============================================================================
+# You are given an array of altitude gain.
+# Write a script to find the peak point gained.
+#
+# Example 1 Input: @gain = (-5, 1, 5, -9, 2)
+#           Output: 1
+#   start: 0    1st change:  0 + (-5) = -5
+#               2nd change: -5 + 1    = -4
+#               3rd change: -4 + 5    = 1
+#               4th change:  1 + (-9) = -8
+#               5th change: -8 + 2    = -6
+#   max(0, -5, -4, 1, -8, -6) = 1
+#
+# Example 2 Input: @gain = (10, 10, 10, -25)
+#           Output: 30
+#   start: 0    1st change:  0 + 10    = 10
+#               2nd change: 10 + 10    = 20
+#               3rd change: 20 + 10    = 30
+#               4th change: 30 + (-25) = 5
+#   max(0, 10, 20, 30, 5) = 30
+#
+# Example 3 Input: @gain = (3, -4, 2, 5, -6, 1)
+#           Output: 6
+# Example 4 Input: @gain = (-1, -2, -3, -4)
+#           Output: 0
+# Example 5 Input: @gain = (-10, 15, 5)
+#           Output: 10
+#=============================================================================
+
+use v5.42;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark);
+my $logger;
+{
+    use Log::Log4perl qw(:easy);
+    Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ),
+            layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" });
+    $logger = Log::Log4perl->get_logger();
+}
+#=============================================================================
+
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($Benchmark) ) if $Benchmark;
+
+say peakPoint(@ARGV);
+
+#=============================================================================
+sub peakPoint(@gain)
+{
+    my $peak = my $elevation = 0;
+    while ( defined (my $hike = shift @gain) )
+    {
+        $elevation += $hike;
+        $peak = $elevation if $elevation > $peak;
+    }
+    return $peak;
+}
+
+sub pp(@gain)
+{
+    use List::Util qw/reductions max/;
+    return max reductions { $a + $b } 0, @gain;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( peakPoint( -5,  1,  5,  -9,  2   ) ,  1, "Example 1");
+    is( peakPoint( 10, 10, 10, -25       ) , 30, "Example 2");
+    is( peakPoint(  3, -4,  2,   5, -6, 1) ,  6, "Example 3");
+    is( peakPoint( -1, -2, -3,  -4       ) ,  0, "Example 4");
+    is( peakPoint(-10, 15,  5            ) , 10, "Example 5");
+
+    is( pp( -5,  1,  5,  -9,  2   ) ,  1, "pp Example 1");
+    is( pp( 10, 10, 10, -25       ) , 30, "pp Example 2");
+    is( pp(  3, -4,  2,   5, -6, 1) ,  6, "pp Example 3");
+    is( pp( -1, -2, -3,  -4       ) ,  0, "pp Example 4");
+    is( pp(-10, 15,  5            ) , 10, "pp Example 5");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my @gain;
+    push @gain, rand(100) for 1 .. 200;
+    cmpthese($repeat, {
+            loop => sub { peakPoint(@gain) },
+            reduce => sub { pp(@gain) },
+        });
+}