Merge pull request #12398 from robbie-hatley/rh331

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

3 files changed, 193 insertions, 0 deletions

diff --git a/challenge-331/robbie-hatley/blog.txt b/challenge-331/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..b5a8064b18
--- /dev/null
+++ b/challenge-331/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/07/robbie-hatleys-solutions-in-perl-for_22.html
diff --git a/challenge-331/robbie-hatley/perl/ch-1.pl b/challenge-331/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..1e8c43f698
--- /dev/null
+++ b/challenge-331/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 331-1,
+written by Robbie Hatley on Mon Jul 21, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 331-1: Last Word
+Submitted by: Mohammad Sajid Anwar
+You are given a string. Write a script to find the length of last
+word in the given string.
+
+Example #1:
+Input: $str = "The Weekly Challenge"
+Output: 9
+
+Example #2:
+Input: $str = "   Hello   World    "
+Output: 5
+
+Example #3:
+Input: $str = "Let's begin the fun"
+Output: 3
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+There are a number of ways of approaching this, including using "split" to obtain a list of words which are in
+the string. But I'll use a simpler approach: I'll use an m// operator with a (capture group) to isolate the
+final word into "$1", then feed "$1" into the length() operator.
+
+--------------------------------------------------------------------------------------------------------------
+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 '("I ate a rat", "she ate a leprechaun", "   lots   of   spaces   ")'
+
+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;
+   # What is the length of the last
+   # word of a given sentence?
+   sub length_of_last_word ($s)
+   {$s =~ m/(\S+)\s*$/;length $1}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) : ("The Weekly Challenge", "   Hello   World    ", "Let's begin the fun");
+#                  Expected outputs :             9                       5                        3
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $string (@strings) {
+   say '';
+   say "String = \"$string\"";
+   my $lolw = length_of_last_word($string);
+   say "Length of last word = $lolw";
+}
diff --git a/challenge-331/robbie-hatley/perl/ch-2.pl b/challenge-331/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..6cb0542599
--- /dev/null
+++ b/challenge-331/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,123 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 331-2,
+written by Robbie Hatley on Mon Jul 21, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 331-2: Buddy Strings
+Submitted by Mohammad Sajid Anwar.
+Edited by Robbie Hatley for family-friendliness, grammar,
+and clarification of examples.
+
+You are given two strings, source and target. Write a script to
+find out if the given strings are Buddy Strings. If swapping of
+two letters in one string makes it same as the other string,
+then they are "Buddy Strings".
+
+Example #1:
+Input: $source = "fram"
+       $target = "farm"
+Output: true
+(Swapping 'a' and 'r' makes them buddy strings.)
+
+Example #2:
+Input: $source = "love"
+       $target = "love"
+Output: false
+(Because the strings are identical but have no letters
+in-common, any swap leaves the two strings different.)
+
+Example #3:
+Input: $source = "fodo"
+       $target = "food"
+Output: true
+(Because the strings are different with exactly two
+differences which are mirror images of each other,
+swapping the two "different" letters in one string
+makes it the same as the other string.)
+
+Example #4:
+Input: $source = "feed"
+       $target = "feed"
+Output: true
+(Because the strings are identical, normally any
+swapping of letters in one string would make it
+different from the other; but because duplicate
+letters exist, we can swap THOSE, resulting in
+the two strings STILL being identical.)
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I'll write a sub that determines the buddy-ness of a pair of strings by running these checks:
+1. If the lengths of the two strings are not equal, the strings aren't buddies.
+2. If the strings are identical, they're buddies if-and-only-if they contain duplicate characters.
+3. If the strings are same-size-but-different:
+   a. If number of indices for which the characters are unequal is not 2, the strings aren't buddies.
+   b. If the second pair of unequal characters is not the reverse of the first, the strings aren't buddies.
+   c. Otherwise, the strings are buddies.
+
+--------------------------------------------------------------------------------------------------------------
+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 '(["granite", "gabro"], ["granite", "gnarite"], ["bark", "fork"], ["dog", "dog"], ["rook", "rook"])'
+
+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;
+   use List::Util 'uniq';
+   # Are a pair of strings good buddies?
+   sub buddies ($s1, $s2) {
+      # Get the lengths of the two strings:
+      my $n1 = length($s1); my $n2 = length($s2);
+      # If the lengths are unequal, the strings aren't buddies:
+      return 'False.' if $n1 != $n2;
+      # If the two strings are identical, then they are buddies
+      # if-and-only-if they contain duplicate characters:
+      if ( $s1 eq $s2 ) {
+         my @sorted = sort {$a cmp $b} split //, $s1;
+         my @unique = uniq @sorted;
+         return 'True.' if scalar(@unique) < scalar(@sorted);
+         return 'False.'}
+      # Else if the two strings are different, the number of
+      # differences must be 2, and the second character pair
+      # must be the reverse of the first character pair:
+      else {
+         my @ue = (); # List of unequal character pairs.
+         for my $idx (0..$n1-1) {
+            my $c1 = substr($s1, $idx, 1);
+            my $c2 = substr($s2, $idx, 1);
+            next if $c1 eq $c2;
+            push @ue, $c1.$c2}
+         return 'False.' if 2 != scalar @ue;
+         return 'False.' if $ue[1] ne scalar reverse $ue[0];
+         return 'True.'}}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) : (["fram", "farm"], ["love", "love"], ["feed", "feed"]);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   my $s1 = $aref->[0];
+   my $s2 = $aref->[1];
+   my $b = buddies($s1, $s2);
+   say "String 1 = \"$s1\"";
+   say "String 2 = \"$s2\"";
+   say "Strings are buddies? $b";
+}