Merge pull request #12363 from robbie-hatley/rh330

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

3 files changed, 162 insertions, 0 deletions

diff --git a/challenge-330/robbie-hatley/blog.txt b/challenge-330/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..1b7c8a0195
--- /dev/null
+++ b/challenge-330/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/07/robbie-hatleys-solutions-in-perl-for_34.html
diff --git a/challenge-330/robbie-hatley/perl/ch-1.pl b/challenge-330/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..8a4aaabb29
--- /dev/null
+++ b/challenge-330/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 330-1,
+written by Robbie Hatley on Thu Jul 17, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 330-1: Clear Digits
+Submitted by: Mohammad Sajid Anwar
+You are given a string containing only lower case English letters
+and digits. Write a script to remove all digits by removing the
+first digit and the closest non-digit character to its left.
+
+Example #1:
+Input: $str = "cab12"
+Output: "c"
+Round 1: remove "1" then "b" => "ca2"
+Round 2: remove "2" then "a" => "c"
+
+Example #2:
+Input: $str = "xy99"
+Output: ""
+Round 1: remove "9" then "y" => "x9"
+Round 2: remove "9" then "x" => ""
+
+Example #3:
+Input: $str = "pa1erl"
+Output: "perl"
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I note that it will not be POSSIBLE to remove "the character to the left of a digit" if the index of the digit
+is 0; so in that case, I'll just skip removing "character to left". In all other cases, I'll remove both each
+digit and the character to it's left. I'll use a 3-part index loop with double backtracking to avoid missing
+digits, and just keep erasing digits (and their left-hand men) until no digits remain.
+
+--------------------------------------------------------------------------------------------------------------
+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 double-quoted strings, in proper Perl syntax, like so:
+
+./ch-1.pl '("Peg9rq7lg5", "ragu37t", "0817354629bat", "polenastyisrat0192837465cat")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8::all;
+
+   # Clear digits and their left-hand men:
+   sub clear_digits_and_left ($s) {
+      for ( my $idx = 0 ; $idx <= length($s)-1 ; ++$idx ) {
+         if ( substr($s, $idx, 1) =~ m/\d/ ) {
+            substr $s, $idx - 0, 1, '';
+            substr $s, $idx - 1, 1, '' if $idx > 0;
+            --$idx;
+            --$idx}}
+      return $s}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) : ("cab12", "xy99", "pa1erl");
+#                   Expected outputs : (  "c"  ,   ""  ,  "perl" )
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $string (@strings) {
+   say '';
+   say "String = \"$string\"";
+   my $cdal = clear_digits_and_left($string);
+   say "CDAL   = \"$cdal\"";
+}
diff --git a/challenge-330/robbie-hatley/perl/ch-2.pl b/challenge-330/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..e551ab01c0
--- /dev/null
+++ b/challenge-330/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 330-2,
+written by Robbie Hatley on Thu Jul 17, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 330-2: Title Capital
+Submitted by: Mohammad Sajid Anwar
+You are given a string made up of one or more words separated by
+a single space. Write a script to capitalize the given title. If
+the word length is 1 or 2 then convert the word to lowercase,
+otherwise make the first character uppercase and remaining
+lowercase.
+
+Example #1:
+Input: $str = "PERL IS gREAT"
+Output: "Perl is Great"
+
+Example #2:
+Input: $str = "THE weekly challenge"
+Output: "The Weekly Challenge"
+
+Example #3:
+Input: $str = "YoU ARE A stAR"
+Output: "You Are a Star"
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I'll split the input on whitespace to an array, then I'll use a 3-part index loop to process each array
+element, Title-Casing each array element with size >=3 and lower-casing the remainder. Exception: This
+problem's description doesn't mention it, but the convention in English is to also Title-Case the first
+and last words of every title, so I'll also do that.
+
+--------------------------------------------------------------------------------------------------------------
+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 double-quoted strings, in proper Perl syntax, like so:
+
+./ch-2.pl '("tHe silMARillion", "a TAle oF TwO cItIes", "proGRAMming pErL", "a pLanE tO rOam in")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8::all;
+
+   # Correctly case a title:
+   sub title ($t) {
+      my @words = split /\s+/, $t;
+      my $n = scalar(@words);
+      for ( my $idx = 0 ; $idx < $n ; ++$idx ) {
+         if ( 0 == $idx || $n-1 == $idx || length($words[$idx]) >= 3 ) {
+            $words[$idx] =~ s/^(.)(.*)$/ucfirst($1).lc($2)/e}
+         else {
+            $words[$idx] = lc $words[$idx]}}
+      return join ' ', @words}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) : ("PERL IS gREAT", "THE weekly challenge", "YoU ARE A stAR");
+#                   Expected outputs : ("Perl is Great", "The Weekly Challenge", "You Are a Star")
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $string (@strings) {
+   say '';
+   say "String = \"$string\"";
+   my $title = title($string);
+   say "Title  = \"$title\"";
+}