Merge pull request #12024 from robbie-hatley/rh321

Robbie Hatley's Solutions, in Perl for The Weekly Challenge #321.

3 files changed, 207 insertions, 0 deletions

diff --git a/challenge-321/robbie-hatley/blog.txt b/challenge-321/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..35495f5a91
--- /dev/null
+++ b/challenge-321/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/05/robbie-hatleys-solutions-in-perl-for_12.html
diff --git a/challenge-321/robbie-hatley/perl/ch-1.pl b/challenge-321/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..71cfbd9126
--- /dev/null
+++ b/challenge-321/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 321-1,
+written by Robbie Hatley on Mon May 12, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 321-1: Distinct Average
+Submitted by: Mohammad Sajid Anwar
+You are given an array of numbers with even length. Write a
+script to return a count of distinct averages. The averages
+are calculated by removing the minimum and the maximum, then
+averaging 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 averages 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 averages 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 averages is 2.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+After checking that each input array is, indeed, an even-length array of real numbers, I'll compute each
+"Min-Max Average" by doing the following:
+1. Put list in increasing numerical order.
+2. Loop while @sorted is not empty:
+   a. Snip-off min and max.
+   a. Compute next MMA ((min+max)/2) and push it to list @MMAs.
+3. Compute number of unique MMAs using "sort", "unique", and "scalar".
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of even-sized arrays of numbers, in proper Perl syntax, like so:
+
+./ch-1.pl '([],[1,2,3],[32,-64,-21,-11],[37.19,-13.24,84.62,-99.17,82.63,-3.69])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use Scalar::Util 'looks_like_number';
+   use List::Util   'uniq';
+
+   # Is a given list an even-sized list of numbers?
+   sub is_even_sized_list_of_numbers (@list) {
+      return 0 unless scalar(@list) > 0;                  # Reject empty lists.
+      return 0 unless 0 == scalar(@list)%2;               # Reject lists with odd number of elements.
+      for my $item (@list) {
+         return 0 unless looks_like_number $item;         # Reject lists with any non-numeric elements.
+      }
+      return 1;                                           # List passes all tests.
+   }
+
+   # How many unique Min-Max Averages does
+   # an even-sized list of numbers have?
+   sub number_of_unique_min_max_averages (@list) {
+      my @MMAs;                                           # Min-Max Averages.
+      my @sorted = sort {$a<=>$b} @list;                  # Put list in increasing numerical order.
+      while (@sorted) {                                   # While @sorted is not empty.
+         my ($min, $max) = (shift(@sorted),pop(@sorted)); # Snip min and max from sorted list.
+         push @MMAs, ($min + $max)/2;                     # Push next MMA to @MMAs.
+      }                                                   # Repeat.
+      scalar(uniq(sort {$a<=>$b} @MMAs));                 # Return number of unique MMAs.
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   [1, 2, 4, 3, 5, 6], # Expected output = 1
+   [0, 2, 4, 8, 3, 5], # Expected output = 2
+   [7, 3, 1, 0, 5, 9], # Expected output = 2
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   say "List of numbers = (@$aref)";
+   if (!is_even_sized_list_of_numbers(@$aref)) {
+      say STDERR "Error: Not an even-sized list of numbers; moving on to next list.";
+      next;
+   }
+   my $noumma = number_of_unique_min_max_averages(@$aref);
+   say "Number of unique Min-Max Averages = $noumma";
+}
diff --git a/challenge-321/robbie-hatley/perl/ch-2.pl b/challenge-321/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..87dfd75dc2
--- /dev/null
+++ b/challenge-321/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 321-2,
+written by Robbie Hatley on Mon May 12, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 321-2: Backspace Compare
+Submitted by: Mohammad Sajid Anwar
+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
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I'll solve this by simply doing what each "#" backspace character means: "erase this character, and the one to
+its left (if this is not the first character)". Then compare the processed strings.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+single-quoted array of arrays of two double-quoted strings, in proper Perl syntax, like so:
+
+./ch-2.pl '(["rat#ck", "Greg####rack"],["Hadley####tley", "Hadley####thaway"])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use Sys::Binmode;
+   use utf8::all;
+
+   # Treat each octothorpe in a string as a backspace command:
+   sub backspace ($s) {
+      for ( my $i = 0 ; $i < length($s) ; ++$i ) { # For each character in string:
+         if ('#' eq substr($s,$i,1)) {             # If it's a "#":
+            substr($s,$i,1,'');                    # Remove "#".
+            --$i;                                  # Decrement index.
+            if ($i >= 0) {                         # If index is still non-negative:
+               substr($s,$i,1,'');                 # Also remove the character that was to the left of the "#"
+               --$i;}}}                            # and decrement the index again.
+      return $s;}                                  # Return result.
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   ["ab#c", "ad#c"], # Expected output: true
+   ["ab##", "a#b#"], # Expected output: true
+   ["a#b" , "c"   ], # Expected output: false
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   my ($s1,$s2) = @$aref[0,1];
+   my ($b1,$b2) = map {backspace($_)} ($s1,$s2);
+   say "String 1 (original) = $s1";
+   say "String 2 (original) = $s2";
+   say "String 1 (backspcd) = $b1";
+   say "String 2 (backspcd) = $b2";
+   my $bc = (backspace($s1) eq backspace($s2)) ? 'true' : 'false';
+   say "Backspace compare: $bc";
+}