Merge pull request #12031 from boblied/w321

Week 321 solutions from Bob Lied

4 files changed, 224 insertions, 3 deletions

diff --git a/challenge-321/bob-lied/README.md b/challenge-321/bob-lied/README.md
index 95cd170130..0825268e3e 100644
--- a/challenge-321/bob-lied/README.md
+++ b/challenge-321/bob-lied/README.md
@@ -1,4 +1,4 @@
-# Solutions to weekly challenge 320 by Bob Lied
+# Solutions to weekly challenge 321 by Bob Lied
 
-## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-320/)
-## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-320/bob-lied)
+## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-321/)
+## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-321/bob-lied)
diff --git a/challenge-321/bob-lied/blog.txt b/challenge-321/bob-lied/blog.txt
new file mode 100644
index 0000000000..4d8af974f5
--- /dev/null
+++ b/challenge-321/bob-lied/blog.txt
@@ -0,0 +1 @@
+https://dev.to/boblied/pwc-321-every-average-tells-a-story-dont-it-bj0
diff --git a/challenge-321/bob-lied/perl/ch-1.pl b/challenge-321/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..a36ddd29ae
--- /dev/null
+++ b/challenge-321/bob-lied/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/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 321 Task 1 Distinct Average
+#=============================================================================
+# You are given an array of numbers with even length.  Write a script to
+# return the count of distinct average. The average is calculate by removing
+# the minimum and the maximum, then average of the two.
+# Example 1 Input: @nums = (1, 2, 4, 3, 5, 6)
+#           Output: 1
+#   Step 1: Min = 1, Max = 6, Avg = 3.5
+#   Step 2: Min = 2, Max = 5, Avg = 3.5
+#   Step 3: Min = 3, Max = 4, Avg = 3.5
+#   The count of distinct average is 1.
+#
+# Example 2 Input: @nums = (0, 2, 4, 8, 3, 5)
+#           Output: 2
+#   Step 1: Min = 0, Max = 8, Avg = 4
+#   Step 2: Min = 2, Max = 5, Avg = 3.5
+#   Step 3: Min = 3, Max = 4, Avg = 3.5
+#   The count of distinct average is 2.
+#
+# Example 3 Input: @nums = (7, 3, 1, 0, 5, 9)
+#           Output: 2
+#   Step 1: Min = 0, Max = 9, Avg = 4.5
+#   Step 2: Min = 1, Max = 7, Avg = 4
+#   Step 3: Min = 3, Max = 5, Avg = 4
+#   The count of distinct average is 2.
+#=============================================================================
+
+use v5.40;
+
+
+use Getopt::Long;
+my $Verbose = false;
+my $DoTest  = false;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+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;
+
+say distAvg(@ARGV);
+
+#=============================================================================
+sub distAvg(@ints)
+{
+    my %average;
+    @ints = sort { $a <=> $b } @ints;
+    while ( @ints )
+    {
+        # We can skip the division for the average. It's a constant factor
+        # of 2, and we're only looking for distinct values;
+
+        # my $min = shift @ints;    # Remove minimum;
+        # my $max = pop @ints;      # Remove maximum;
+
+        $average{ (shift @ints)+(pop @ints) } = true;
+    }
+    return scalar %average;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( distAvg(1,2,4,3,5,6), 1, "Example 1");
+    is( distAvg(0,2,4,8,3,5), 2, "Example 2");
+    is( distAvg(7,3,1,0,5,9), 2, "Example 1");
+
+    done_testing;
+}
diff --git a/challenge-321/bob-lied/perl/ch-2.pl b/challenge-321/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..ad5b21c294
--- /dev/null
+++ b/challenge-321/bob-lied/perl/ch-2.pl
@@ -0,0 +1,139 @@
+#!/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 321 Task 2 Backspace Compare
+#=============================================================================
+# You are given two strings containing zero or more #.  Write a script to
+# return true if the two given strings are same by treating # as backspace.
+# Example 1 Input: $str1 = "ab#c" $str2 = "ad#c"
+#           Output: true
+#    For first string,  we remove "b" as it is followed by "#".
+#   For second string, we remove "d" as it is followed by "#".
+#   In the end both strings became the same.
+#
+# Example 2 Input: $str1 = "ab##" $str2 = "a#b#"
+#           Output: true
+#
+# Example 3 Input: $str1 = "a#b" $str2 = "c"
+#           Output: false
+#=============================================================================
+
+use v5.40;
+
+
+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 bspCmp(@ARGV) ? "true" : "false";
+
+#=============================================================================
+sub bspCmp($str1, $str2)
+{
+    return bsp($str1) eq bsp($str2);
+}
+
+sub bsp($str)
+{
+    my @c = split(//, $str);
+    my @out;
+    for ( @c )
+    {
+        if ( $_ eq '#' )
+        {
+            pop @out;
+        }
+        else
+        {
+            push @out, $_;
+        }
+    }
+    return join("", @out);
+}
+
+sub bspSTR($str)
+{
+    my $out = '';
+    while ( (my $c = substr($str, 0, 1, '')) ne '' )
+    {
+        if ( $c eq '#' )
+        {
+            substr($out, -1, 1, '');
+        }
+        else
+        {
+            $out .= $c;
+        }
+    }
+    return $out;
+}
+
+# Fastest
+sub bspRE($str)
+{
+    while ( $str =~ s/[^#]#//g ) { };
+    return $str =~ s/#+//gr;    # Leading or trailing might be left
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( bsp('abc'),  'abc', 'No backspaces');
+    is( bsp('#abc'), 'abc', 'Useless leading backspace');
+    is( bsp('a###'), '',    'Superfluous backspaces');
+    is( bsp('dab##c'), 'dc',    'RE multiple backspaces');
+    is( bsp('dab##efg###c'), 'dc',    'RE multiple backspaces');
+
+    is( bspSTR('abc'),  'abc', 'STR No backspaces');
+    is( bspSTR('#abc'), 'abc', 'STR Useless leading backspace');
+    is( bspSTR('a###'), '',    'STR Superfluous backspaces');
+    is( bspSTR('dab##c'), 'dc',    'RE multiple backspaces');
+    is( bspSTR('dab##efg###c'), 'dc',    'RE multiple backspaces');
+
+    is( bspRE('abc'),  'abc', 'RE No backspaces');
+    is( bspRE('#abc'), 'abc', 'RE Useless leading backspace');
+    is( bspRE('a###'), '',    'RE Superfluous backspaces');
+    is( bspRE('dab##c'), 'dc',    'RE multiple backspaces');
+    is( bspRE('dab##efg###c'), 'dc',    'RE multiple backspaces');
+
+    is( bspCmp("ab#c", "ad#c"),  true, "Example 1");
+    is( bspCmp("ab##", "a#b#"),  true, "Example 2");
+    is( bspCmp("a#b",   "c"  ), false, "Example 3");
+
+    is( bspCmp("dab##c", "da#b#c"),  true, "Example 2+");
+
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my $str = 'abcdefghijklmnopqrstuvwxyz' x 5;
+    for ( 1 .. 15 ) { substr($str, int(rand(length($str))), 1, '#') }
+    
+
+    cmpthese($repeat, {
+            array  => sub { bsp($str) },
+            string => sub { bspSTR($str) },
+            regex  => sub { bspRE($str) }
+        });
+}