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

3 files changed, 216 insertions, 0 deletions

diff --git a/challenge-273/robbie-hatley/blog.txt b/challenge-273/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..57339653ed
--- /dev/null
+++ b/challenge-273/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/06/robbie-hatleys-solutions-to-weekly_10.html
\ No newline at end of file
diff --git a/challenge-273/robbie-hatley/perl/ch-1.pl b/challenge-273/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..03c97c45fe
--- /dev/null
+++ b/challenge-273/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,118 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 273-1,
+written by Robbie Hatley on Mon Jun 10, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 273-1: Percentage of Character
+Submitted by: Mohammad Sajid Anwar
+You are given a string, $str and a character $chr. Write a
+script to return the nearest integer percentage of the
+characters in $str which are $chr.
+
+Example 1:
+Input: $str = "perl", $chr = "e"
+Output: 25
+
+Example 2:
+Input: $str = "java", $chr = "a"
+Output: 50
+
+Example 3:
+Input: $str = "python", $chr = "m"
+Output: 0
+
+Example 4:
+Input: $str = "ada", $chr = "a"
+Output: 67
+
+Example 5:
+Input: $str = "ballerina", $chr = "l"
+Output: 22
+
+Example 6:
+Input: $str = "analitik", $chr = "k"
+Output: 13
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+This is just a matter of counting instances of $chr in $str, dividing by length($str), multiplying by 100,
+and rounding to nearest integer. The m// operator and the "lround" function from POSIX are useful here:
+
+   sub pct_chr_in_str ($str, $chr) {
+      my $length = length($str);
+      my @matches = $str =~ m/$chr/g;
+      lround(100*(scalar(@matches)/$length));
+   }
+
+--------------------------------------------------------------------------------------------------------------
+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. The second element of each
+inner array will be construed as a character to be searched-for in the first element. Eg:
+./ch-1.pl '(["aardvark", "a"], ["茶と茶と茶", "茶"])'
+
+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 POSIX 'lround';
+
+   # What is the percentage, to the nearest integer,
+   # of a given character in a given string?
+   sub pct_chr_in_str ($str, $chr) {
+      my $length = length($str);
+      my @matches = $str =~ m/$chr/g;
+      lround(100*(scalar(@matches)/$length));
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   ["perl", "e"],
+   # Expected output: 25
+
+   # Example 2:
+   ["java", "a"],
+   # Expected output: 50
+
+   # Example 3:
+   ["python", "m"],
+   # Expected output: 0
+
+   # Example 4:
+   ["ada", "a"],
+   # Expected output: 67
+
+   # Example 5:
+   ["ballerina", "l"],
+   # Expected output: 22
+
+   # Example 6:
+   ["analitik", "k"],
+   # Expected output: 13
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+say 'Percentange (to nearest integer) of each character in each string:';
+for my $aref (@arrays) {
+   say '';
+   my ($str, $chr) = @$aref;
+   my $pcis = pct_chr_in_str($str, $chr);
+   say "String = $str";
+   say "Char   = $chr";
+   say "Pct    = $pcis%";
+}
diff --git a/challenge-273/robbie-hatley/perl/ch-2.pl b/challenge-273/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..647f237d95
--- /dev/null
+++ b/challenge-273/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 273-2,
+written by Robbie Hatley on Mon Jun 10, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 273-2: B After A
+Submitted by: Mohammad Sajid Anwar
+You are given a string, $str. Write a script to return true if
+there is at least one b, and no a appears after the first b.
+
+Example 1:
+Input: $str = "aabb"
+Output: true
+
+Example 2:
+Input: $str = "abab"
+Output: false
+
+Example 3:
+Input: $str = "aaa"
+Output: false
+
+Example 4:
+Input: $str = "bbb"
+Output: true
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+A regular expression will solve this. What we're looking for is "b followed by non-a characters to end
+of string". The regular expression for that is "^[^b]*b[^a]*$":
+
+   sub b_after_a ($str) {
+      $str =~ m/^[^b]*b[^a]*$/
+   }
+
+--------------------------------------------------------------------------------------------------------------
+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 '("Bob shaved?", "I shaved Bob!", "soliloquy", "ambient", "麦藁雪")'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.38;
+   use strict;
+   use warnings;
+   use utf8;
+   use warnings FATAL => 'utf8';
+
+   # Does a given string contain at least one "b"
+   # but no "a" after the first "b"?
+   sub b_after_a ($str) {
+      $str =~ m/^[^b]*b[^a]*$/
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   "aabb",
+   # Expected output: true
+
+   # Example 2 input:
+   "abab",
+   # Expected output: false
+
+   # Example 3 input:
+   "aaa",
+   # Expected output: false
+
+   # Example 4 input:
+   "bbb",
+   # Expected output: true
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+say 'Does each string contain at least one "b" with no "a" after first "b"?';
+for my $str (@strings) {
+   say '';
+   say "String = $str";
+   my $ab = b_after_a($str);
+   my $truefalse = $ab ? 'true' : 'false';
+   say "Result = $truefalse";
+}