Merge pull request #10520 from robbie-hatley/rh280

Robbie Hatley's Perl solutions for The Weekly Challenge #280.

3 files changed, 186 insertions, 0 deletions

diff --git a/challenge-280/robbie-hatley/blog.txt b/challenge-280/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..6684be80eb
--- /dev/null
+++ b/challenge-280/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/07/robbie-hatleys-solutions-to-weekly_29.html
\ No newline at end of file
diff --git a/challenge-280/robbie-hatley/perl/ch-1.pl b/challenge-280/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..81bc5654d4
--- /dev/null
+++ b/challenge-280/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 280-1,
+written by Robbie Hatley on Mon Jul 29, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 280-1: Twice Appearance
+Submitted by: Mohammad Sajid Anwar
+Given a string containing lowercase English letters only, write
+a script to print the first letter to appear a second time.
+
+[Note, Robbie Hatley, 2024-07-29: The original version said
+"first letter that appears twice", but the examples contradict
+that, so I edited it to read "a second time" instead of
+"twice", in order to jibe with the examples. For example, in
+"acbddbca" the first letter to appear twice is "a", but the
+first letter to appear a second time is "d". The difference is
+that "twice" is not positional, but "second time" IS positional
+left-to-right (because that's the direction English is read in).]
+
+Example 1:
+Input:  "acbddbca"
+Output: "d" (not a, because d "appears a second time" before a).
+
+Example 2:
+Input:  "abccd"
+Output: "c" (c is only letter to appear a second time)
+
+Example 3:
+Input:  "abcdabbb"
+Output: "a" (not b, because a "appears a second time" before b).
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+To solve this problem, I'll make a hash of letter abundances. The first letter to reach an abundance greater
+than 1 will be returned, else the Unicode replacement character if no letter appears a second time.
+
+--------------------------------------------------------------------------------------------------------------
+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 '("making", "caterer", "isomorphism")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.38;
+   use utf8;
+   sub second ($x) {
+      my %hash;
+      my $char;
+      for my $idx (0..length($x)-1) {
+         $char = substr($x,$idx,1);
+         ++$hash{$char};
+         if (2 == $hash{$char}){
+            return $char;
+         }
+      }
+      return "\x{FFFD}";
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) :
+(
+   "acbddbca",
+   "abccd",
+   "abcdabbb",
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $x (@strings) {
+   my $second = second($x);
+   say '';
+   say "String = $x";
+   say "First character to appear a second time = $second";
+}
diff --git a/challenge-280/robbie-hatley/perl/ch-2.pl b/challenge-280/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..bf59742bcb
--- /dev/null
+++ b/challenge-280/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 280-2,
+written by Robbie Hatley on Mon Jul 29, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 280-2: Count Asterisks
+Submitted by: Mohammad Sajid Anwar
+Given a string where every two consecutive vertical bars are
+grouped into a pair, write a script to return the number of
+asterisks, *, excluding any within each pair of vertical bars.
+
+[Note, Robbie Hatley, 2024-07-29: The original said "between
+each pair", but the examples make it clear that the intended
+meaning is the opposite, "within each pair". ("Between" would
+mean "NOT within any pair; outside of all pairs".)]
+
+Example 1:
+Input: "p|*e*rl|w**e|*ekly|"
+Ouput: 2
+(Pair 1 contains "*e*rl" and Pair 2 contains "*ekly", so those
+are excluded, leaving "pw**e", which contains 2 asterisks.)
+
+Example 2:
+Input: $str = "perl"
+Ouput: 0
+(There are no asterisks at all, so the count is zero.)
+
+Example 3:
+Input: $str = "th|ewe|e**|k|l***ych|alleng|e"
+Ouput: 5
+(Pair 1 contains "ewe", Pair 2 contains "k", and Pair 3 contains
+"allenge", so those are excluded, leaving "the**l***yche", which
+contains 5 asterisks.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+To solve this problem, I'll use a finite state machine with 2 states: "count on" and "count off", denoted by
+setting variable $state to 1 for on or 0 for off. $state starts in state "on" at the left end of the string,
+then as we move right, $state is toggled each time we reach a "|" character. Count asterisks, starting from
+zerio, only while $count is "on"; the final count is our answer.
+
+--------------------------------------------------------------------------------------------------------------
+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 '("I d*r*a*n*k a |c*u*p| of tea!", "She ate* seven |r*a*b*b*i*t*s|.", "I burped.")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.38;
+   use utf8;
+   sub count ($x) {
+      my $state = 1;
+      my $count = 0;
+      my $char  = "\x{FFFD}";
+      for my $idx (0..length($x)-1) {
+         $char = substr($x, $idx, 1);
+         if ('|' eq $char) {
+            $state = !$state;
+         }
+         elsif ('*' eq $char && $state) {
+            ++$count;
+         }
+         else {
+            ; # Do nothing.
+         }
+      }
+      return $count;
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) :
+(
+   "p|*e*rl|w**e|*ekly|",
+   "perl",
+   "th|ewe|e**|k|l***ych|alleng|e",
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $x (@strings) {
+   my $count = count($x);
+   say '';
+   say "String = $x";
+   say "Number of non-excluded asterisks = $count";
+}