Merge pull request #10295 from robbie-hatley/rh274

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

3 files changed, 278 insertions, 0 deletions

diff --git a/challenge-274/robbie-hatley/blog.txt b/challenge-274/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..eb60077ba2
--- /dev/null
+++ b/challenge-274/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/06/robbie-hatleys-solutions-to-weekly_20.html
\ No newline at end of file
diff --git a/challenge-274/robbie-hatley/perl/ch-1.pl b/challenge-274/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..ee4e66076e
--- /dev/null
+++ b/challenge-274/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,132 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 274-1,
+written by Robbie Hatley on Mon Jun 17, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 274-1: Goat Latin
+Submitted by: Mohammad Sajid Anwar
+You are given a sentence, $sentance. Write a script to convert
+$sentence to Goat Latin, a made up language similar to Pig Latin.
+
+Rules for Goat Latin:
+
+1) If a word begins with a vowel ("a", "e", "i", "o", "u"), append
+   "ma" to the end of the word.
+2) If a word begins with consonant i.e. not a vowel, remove first
+   letter and append it to the end then add "ma".
+3) Add letter "a" to the end of first word in the sentence, "aa"
+   to the second word, etc.
+
+Example 1:
+Input: $sentence = "I love Perl"
+Output: "Imaa ovelmaaa erlPmaaaa"
+
+Example 2:
+Input: $sentence = "Perl and Raku are friends"
+Output: "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa"
+
+Example 3:
+Input: $sentence = "The Weekly Challenge"
+Output: "heTmaa eeklyWmaaa hallengeCmaaaa"
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+The tricky parts of this task are defining the terms "vowel", "consonant", "word", and "sentence".
+The definitions used in English won't work here. Instead, I define these terms as follows:
+
+"vowel"     = one of [aeiou] and case variants, with or without combining marks.
+              (eg: ÅËiòU)
+"consonant" = any character which is not a "vowel".
+              (eg: b7$@ÐgÑ茶z)
+"word"      = any cluster of non-horizontal-whitespace characters.
+              (eg: "79.m:v", "du#f", "$17")
+"sentence"  = any string consisting of "words" separated by horizontal whitespace.
+              (eg: "79.m:v du#f $17")
+
+--------------------------------------------------------------------------------------------------------------
+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, apostrophes escaped as '"'"', in proper Perl syntax, like so:
+./ch-1.pl '("He ate.", "Did she sit down?", "She ate 3.7 hot dogs.", "He didn'"'"'t take very many baths!")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.38;
+   use utf8;
+
+   use Unicode::Normalize 'NFD';
+
+   # Define "vowel" to mean one of aeiou or variants thereof (eg, ÅËiòU) :
+   sub is_vowel ($x) {
+      # Decompose any extended grapheme clusters within $x to
+      # unmarked letters followed by separate combining marks:
+      my $decomp = NFD $x;
+      # Get rid of all characters except unmarked letters:
+      my $unmarked = $decomp =~ s/[^\pL]+//gr;
+      # Convert to lower-case:
+      my $lower = lc $unmarked;
+      # $x is a "vowel" if-and-only-if $lower is one of [aeiou]:
+      return $lower =~ m/^[aeiou]{1}$/;
+   }
+
+   # Define "consonant" to mean "not a vowel" (eg, b7$@ÐgÑ茶z).
+   # (Don't write a subroutine for this; use "else" or "!is_vowel".)
+
+   # Define a "word" to be any cluster of non-horizontal-whitespace characters.
+   # (eg: "79.m:v", "du#f", "$17")
+
+   # Define a "sentence" to be any string consisting of "words"
+   # separated by horizontal whitespace. (eg: "79.m:v du#f $17")
+
+   # Convert a sentence to Goat Latin:
+   sub goat ($x) {
+      # Separate $x into "words" split by horizontal whitespace:
+      my @words = split /\h+/, $x;
+      # Process each "word" of the input by index:
+      for ( my $idx = 0 ; $idx <= $#words ; ++$idx ) {
+         # Grab a copy of the initial letter of the "word":
+         my $init = substr($words[$idx], 0, 1);
+         # If "word" starts with consonant, move first character to end of word:
+         !is_vowel($init) and $words[$idx] = substr($words[$idx], 1) . $init;
+         # Tack-on "ma" followed by 1+$idx copies of letter "a":
+         $words[$idx] .= "ma" . "a"x(1+$idx);
+      }
+      # Join processed "words" with ' ':
+      join ' ', @words;
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   "I love Perl",
+   # Expected output: "Imaa ovelmaaa erlPmaaaa"
+
+   # Example 2 input:
+   "Perl and Raku are friends",
+   # Expected output: "erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa"
+
+   # Example 3 input:
+   "The Weekly Challenge",
+   # Expected output: "heTmaa eeklyWmaaa hallengeCmaaaa"
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $string (@strings) {
+   say '';
+   say "Original   sentence = $string";
+   say "Goat-Latin sentence = ${\goat($string)}";
+}
diff --git a/challenge-274/robbie-hatley/perl/ch-2.pl b/challenge-274/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..773de294c3
--- /dev/null
+++ b/challenge-274/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,145 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 274-2,
+written by Robbie Hatley on Mon Jun 17, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 274-2: Bus Route
+Submitted by: Peter Campbell Smith
+Several bus routes start from a bus stop near my home, and go to
+the same stop in town. They each run to a set timetable, but they
+take different times to get into town. Write a script to find the
+times - if any - I should let one bus leave and catch a strictly
+later one in order to get into town strictly sooner. An input
+timetable consists of the service interval, the offset within the
+hour, and the duration of the trip.
+
+Example 1:
+Input: [ [12, 11, 41], [15, 5, 35] ]
+Output: [36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47]
+Route 1 leaves every 12 minutes, starting at 11 minutes past the
+hour (so 11, 23, ...) and takes 41 minutes. Route 2 leaves every
+15 minutes, starting at 5 minutes past (5, 20, ...) and takes 35
+minutes. At 45 minutes past the hour I could take the route 1
+bus at 47 past the hour, arriving at 28 minutes past the
+following hour, but if I wait for the route 2 bus at 50 past I
+will get to town sooner, at 25 minutes past the next hour.
+
+Example 2:
+Input: [ [12, 3, 41], [15, 9, 35], [30, 5, 25] ]
+Output: [ 0, 1, 2, 3, 25, 26, 27, 40, 41, 42, 43, 44, 45,
+         46, 47, 48, 49, 50, 51, 55, 56, 57, 58, 59 ]
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I first make a list, in no particular order, of all "trips" within the next 4 hours (NOT 1 hour!!!),
+with each "trip" being a two-element array [dep,arr] giving departure and arrival times. Each departure and
+arrival time will be "minutes after start of current hour", which may in the NEXT hour, or the NEXT,
+hence the need to collect trips for next 4 hours rather than just 1.
+
+Next, I mark those trips which should be skipped because there exists a trip with a later departure but
+earlier arrival with the word "skip".
+
+Then, for each minute within the current hour, I check the "next" trip to see if it should be skipped; if so,
+I add that minute to a @skips list.
+
+Finally, I return @skips.
+
+--------------------------------------------------------------------------------------------------------------
+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 arrays, with each inner-most array being three non-negative integers,
+which are interval, offset, and duration:
+./ch-2.pl '([[3,8,17],[6,4,52]],[[17,3,22],[5,4,33]])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+use v5.38;
+use List::Util 'uniq';
+$" = ', ';
+
+sub skip (@timetables) {
+   my @trips; # All trips.
+   my @skips; # Times at which next trip should be skipped.
+
+   # Get trips:
+   foreach my $tref (@timetables) {
+      my ($int, $off, $dur) = @$tref;
+      my $dep = $off;
+      while ($dep < 240) { # Next 4 hours.
+         my $arr = $dep + $dur;
+         push @trips, [$dep, $arr, 'take'];
+         $dep += $int;
+      }
+   }
+
+   # Sort trips:
+   @trips = sort {$$a[0]<=>$$b[0]||$$a[1]<=>$$b[1]} @trips;
+
+   # Mark trips which should be skipped:
+   foreach my $trip1 (@trips) {
+      foreach my $trip2 (@trips) {
+         next unless $$trip2[0] > $$trip1[0];
+         # If there's a later departure with earlier arrival,
+         # then mark $trip1 to be skipped:
+         if ($$trip2[1] < $$trip1[1]) {
+            $$trip1[2] = 'skip';
+            last;
+         }
+      }
+   }
+
+   # Diagnostics:
+   # say 'Trips = ';
+   # say "@$_" for @trips;
+
+   # Collect minutes for which "next trip should be skipped":
+   for my $minute (0..59) {
+      for my $trip (@trips) {
+         next if $$trip[0] < $minute;
+         if ($$trip[2] eq 'skip') {
+            push @skips, $minute;
+         }
+         last;
+      }
+   }
+
+   # Return result:
+   @skips;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   [ [12, 11, 41], [15, 5, 35] ],
+   # Expected output:
+   # [36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47]
+
+   # Example 2 input:
+   [ [12, 3, 41], [15, 9, 35], [30, 5, 25] ],
+   # Expected output:
+   # [0, 1, 2, 3, 25, 26, 27, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 55, 56, 57, 58, 59 ]
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $aref (@arrays) {
+   say '';
+   my @timetables = @$aref;
+   my @ttstrings = map {'[' . "@$_" . ']'} @timetables;
+   say "Times = @ttstrings";
+   my @skips = skip(@timetables);
+   say "Skips = @skips";
+}