Robbie Hatley's Perl solutions to The Weekly Challenge #245.

3 files changed, 278 insertions, 0 deletions

diff --git a/challenge-245/robbie-hatley/blog.txt b/challenge-245/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..d163338835
--- /dev/null
+++ b/challenge-245/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2023/11/robbie-hatleys-solutions-to-weekly_29.html
\ No newline at end of file
diff --git a/challenge-245/robbie-hatley/perl/ch-1.pl b/challenge-245/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..1b3c6a819a
--- /dev/null
+++ b/challenge-245/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,128 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 245-1.
+Written by Robbie Hatley on Tue Nov 28, 2023.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 245-1: Sort Language
+Submitted by: Mohammad S Anwar
+You are given two arrays: one of languages and the other of their
+popularities. Write a script to sort the languages based on their
+popularities.
+
+Example 1:
+Input: @lang = ('perl', 'c', 'python'); @popularity = (2, 1, 3);
+Output: ('c', 'perl', 'python')
+
+Example 2:
+Input: @lang = ('c++', 'haskell', 'java'); @popularity = (1, 3, 2);
+Output: ('c++', 'java', 'haskell')
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I tried solving this problem by "zipping" the two arrays together to make an array of [language, popularity]
+pairs, then sorting that array numerically by the second elements of the pairs; however, the resulting code
+was excessively verbose. But then I hit upon a much easier way: use an array slice! Take the indexes of the
+first array (0..$#$aref1), re-order them according to a sort of the second array, then "slice" the first
+array using the re-ordered indexes. The result was that I could now solve this entire problem with half a line
+of code.
+
+--------------------------------------------------------------------------------------------------------------
+IO NOTES:
+Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a
+double-quoted array of arrays of two arrays, with the inner array pairs consisting of an array of
+single-quoted strings followed by an array of small positive integers (1-9), in proper Perl syntax, like so:
+./ch-1.pl "([['Go','Lisp','AutoIt3','Logo'],[2, 1, 4, 3]],[['Awk','Cobol','Perl','Sed'],[3,4,1,2]])"
+
+Output is to STDOUT and will be each input array followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS AND MODULES USED:
+
+use v5.38;
+use strict;
+use warnings;
+use utf8;
+use warnings FATAL => 'utf8';
+use Sys::Binmode;
+use Time::HiRes 'time';
+
+# ------------------------------------------------------------------------------------------------------------
+# START TIMER:
+our $t0;
+BEGIN {$t0 = time}
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+sub is_array_of_pos_ints($aref) {
+   return 0 if 'ARRAY' ne ref $aref;
+   for (@$aref) {
+      return 0 if !/^[1-9]\d*$/;
+   }
+   return 1;
+}
+
+sub sort_array1_by_array2($aref1, $aref2) {
+   return @$aref1[sort{$$aref2[$a]<=>$$aref2[$b]}0..$#$aref1];
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Inputs:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 Inputs:
+   [
+      ['perl', 'c', 'python'],
+      [2, 1, 3],
+   ],
+   # Expected Output: ('c', 'perl', 'python')
+
+   # Example 2 Inputs:
+   [
+      ['c++', 'haskell', 'java'],
+      [1, 3, 2],
+   ],
+   # Expected Output: ('c++', 'java', 'haskell')
+);
+
+# Main loop:
+for my $aref (@arrays) {
+   say '';
+   my $aref1 = $aref->[0];
+   my $aref2 = $aref->[1];
+   say 'Languages    = (' . join(', ', map {"'$_'"} @$aref1) . ')';
+   say 'Popularities = (' . join(', ',              @$aref2) . ')';
+   if ( scalar(@$aref1) != scalar(@$aref2) ) {
+      say 'Error: subarrays are of unequal lengths.';
+      say 'Moving on to next array.';
+      next;
+   }
+   if ( !is_array_of_pos_ints($aref2) ) {
+      say 'Error: second subarray is not array of positive integers.';
+      say 'Moving on to next array.';
+      next;
+   }
+   my @sorted = sort_array1_by_array2($aref1, $aref2);
+   say 'Sorted       = (' . join(', ', map {"'$_'"} @sorted) . ')';
+}
+exit;
+
+# ------------------------------------------------------------------------------------------------------------
+# DETERMINE AND PRINT EXECUTION TIME:
+END {my $µs = 1000000 * (time - $t0);printf("\nExecution time was %.0fµs.\n", $µs)}
+__END__
diff --git a/challenge-245/robbie-hatley/perl/ch-2.pl b/challenge-245/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..d1173539a0
--- /dev/null
+++ b/challenge-245/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,149 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 110-character-wide Unicode UTF-8 Perl-source-code text file with hard Unix line breaks ("\x0A").
+¡Hablo Español! Говорю Русский. Björt skjöldur. ॐ नमो भगवते वासुदेवाय. 看的星星，知道你是爱。麦藁雪、富士川町、山梨県。
+
+--------------------------------------------------------------------------------------------------------------
+TITLE BLOCK:
+Solutions in Perl for The Weekly Challenge 245-2.
+Written by Robbie Hatley on Tue Nov 28, 2023.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 245-2: Largest of Three
+Submitted by: Mohammad S Anwar
+You are given an array of integers >= 0. Write a script to return
+the largest number formed by concatenating some of the given
+integers in any order which is also multiple of 3. Return -1 if
+none found.
+
+Example 1:
+Input: @ints = (8, 1, 9)
+Output: 981
+981 % 3 == 0
+
+Example 2:
+Input: @ints = (8, 6, 7, 1, 0)
+Output: 8760
+
+Example 3:
+Input: @ints = (1)
+Output: -1
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+This WOULD BE just a matter of combinatorics if not for the fact that no upper bound is given for our
+non-negative integers. That means that we'll be "concatenating" integers with possibly more-than-one digit,
+so we can't just assume that each integer is one digit then concatenate all permutations of all combinations.
+Instead, we need to make a "sub concatenate($aref)" which first splits each input into its digits, then
+pushes those clusters of digits onto an array, then joins that array. Also we'll need a "sub are_nni($aref)"
+to check that all inputs are non-negative integers, and a "sub largest_of_three($aref)" to find the largest
+multiple of 3 we can make or return -1 if we can't make any. THEN the rest is just permutations of
+combinations. More work for CPAN module "Math::Combinatorics". This time I'll use it's non-OOP functions,
+as OOP just isn't necessary for a problem like this, and indeed just gets in the way.
+
+--------------------------------------------------------------------------------------------------------------
+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 non-negative integers, in proper Perl syntax, like so:
+./ch-2.pl '([3,14,0,5,72],[1,0,97,23])'
+
+Output is to STDOUT and will be each input array followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS AND MODULES USED:
+
+use v5.38;
+use strict;
+use warnings;
+use utf8;
+use warnings FATAL => 'utf8';
+use Sys::Binmode;
+use Time::HiRes 'time';
+use Math::Combinatorics;
+
+# ------------------------------------------------------------------------------------------------------------
+# START TIMER:
+our $t0;
+BEGIN {$t0 = time}
+
+# ------------------------------------------------------------------------------------------------------------
+# SUBROUTINES:
+
+# Are all of the elements of a referred-to array decimal representations of non-negative integers?
+sub are_nni ($aref) {
+   return 0 if 'ARRAY' ne ref $aref;
+   return 0 if scalar(@$aref) < 1;
+   for (@$aref) {return 0 if !/^0$|^[1-9]\d*$/}
+   return 1;
+}
+
+sub concatenate($aref) {
+   my @digits;
+   for (@$aref) {push @digits, split(//,$_)}
+   return join('',@digits);
+}
+
+sub largest_of_three($aref) {
+   # For each possible non-empty subset size of @$aref, get all combinations
+   # of that size, then get all permutations of each of those combinations,
+   # then concatentate each of those permutations to an integer, and keep track
+   # of the maximum divisible-by-3 integer seen, then return the maximum
+   # which will be -1 if we couldn't make any divisible-by-3 integers:
+   my $max = -1;
+   for ( my $size = scalar(@$aref) ; $size >= 1 ; --$size ) {
+      my @combs = combine($size,@$aref);
+      for my $cref ( @combs ) {
+         my @perms = permute(@$cref);
+         for my $pref ( @perms ) {
+            my $integer = concatenate($pref);
+            0 == $integer % 3 && $integer > $max and $max = $integer;
+         }
+      }
+   }
+   return $max;
+}
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+
+# Inputs:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 Input:
+   [8, 1, 9],
+   # Expected Output: 981
+
+   # Example 2 Input:
+   [8, 6, 7, 1, 0],
+   # Expected Output: 8760
+
+   # Example 3 Input:
+   [1],
+   # Expected Output: -1
+);
+
+# Main loop:
+for my $aref (@arrays) {
+   say '';
+   say 'Array = (' . join(', ', @$aref) . ')';
+   if ( !are_nni($aref) ) {
+      say 'Error: not an array of non-negative integers.';
+      say 'Moving on to next array.';
+      next;
+   }
+   say 'Greatest multiple of 3 creatable from array = ',
+   largest_of_three($aref);
+}
+exit;
+
+# ------------------------------------------------------------------------------------------------------------
+# DETERMINE AND PRINT EXECUTION TIME:
+END {my $µs = 1000000 * (time - $t0);printf("\nExecution time was %.0fµs.\n", $µs)}
+__END__