Merge pull request #10322 from robbie-hatley/rh275

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

3 files changed, 208 insertions, 0 deletions

diff --git a/challenge-275/robbie-hatley/blog.txt b/challenge-275/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..27bc211587
--- /dev/null
+++ b/challenge-275/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/06/robbie-hatleys-solutions-to-weekly_24.html
\ No newline at end of file
diff --git a/challenge-275/robbie-hatley/perl/ch-1.pl b/challenge-275/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..95f2860cec
--- /dev/null
+++ b/challenge-275/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 275-1,
+written by Robbie Hatley on Mon Jun 24, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 275-1: Broken Keys
+Submitted by: Mohammad Sajid Anwar
+You are given a sentence $sentence and list of broken keys @keys.
+Write a script to find out how many words can be typed fully.
+
+Example 1:
+Input: $sentence = "Perl Weekly Challenge", @keys = ('l', 'a')
+Output: 0
+
+Example 2:
+Input: $sentence = "Perl and Raku", @keys = ('a')
+Output: 1
+Only Perl since the other word two words contain 'a' and can't
+be typed fully.
+
+Example 3:
+Input: $sentence = "Well done Team PWC", @keys = ('l', 'o')
+Output: 2
+
+Example 4:
+Input: $sentence = "The joys of polyglottism", @keys = ('T')
+Output: 2
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+A simple regular expression will handle this: ^[^$keys]+$
+
+--------------------------------------------------------------------------------------------------------------
+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 two-element arrays, with each inner array being a double-quoted sentence followed by
+an array of double-quoted keyboard characters, in proper Perl syntax, like so:
+./ch-1.pl '(["She shaved?", ["q","r"]],["We sat around the tree.", ["6","."]])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, VARIABLES, AND SUBS:
+
+   use v5.38;
+   $"='';
+   sub can_type_in_spite_of_broken_keys ($sentence, @keys) {
+      my $can_type = 0;
+      map {/^[^@keys]+$/i and ++$can_type} split /\h+/, $sentence;
+      $can_type;
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   ["Perl Weekly Challenge", ["l", "a"]],
+   # Expected output: 0
+
+   # Example 2 input:
+   ["Perl and Raku", ["a"]],
+   # Expected output: 1
+
+   # Example 3 input:
+   ["Well done Team PWC", ["l", "o"]],
+   # Expected output: 2
+
+   # Example 4 input:
+   ["The joys of polyglottism", ["T"]],
+   # Expected output: 2
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $aref (@arrays) {
+   say '';
+   my $sentence =   $aref->[0] ;
+   my @keys     = @{$aref->[1]};
+   my $can_type = can_type_in_spite_of_broken_keys($sentence, @keys);
+   say "Sentence: \"$sentence\"";
+   say "Broken keys: @keys";
+   say "Number of words that can be typed in spite of broken keys = $can_type";
+}
diff --git a/challenge-275/robbie-hatley/perl/ch-2.pl b/challenge-275/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..968febf733
--- /dev/null
+++ b/challenge-275/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,115 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 275-2,
+written by Robbie Hatley on Mon Jun 24, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 275-2: Replace Digits
+Submitted by: Mohammad Sajid Anwar
+You are given an alphanumeric string, $str, where each character
+is either a letter or a digit. Write a script to replace each
+digit in the given string with the value of the previous letter
+plus (digit) places.
+
+Example 1:
+Input: $str = 'a1c1e1'
+Ouput: 'abcdef'
+shift('a', 1) => 'b'
+shift('c', 1) => 'd'
+shift('e', 1) => 'f'
+
+Example 2:
+Input: $str = 'a1b2c3d4'
+Output: 'abbdcfdh'
+shift('a', 1) => 'b'
+shift('b', 2) => 'd'
+shift('c', 3) => 'f'
+shift('d', 4) => 'h'
+
+Example 3:
+Input: $str = 'b2b'
+Output: 'bdb'
+
+Example 4:
+Input: $str = 'a16z'
+Output: 'abgz'
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I find it interesting that the examples show that "previous digit" means "nearest digit to the left in
+original strinug, if any", rather than "digit immediately to the left". This causes two ambiguities:
+
+1. What if there is NO previous letter?
+2. What if we try to shift 'z' by 3?
+
+I think I'll fix #1 by returning 'invalid_string' unless the input is well-formed (m/[a-z][a-z0-9]*/).
+
+And I'll fix #2 by looping back to the beginning of the alphabet as in ROT13 (so that z3 is c).
+
+--------------------------------------------------------------------------------------------------------------
+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 matching m/^[a-z]{1}[a-z0-9]*$/, in proper Perl syntax, like so:
+./ch-2.pl '("z9a3bgq2f", "z9z1z7z2")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.38;
+   sub replace_digits ($string) {
+      return 'invalid_string' unless $string =~ m/[a-z][a-z0-9]*/;
+      my $new = '';
+      my $prev = '-';
+      for my $char (split //, $string) {
+         if ( $char =~ m/^[a-z]{1}$/ ) {
+            $prev = $char;
+            $new .= $char;
+         }
+         elsif ( $char =~ m/^[0-9]{1}$/ ) {
+            return 'invalid_prev' unless $prev =~ m/^[a-z]{1}$/;
+            my $old_ord = ord($prev);
+            my $new_ord = ($old_ord - 97 + $char) % 26 + 97;
+            $new .= chr $new_ord;
+         }
+         else {return 'invalid_char';}
+      }
+      $new;
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   'a1c1e1',
+   # Expected output = 'abcdef'
+
+   # Example 2 input:
+   'a1b2c3d4',
+   # Expected output = 'abbdcfdh'
+
+   # Example 3 input:
+   'b2b',
+   # Expected output = 'bdb'
+
+   # Example 4 input:
+   'a16z',
+   # Expected output = 'abgz'
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $string (@strings) {
+   say '';
+   say "Original string = $string";
+   say 'String with digits replacecd = ', replace_digits $string;
+}