Merge pull request #11458 from boblied/w304

Week 304 done

3 files changed, 167 insertions, 3 deletions

diff --git a/challenge-304/bob-lied/README b/challenge-304/bob-lied/README
index c32ac23f4a..a7ca268f89 100644
--- a/challenge-304/bob-lied/README
+++ b/challenge-304/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 303 by Bob Lied
+Solutions to weekly challenge 304 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-303/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-303/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-304/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-304/bob-lied
diff --git a/challenge-304/bob-lied/perl/ch-1.pl b/challenge-304/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..92e344657f
--- /dev/null
+++ b/challenge-304/bob-lied/perl/ch-1.pl
@@ -0,0 +1,84 @@
+#!/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 304 Task 1 Arrange Binary
+#=============================================================================
+# You are given a list of binary digits (0 and 1) and a positive integer, $n.
+# Write a script to return true if you can re-arrange the list by replacing at
+# least $n digits with 1 in the given list so that no two consecutive digits
+# are 1 otherwise return false.
+# Example 1 Input: @digits = (1, 0, 0, 0, 1), $n = 1
+#           Output: true
+#   Re-arranged list: (1, 0, 1, 0, 1)
+# Example 2 Input: @digits = (1, 0, 0, 0, 1), $n = 2
+#           Output: false
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+my $N = 1;
+
+GetOptions("n:i" => \$N, "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 arrange($N, @ARGV) ? "true" : "false";
+
+#=============================================================================
+sub arrange($n, @digits)
+{
+    use List::Util qw/sum0/;
+    my $possible = sum0 map { int(length($_)/2) }
+            join("", 0,@digits) =~ m/(00+)(?!1)/g;
+    return $n <= $possible;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( arrange(1,  1,0,0,0,1),    true, "Example 1");
+    is( arrange(2,  1,0,1,0,1),   false, "Example 2");
+    is( arrange(1,  0,0,1,1,1),    true, "Leading");
+    is( arrange(1,  1,1,1,0,0),    true, "Trailing");
+    is( arrange(2,  0,0,1,0,0),    true, "Leading and trailing");
+    is( arrange(3,  0,0,1,0,0),   false, "Leading and trailing nope");
+    is( arrange(3,  0,0,0,0,0,0),  true, "Even number of zeroes");
+    is( arrange(4,  0,0,0,0,0,0), false, "Even number of zeroes no");
+    is( arrange(1,            0),  true, "Degenerate single digit");
+    is( arrange(2,            0), false, "Degenerate single digit no");
+    is( arrange(1,          0,0),  true, "Degenerate two digit");
+    is( arrange(2,          0,0), false, "Degenerate two digit 2");
+    is( arrange(1,          1,0), false, "Degenerate two digit no");
+
+    is( arrange(2,  1,0,0,1,0,0,1),false, "Only pairs");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}
diff --git a/challenge-304/bob-lied/perl/ch-2.pl b/challenge-304/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..11ef31707a
--- /dev/null
+++ b/challenge-304/bob-lied/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/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 304 Task 2 Maximum Average
+#=============================================================================
+# You are given an array of integers, @ints and an integer, $n
+# which is less than or equal to total elements in the given array.
+# Write a script to find the contiguous subarray whose length is the given
+# integer, $n, and has the maximum average. It should return the average.
+# Example 1 Input: @ints = (1, 12, -5, -6, 50, 3), $n = 4
+#           Output: 12.75
+#   Subarray: (12, -5, -6, 50) Average: (12 - 5 - 6 + 50) / 4 = 12.75
+# Example 2 Input: @ints = (5), $n = 1
+#           Output: 5
+#=============================================================================
+
+use v5.40;
+use List::Util qw/sum0/;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+my $Benchmark = 0;
+
+my $N = 4;
+
+GetOptions("n:i" => \$N, "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 maxAvg($N, @ARGV);
+
+#=============================================================================
+sub maxAvg($n, @ints)
+{
+    die "n=$n out of range 1..".scalar(@ints) if ( $n < 0 || $n > scalar(@ints) );
+    my $first = $ints[0];
+    my $bestSum = my $moving = sum0 @ints[ 0 .. ($n-1) ];
+    for my $i ( $n .. $#ints )
+    {
+        $moving += $ints[$i] - $ints[$i-$n];
+        $bestSum = $moving if $moving > $bestSum;
+    }
+    return $bestSum / $n;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( maxAvg(4,  12,-5,-6,50), 12.75, "Example 1");
+    is( maxAvg(1,            5),     5, "Example 2");
+
+    is( maxAvg(1,  7,9,2,-3,-5),     9, "Degenerate n=1 ==> max");
+    is( maxAvg(6,  6,7,8,4,5,6),     6, "Degenerate n=length ==> avg");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    cmpthese($repeat, {
+            label => sub { },
+        });
+}