Merge pull request #10713 from robbie-hatley/rh284

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

3 files changed, 209 insertions, 0 deletions

diff --git a/challenge-284/robbie-hatley/blog.txt b/challenge-284/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..84cf8d80de
--- /dev/null
+++ b/challenge-284/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/08/robbie-hatleys-solutions-to-weekly_26.html
\ No newline at end of file
diff --git a/challenge-284/robbie-hatley/perl/ch-1.pl b/challenge-284/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..835daae2f7
--- /dev/null
+++ b/challenge-284/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 284-1,
+written by Robbie Hatley on Sun Aug 25, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 284-1: Lucky Integer
+Submitted by: Mohammad Sajid Anwar
+You are given an array of integers, @ints. Write a script to
+find the lucky integer if found otherwise return -1. If there
+are more than one then return the largest. A lucky integer is
+an integer that has a frequency in the array equal to its
+value.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+Abundance, pushing, and popping will be involved.
+
+--------------------------------------------------------------------------------------------------------------
+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 integers, in proper Perl syntax, like so:
+./ch-1.pl '([3,4,3,7,4,7,2,7,4,7,2,7,3,4,7],[3,4,3,7,4,7,2,7,4,7,2,7,3,7],[3,4,3,7,4,7,2,7,4,7,2,7,7])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+sub lucky_integer {
+   my %abundance; ++$abundance{$_} for @_;
+   my @lucky = (-1);
+   for (sort {$a<=>$b} keys %abundance) {
+      push @lucky, $_ if $_ == $abundance{$_}
+   }
+   pop @lucky;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# EXAMPLE INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) : ([2, 2, 3, 4],[1, 2, 2, 3, 3, 3],[1, 1, 1, 3]);
+# Expected outputs:                         2                3              -1
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $aref (@arrays) {
+   my @array = @$aref;
+   my $lucky = lucky_integer @array;
+   print "\n";
+   print "Array = @array\n";
+   print "Lucky Integer = $lucky\n";
+}
diff --git a/challenge-284/robbie-hatley/perl/ch-2.pl b/challenge-284/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..f8b37e4b60
--- /dev/null
+++ b/challenge-284/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,149 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 284-2,
+written by Robbie Hatley on Sun Aug 25, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 284-2: Relative Sort
+Submitted by: Mohammad Sajid Anwar
+You are given two list of integers, @list1 and @list2.
+The elements in the @list2 are distinct and also in @list1.
+Write a script to sort the elements in @list1 such that the
+relative order of items in @list1 is same as in the @list2.
+Elements of @list1 which are not in @list2 should be placed
+at the end of @list1 in ascending order.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+
+First, I'll need subs to perform these 3 checks:
+
+1. Does an array consist purely of integers?
+2. Does an array consist purely of unique elements?
+3. Is one array a subset of another?
+
+Then apply those subs to @list1 and @list2 to make sure that both lists are integers-only, @list2 is unique,
+and @list2 is a subset of @list1.
+
+Then, I'll need to write a sub that creates a @list3 starting with same-value clusters of elements of @list1
+which are also in @list2, in the same numeric-value order as the elements of @list2, followed by the orphans
+from @list1 which aren't in @list2 sorted in increasing numeric order. I'll do this as follows: for each
+element $e2 of @list2, splice each element $e1 of @list1 which is equal to $e2 from @list1 and push it to
+@list3. Then sort the remaining elements of @list1 by acending numeric order and push them to @list3.
+
+--------------------------------------------------------------------------------------------------------------
+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 arrays of integers, in proper Perl syntax, like so:
+./ch-2.pl '([[-17,5,3,82,1,4,17],[5,4,3]],[[-17,5,3,82,1,4,17],[3,4,5]])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+use v5.36;
+
+# Does an array consist only of decimal representations of integers?
+sub is_ints :prototype(\@) ($aref) {
+   foreach my $item (@$aref) {
+      $item !~ m/^-[1-9][0-9]*$|^0$|^[1-9][0-9]*$/ and return 0
+   }
+   return 1
+}
+
+# Does an array consist only of unique elements?
+sub is_unique :prototype(\@) ($aref) {
+   my %abundance;
+   foreach my $item (@$aref) {
+      ++$abundance{$item}
+   }
+   foreach my $key (keys %abundance) {
+      1 != $abundance{$key} and return 0
+   }
+   return 1
+}
+
+# Is array A a subset of array B?
+sub is_subset :prototype(\@\@) ($Aref, $Bref) {
+   A: foreach my $A (@$Aref) {
+      B: foreach my $B (@$Bref) {
+         next A if $A == $B;
+      }
+      return 0
+   }
+   return 1
+}
+
+# Make a @list3 consisting of elements of @list1 which are also in @list2 sorted relative to @list2,
+# with remainder, sorted, tacked to end, and return @list3 to caller:
+sub relative_sort :prototype(\@\@) ($list1ref, $list2ref) {
+   my @list1 = @$list1ref;
+   my @list2 = @$list2ref;
+   my @list3 = ();
+   # First, splice-out elements of @list1 which are in @list2 and push them to @list3:
+   for my $e2 (@list2) {
+      for ( my $idx1 = 0 ; $idx1 <= $#list1 ; ++$idx1 ) {
+         my $e1 = $list1[$idx1];
+         if ($e1 == $e2) {
+            push @list3, splice @list1, $idx1, 1;
+            --$idx1 # Must re-visit same index because it now has new contents.
+         }
+      }
+   }
+   # Then, sort the orphans and tack them to the end of @list3:
+   push @list3, sort {$a<=>$b} @list1;
+   # Finally, return result to caller:
+   return @list3;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# EXAMPLE INPUTS AND EXPECTED OUTPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   [
+      [2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5],
+      [2, 1, 4, 3, 5, 6],
+   ],
+   # Expected ouput: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)
+
+   [
+      [3, 3, 4, 6, 2, 4, 2, 1, 3],
+      [1, 3, 2]
+   ],
+   # Expected output: (1, 3, 3, 3, 2, 2, 4, 4, 6)
+
+   [
+      [3, 0, 5, 0, 2, 1, 4, 1, 1],
+      [1, 0, 3, 2],
+   ],
+   # Expected output: (1, 1, 1, 0, 0, 3, 2, 4, 5)
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   my @list1 = @{$$aref[0]};
+   my @list2 = @{$$aref[1]};
+   say "List 1: (@list1)";
+   say "List 2: (@list2)";
+
+   !is_ints   @list1 and say "Error: \@list1 not array of integers. \nMoving on to next array pair." and next;
+   !is_ints   @list2 and say "Error: \@list2 not array of integers. \nMoving on to next array pair." and next;
+   !is_unique @list2 and say "Error: \@list2 is not unique elements.\nMoving on to next array pair." and next;
+   !is_subset @list2, @list1
+                     and say "Error: \@list2 not subset of \@list1.  \nMoving on to next array pair." and next;
+
+   my @list3 = relative_sort @list1, @list2;
+   say "List 1 sorted relative to List 2: (@list3)";
+}