Merge pull request #12180 from boblied/w325

Week 325 solutions from Bob Lied

3 files changed, 198 insertions, 3 deletions

diff --git a/challenge-325/bob-lied/README.md b/challenge-325/bob-lied/README.md
index 8fc48e8055..05d522492e 100644
--- a/challenge-325/bob-lied/README.md
+++ b/challenge-325/bob-lied/README.md
@@ -1,4 +1,4 @@
-# Solutions to weekly challenge 324 by Bob Lied
+# Solutions to weekly challenge 325 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-324/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-324/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-325/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-325/bob-lied)
diff --git a/challenge-325/bob-lied/perl/ch-1.pl b/challenge-325/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..b059daabad
--- /dev/null
+++ b/challenge-325/bob-lied/perl/ch-1.pl
@@ -0,0 +1,112 @@
+#!/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 325 Task 1 Consecutive One
+#=============================================================================
+# You are given a binary array containing only 0 or/and 1.
+# Write a script to find out the maximum consecutive 1 in the given array.
+# Example 1 Input: @binary = (0, 1, 1, 0, 1, 1, 1)
+#           Output: 3
+# Example 2 Input: @binary = (0, 0, 0, 0)
+#           Output: 0
+# Example 3 Input: @binary = (1, 0, 1, 0, 1, 1)
+#           Output: 2
+#=============================================================================
+
+use v5.40;
+use List::Util qw/max/;
+
+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 consecutive(@ARGV);
+
+#=============================================================================
+sub consecutive(@binary)
+{
+    my $count = 0;
+    my $maxConsecutive = 0;
+    for ( @binary )
+    {
+        if ( $_ )
+        {
+            $maxConsecutive = $count if ++$count > $maxConsecutive;
+        }
+        else
+        {
+            $count = 0;
+        }
+    }
+    return $maxConsecutive;
+}
+
+sub flipflop(@binary)
+{
+    my $max = my $count = 0;
+    for ( @binary )
+    {
+        if ( $_==1 .. $_==1 )
+        {
+            $max = $count if ++$count > $max;
+        }
+        else
+        {
+            $count = 0;
+        }
+    }
+    return $max;
+}
+
+sub asString(@binary)
+{
+    return max(map { length($_) } ( join('', @binary) =~ m/1+/g )) // 0;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    for my $func ( \&consecutive, \&flipflop, \&asString )
+    {
+    is( $func->(0, 1, 1, 0, 1, 1, 1), 3, "Example 1");
+    is( $func->(0, 0, 0, 0         ), 0, "Example 2");
+    is( $func->(1, 0, 1, 0, 1, 1   ), 2, "Example 3");
+
+    is( $func->(                   ), 0, "Empty list");
+    is( $func->(0                  ), 0, "One zero");
+    is( $func->(1                  ), 1, "One one");
+    is( $func->(1, 1, 1, 1, 1, 1, 1), 7, "All one");
+    }
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my @binary = map { int(rand(2)) } 1 .. 1000;
+
+    cmpthese($repeat, {
+            loop    => sub { consecutive(@binary) },
+            fliplop => sub { flipflop(@binary) },
+            string  => sub { asString(@binary) },
+        });
+}
diff --git a/challenge-325/bob-lied/perl/ch-2.pl b/challenge-325/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..cbd7049c29
--- /dev/null
+++ b/challenge-325/bob-lied/perl/ch-2.pl
@@ -0,0 +1,83 @@
+#!/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 325 Task 2  Final Price
+#=============================================================================
+# You are given an array of item prices.  Write a script to find out the
+# final price of each items in the given array, under the following odd rule:
+#
+# There is a special discount scheme going on. If there’s an item with a
+# lower or equal price later in the list, you get a discount equal to that
+# later price (the first one you find in order).
+#
+# Example 1 Input: @prices = (8, 4, 6, 2, 3)
+#           Output: (4, 2, 4, 2, 3)
+#   Item 0: The item price is 8.
+#       The first time that has price <= current item price is 4.
+#       Final price = 8 - 4 => 4
+#   Item 1: The item price is 4.
+#       The first time that has price <= current item price is 2.
+#       Final price = 4 - 2 => 2
+#   Item 2: The item price is 6.
+#       The first time that has price <= current item price is 2.
+#       Final price = 6 - 2 => 4
+#   Item 3: The item price is 2.
+#       No item has price <= current item price, no discount.
+#       Final price = 2
+#   Item 4: The item price is 3.
+#       Since it is the last item, so no discount.
+#       Final price = 3
+#
+# Example 2 Input: @prices = (1, 2, 3, 4, 5)
+#           Output: (1, 2, 3, 4, 5)
+# Example 3 Input: @prices = (7, 1, 1, 5)
+#           Output: (6, 0, 1, 5)
+#=============================================================================
+
+use v5.40;
+use List::Util qw/first/;
+
+
+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 '(', join(', ', finalPrice(@ARGV)), ')';
+
+#=============================================================================
+sub finalPrice(@prices)
+{
+    my @final;
+    while ( defined(my $p = shift @prices) )
+    {
+        push @final, $p - (( first { $_ <= $p } @prices ) // 0);
+    }
+    return @final;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( [finalPrice(8,4,6,2,3)], [4,2,4,2,3], "Example 1");
+    is( [finalPrice(1,2,3,4,5)], [1,2,3,4,5], "Example 2");
+    is( [finalPrice(7,1,1,5  )], [6,0,1,5  ], "Example 3");
+
+    done_testing;
+}