aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Lied <boblied+github@gmail.com>2025-09-17 11:59:27 -0500
committerBob Lied <boblied+github@gmail.com>2025-09-17 11:59:27 -0500
commit2ae6a5d709e3d198579b3e14a10ea72fa25706f2 (patch)
treec5c4712654311a21086e23ccfef26ca14b0094fc
parentb2cc80b5507fc4f13b2eec8050f70ef12019ffb6 (diff)
downloadperlweeklychallenge-club-2ae6a5d709e3d198579b3e14a10ea72fa25706f2.tar.gz
perlweeklychallenge-club-2ae6a5d709e3d198579b3e14a10ea72fa25706f2.tar.bz2
perlweeklychallenge-club-2ae6a5d709e3d198579b3e14a10ea72fa25706f2.zip
Week 339 solutions
-rw-r--r--challenge-339/bob-lied/README.md8
-rw-r--r--challenge-339/bob-lied/blog.txt1
-rw-r--r--challenge-339/bob-lied/perl/ch-1.pl178
-rw-r--r--challenge-339/bob-lied/perl/ch-2.pl106
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) },
+ });
+}