Merge pull request #7686 from robbie-hatley/207

Robbie Hatley's Perl solutions for PWCC 207.

3 files changed, 163 insertions, 0 deletions

diff --git a/challenge-207/robbie-hatley/blog.txt b/challenge-207/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..b501356b41
--- /dev/null
+++ b/challenge-207/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2023/03/robbie-hatleys-perl-solutions-to-weekly_6.html
\ No newline at end of file
diff --git a/challenge-207/robbie-hatley/perl/ch-1.pl b/challenge-207/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..bdcfc86b25
--- /dev/null
+++ b/challenge-207/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,82 @@
+#! /bin/perl -CSDA
+
+# This is a 120-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+# ¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय.    看的星星，知道你是爱。 麦藁雪、富士川町、山梨県。
+# =======|=========|=========|=========|=========|=========|=========|=========|=========|=========|=========|=========|
+
+########################################################################################################################
+# Robbie Hatley's Perl solution to The Weekly Challege #207-1.
+# Written by Robbie Hatley.
+# Edit history:
+# Mon Mar 06, 2023: Wrote it.
+########################################################################################################################
+
+=pod
+
+Task 1: Keyboard Word
+Submitted by: Mohammad S Anwar
+Write a script to print all the words in a given array that can be typed
+using only letters on one row of a QWERTY keyboard:
+Row 1: qwertyuiop
+Row 2: asdfghjkl
+Row 3: zxcvbnm
+Example 1:  Input: ("Hello","Alaska","Dad","Peace")  Output: ("Alaska","Dad")
+Example 2:  Input: ("OMG","Bye")                     Output: ()
+
+=cut
+
+# IO NOTES:
+# NOTE: Input is by either built-in array-of-arrays, or @ARGV. If using @ARGV,
+#       the args should be a space-separated sequence of 'single-quoted' words
+#       using only letters available on a standard QWERTY keyboard; this 
+#       sequence will be considered to be a single array of words.
+# NOTE: Output is to STDOUT and will be those words which can be typed on one
+#       row of a QWERTY keyboard.
+
+# PRELIMINARIES:
+use v5.36;
+use strict;
+use warnings;
+$"=", ";
+
+# CPAN MODULES:
+use Sys::Binmode;
+use List::AllUtils qw( all );
+
+# SUBROUTINES:
+
+sub row($letter){
+      if ($letter =~ m/[qwertyuiop]/i ) {return 1}
+   elsif ($letter =~ m/[asdfghjkl]/i  ) {return 2}
+   elsif ($letter =~ m/[zxcvbnm]/i    ) {return 3}
+   else                                 {return 0}}
+
+sub one_row($word){
+   my @letters = split //,$word;
+   my $rofl = row($letters[0]);
+   if (all {row($_) eq $rofl} @letters) {return 1}
+   else                                 {return 0}}
+
+# DEFAULT INPUTS:
+my @arrays = 
+(
+   ['Hello','Alaska','Dad','Peace'],
+   ['OMG','Bye'],
+   ['dog','pig','cow','horse','lad','lass'],
+   ['Bob','Tom','Helen','Sal'],
+   ['query','fall','you','me','fad']
+);
+
+# NON-DEFAULT INPUTS:
+if (@ARGV) {@arrays = ([@ARGV]);}
+
+# MAIN BODY OF SCRIPT:
+my $t0 = time;
+for (@arrays){
+   my @array = @{$_};
+   my @one_row_words = ();
+   foreach my $word (@array){
+      if (one_row($word)) {push @one_row_words, $word}}
+   say '';
+   say "original word  list = (@array)";
+   say "one-row  words list = (@one_row_words)";}
\ No newline at end of file
diff --git a/challenge-207/robbie-hatley/perl/ch-2.pl b/challenge-207/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..a17c4e9edb
--- /dev/null
+++ b/challenge-207/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#! /bin/perl -CSDA
+
+# This is a 120-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+# ¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय.    看的星星，知道你是爱。 麦藁雪、富士川町、山梨県。
+# =======|=========|=========|=========|=========|=========|=========|=========|=========|=========|=========|=========|
+
+########################################################################################################################
+# Robbie Hatley's Perl solution to The Weekly Challege #207-2.
+# Written by Robbie Hatley.
+# Edit history:
+# Mon Mar 06, 2023: Wrote it.
+########################################################################################################################
+
+=pod
+
+Task 2: H-Index
+Submitted by: Mohammad S Anwar
+Write a script to compute the "H-Index" of an array of integers enumerating 
+the citations which a researcher has received for each of his/her papers. 
+For more information please checkout the wikipedia page:
+"The H-Index is the largest number h such that h articles have at least h 
+citations each. For example, if an author has five publications, with 9, 7, 
+6, 2, and 1 citations (ordered from greatest to least), then the author’s 
+h-index is 3, because the author has three publications with 3 or more 
+citations. However, the author does not have four publications with 4 or 
+more citations."
+
+Example 1:  Input: (10,8,5,4,3)  Output: 4
+Example 2:  Input: (25,8,5,3,3)  Output: 3
+
+=cut
+
+# IO NOTES:
+# NOTE: Input is by either built-in array-of-arrays, or @ARGV. If using @ARGV,
+#       the args should be a space-separated sequence of non-negative integers;
+#       this sequence will be considered to be a single array.
+# NOTE: Output is to STDOUT and will be the H Index of the array.
+
+# PRELIMINARIES:
+use v5.36;
+use strict;
+use warnings;
+$"=", ";
+
+# CPAN MODULES:
+use Sys::Binmode;
+use List::AllUtils qw( max );
+
+# SUBROUTINES:
+
+sub max0 (@array){
+   my $max = max(@array);
+   return defined($max) ? $max : 0;}
+
+sub h (@array){
+   my @pap_w_n_citations = (0)x(max0(@array)+1);
+   for (@array){for (0..$_) {++$pap_w_n_citations[$_]}}
+   for (reverse(0..$#pap_w_n_citations)){
+      if ($pap_w_n_citations[$_]>=$_){return $_}}}
+
+# DEFAULT INPUTS:
+my @arrays =
+(
+   [8,10,3,5,4],
+   [8,3,5,25,3],
+   [],
+   [17,26,14,18,29]
+);
+
+# NON-DEFAULT INPUTS:
+if (@ARGV) {@arrays = ([@ARGV]);}
+
+# MAIN BODY OF SCRIPT:
+my $t0 = time;
+for (@arrays){
+   say '';
+   my @array = @{$_};
+   my $h = h(@array);   
+   say "\@array:    (@array)";
+   say "h(\@array): $h      ";}
\ No newline at end of file