Merge pull request #9522 from robbie-hatley/rh255

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

3 files changed, 238 insertions, 0 deletions

diff --git a/challenge-255/robbie-hatley/blog.txt b/challenge-255/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..f43b080607
--- /dev/null
+++ b/challenge-255/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/02/robbie-hatleys-solutions-to-weekly.html
\ No newline at end of file
diff --git a/challenge-255/robbie-hatley/perl/ch-1.pl b/challenge-255/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..9861bcf214
--- /dev/null
+++ b/challenge-255/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,112 @@
+#!/usr/bin/perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 255-1.
+Written by Robbie Hatley on Mon Feb 05, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 255-1: Odd Character
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings, $s and $t. The string $t is generated
+using the shuffled characters of the string $s with an
+additional character. Write a script to find the additional
+character in the string $t.
+
+Example 1:
+Input: $s = "Perl" $t = "Preel"
+Output: "e"
+
+Example 2:
+Input: $s = "Weekly" $t = "Weeakly"
+Output: "a"
+
+Example 3:
+Input: $s = "Box" $t = "Boxy"
+Output: "y"
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+Since this problem speaks of "characters" instead of "letters", I'll consider "a" and "A" to be different
+"characters", and use a case-sensitive approach. I'll attack this problem by writing a sub which first splits
+$s and $t into arrays @s and @t of single characters, then for each character of @s, if that character exists
+in @t, splices-out the first occurrence only of that character from @t, then returns @t, which should now
+consist of all "additional" characters (if any) which are in $t but not $s. Note that this approach doesn't
+care if any of the characters of $s are actually in $t; if given $s="migrant" and $t="buck", the sub will
+return ('b','u','c','k') because all of those letters were "added" to "migrant". (The fact that the letters
+('m','i','g','r','a','n','t') were also REMOVED is irrelevant and hence ignored.)
+
+--------------------------------------------------------------------------------------------------------------
+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, apostrophes escaped as '"'"',
+in proper Perl syntax, like this:
+./ch-1.pl '(["trash", "trashy"], ["garbanzo", "gargoyle"]), ["van", "cavern"]'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS AND MODULES USED:
+
+use v5.38;
+use strict;
+use warnings;
+use utf8;
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+sub added_characters ($s, $t) {
+   my @s = split //, $s;
+   my @t = split //, $t;
+   for my $char (@s) {
+      for ( my $i = 0 ; $i <= $#t ; ++$i ) {
+         if ( $char eq $t[$i] ) {
+            splice @t, $i, 1;
+            last;
+         }
+      }
+   }
+   return @t;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Inputs:
+my @pairs = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 Input:
+   ["Perl", "Preel"],
+   # Expected Output: "e"
+
+   # Example 2 Input:
+   ["Weekly", "Weeakly"],
+   # Expected Output: "a"
+
+   # Example 3 Input:
+   ["Box", "Boxy"],
+   # Expected Output: "y"
+);
+
+# Main loop:
+for my $pair (@pairs) {
+   say '';
+   my $s = $pair->[0];
+   my $t = $pair->[1];
+   my @added = added_characters($s, $t);
+   say "\$s = \"$s\"";
+   say "\$t = \"$t\"";
+   say 'Added character(s) = ', join(', ', map {"\"$_\""} @added);
+}
diff --git a/challenge-255/robbie-hatley/perl/ch-2.pl b/challenge-255/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..5215d6edcd
--- /dev/null
+++ b/challenge-255/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,125 @@
+#!/usr/bin/perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 255-2.
+Written by Robbie Hatley on Mon Feb 05, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 255-2: Most Frequent Word
+Submitted by: Mohammad Sajid Anwar
+
+You are given a paragraph $p and a banned word $w. Write a script
+to return the most frequent word that is not banned.
+
+Example 1:
+Input:
+   $p = "Joe hit a ball, the hit ball flew far after it was hit."
+   $w = "hit"
+Output: "ball"
+The banned word "hit" occurs 3 times.
+The other word "ball" occurs 2 times.
+
+Example 2
+
+Input:
+   $p = "Perl and Raku belong to the same family. Perl is the ".
+        "most popular language in the weekly challenge."
+   $w = "the"
+Output: "Perl"
+The banned word "the" occurs 3 times.
+The other word "Perl" occurs 2 times.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I'll write a sub that first splits each paragraph into words (/[a-zA-Z-]+/), then pushes each non-banned word
+to an array called "@words", then makes a frequency hash %freq from @words, then returns the most-frequent
+words with their frequency.
+
+Caveat: This approach will not always handle capitalization and compound words correctly. For example, it
+fails to realize that the substrings "Programming" and "programming" are the same word in the following
+sentence: "Programming is a science, but programming is also an art." Lower-casing everything won't work
+either, because while "Perl" is a name, "perl" is not a word. Also, while "clean-cut" is considered one word
+(correct; it's a hyphenated compound), "race baiting" is considered two words (WRONG; it's a single
+open-compound word). Oh well; I don't have a month to spend perfecting this, so it will have to do.
+
+--------------------------------------------------------------------------------------------------------------
+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, with each inner array consisting of a paragraph
+followed by a banned word, with apostrophes escaped as '"'"', in proper Perl syntax, like this:
+./ch-2.pl '(["She cried and cried and cried\!", "cried"], ["She ate rice and beans and rice and beans\!", "and"])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS AND MODULES USED:
+
+use v5.38;
+use strict;
+use warnings;
+use utf8;
+use List::Util 'uniq';
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+sub most ($paragraph, $banned) {
+   my @words;
+   for my $word ( split /[^a-zA-Z-]/, $paragraph ) {
+      $word ne $banned and push @words, $word;
+   }
+   my %freq;
+   for my $word ( @words ) {++$freq{$word};}
+   my @unique = uniq sort {$freq{$b} <=> $freq{$a}} @words;
+   my @most;
+   for my $word ( @unique ) {
+      last if $freq{$word} < $freq{$unique[0]};
+      push @most, $word;
+   }
+   push @most, $freq{$unique[0]};
+   return @most;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Inputs:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 Input:
+   [
+      "Joe hit a ball, the hit ball flew far after it was hit.",
+      "hit",
+   ],
+   # Expected Output: "ball"
+
+   # Example 2 Input:
+   [
+      "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.",
+      "the",
+   ],
+   # Expected Output: "Perl"
+);
+
+# Main loop:
+for my $aref (@arrays) {
+   say '';
+   my $paragraph = $aref->[0];
+   my $banned    = $aref->[1];
+   my @most = most($paragraph, $banned);
+   my $most = pop @most;
+   say "Paragraph:   \"$paragraph\"";
+   say "Banned word: \"$banned\"";
+   say 'Most-common non-banned words = ', join(', ', map {"\"$_\" ($most)"} @most);
+}