Merge pull request #12158 from robbie-hatley/rh325

Robbie Hatley's solutions, in Perl, for The Weekly Challenge #325.

3 files changed, 142 insertions, 0 deletions

diff --git a/challenge-325/robbie-hatley/blog.txt b/challenge-325/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..4d46f97e6b
--- /dev/null
+++ b/challenge-325/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/06/robbie-hatleys-solutions-in-perl-for_9.html
\ No newline at end of file
diff --git a/challenge-325/robbie-hatley/perl/ch-1.pl b/challenge-325/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..38cdb1b861
--- /dev/null
+++ b/challenge-325/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 325-1,
+written by Robbie Hatley on Mon. June 9, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 325-1: Consecutive Ones
+Submitted by: Mohammad Sajid Anwar
+You are given a binary array containing only 0s or/and 1s. Write
+a script to find the maximum consecutive 1s 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
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+To solve this problem, I'll make a sub that counts each cluster of 1s and keeps track of the max count seen.
+
+--------------------------------------------------------------------------------------------------------------
+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 0s and/or 1s, in proper Perl syntax, like so:
+
+./ch-1.pl '([1,1,0,1,1,1,1,0,0,1,0,1,1,1],[0,0,0,1,0,0,1,1,0])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   # What is the maximum number of consecutive 1s in an array?
+   sub max_consecutive_ones ($aref) {
+      my ($idx, $cnt, $max) = (0,0,0);      # Make needed variables.
+      for $idx (0..$#$aref) {               # Iterate through input items.
+         if (1 == $$aref[$idx]) {           #    If current items is a 1,
+            ++$cnt;                         #       increment counter
+            if ($cnt > $max) {$max = $cnt}} #       and set max to cnt if cnt>max.
+         else {                             #    Otherwise,
+            $cnt = 0}}                      #       reset cnt to zero.
+      return $max}                          # Return max.
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0])
+                   : ([0, 1, 1, 0, 1, 1, 1], [0, 0, 0, 0], [1, 0, 1, 0, 1, 1]);
+# Expected outputs :            3                 0               2
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   say "Array = (@$aref)";
+   my $max = max_consecutive_ones($aref);
+   say "Max consecutive 1s = $max";
+}
diff --git a/challenge-325/robbie-hatley/perl/ch-2.pl b/challenge-325/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..0edd177f20
--- /dev/null
+++ b/challenge-325/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 325-2,
+written by Robbie Hatley on Mon. June 9, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 325-2: Final Price
+Submitted by: Mohammad Sajid Anwar
+You are given an array of item prices. Write a script to find the
+final price of each items in the given array. 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 inputs:   [8, 4, 6, 2, 3], [1, 2, 3, 4, 5], [7, 1, 1, 5]
+Expected outputs: (4, 2, 4, 2, 3), (1, 2, 3, 4, 5), (6, 0, 1, 5)
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+Nested 3-part loops on array indices will allow us to easily see if there is a "first item with greater
+index but less-than-or-equal price" present, and if so, apply that price as "discount" to current price.
+
+--------------------------------------------------------------------------------------------------------------
+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 numbers, in proper Perl syntax, like so:
+./ch-2.pl '([38.25, 64.38, 42.94], [6, 5, 7, 5, 3, 5, 8])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   # Let's discount some prices!
+   sub discount ($aref) {
+      my @discounted = ();                               # Make output array.
+      for (    my $i =    0   ; $i <= $#$aref ; ++$i ) { # For each item in input,
+         my $discount = 0;                               #    start with discount at 0
+         for ( my $j = $i + 1 ; $j <= $#$aref ; ++$j ) { #    for each subsequent item,
+            if ( $$aref[$j] <= $$aref[$i] ) {            #       if its price is <= current item,
+               $discount = $$aref[$j];                   #          set discount to subsequent item
+               last}}                                    #          and stop checking subsequent items.
+         push @discounted, $$aref[$i]-$discount}         #    Push discounted item onto output array.
+      return @discounted}                                # Return output array.
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0])
+                   : ([8, 4, 6, 2, 3], [1, 2, 3, 4, 5], [7, 1, 1, 5]);
+# Expected outputs :  (4, 2, 4, 2, 3), (1, 2, 3, 4, 5), (6, 0, 1, 5)
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   say "Original prices: (@$aref)";
+   my @d = discount($aref);
+   say "Discount prices: (@d)";
+}