Robbie Hatley's Perl solution for The Weekly Challenge 213-1

3 files changed, 216 insertions, 0 deletions

diff --git a/challenge-213/robbie-hatley/blog.txt b/challenge-213/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..1893536b94
--- /dev/null
+++ b/challenge-213/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2023/04/robbie-hatleys-perl-solutions-to-weekly_23.html
\ No newline at end of file
diff --git a/challenge-213/robbie-hatley/perl/ch-1.pl b/challenge-213/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..18646ea55c
--- /dev/null
+++ b/challenge-213/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,86 @@
+#! /bin/perl -CSDA
+
+=pod
+
+------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 90-character-wide UTF-8 Perl-source-code text file with hard Unix line breaks.
+=========|=========|=========|=========|=========|=========|=========|=========|=========|
+
+------------------------------------------------------------------------------------------
+TITLE BLOCK:
+ch-1.pl
+Robbie Hatley's Perl solutions for The Weekly Challenge 213-1.
+Written by Robbie Hatley on Wed Apr 19, 2023.
+
+------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 1: Fun Sort
+Submitted by: Mohammad S Anwar
+Write a script to sort a list of positive integers so that the sorted list consists of 
+the even integers in ascending order followed by the odd integers in ascending order. 
+Example 1: Input: (1,2,3,4,5,6)         Output: (2,4,6,1,3,5)
+Example 2: Input: (1,2)                 Output: (2,1)
+Example 3: Input: (1)                   Output: (1)
+Example 4: Input: (5,-7,4,7,10,2,-8,9)  Output: (-8,2,4,10,-7,5,7,9)
+
+------------------------------------------------------------------------------------------
+INPUT / OUTPUT NOTES:
+
+Input is either from built-in array of arrays or from @ARGV. If using @ARGV, provide one
+argument which must be a 'single-quoted' array of arrays of integers in correct Perl
+syntax. For example:
+./ch-1.pl '([7,3,11,8], [3,19,3,42], [5,-7,10,2,8,4,3,6,19,14,9])'
+
+Output is to STDOUT and will be the input array followed by the "Fun Sort" of the array.
+
+=cut
+
+# ======= PRELIMINARIES: =================================================================
+use v5.36;
+use strict;
+use warnings;
+use utf8;
+use Sys::Binmode;
+use Time::HiRes 'time';
+$"=', ';
+
+# ======= SUBROUTINES: ===================================================================
+
+sub even_odd ($aref, $sref) {
+   my @evens = ();
+   my @odds  = ();
+   for my $x (@{$aref}) {
+      if (0 == $x % 2) {push @evens, $x;}
+      else             {push @odds , $x;}
+   }
+   push @$sref, (sort {$a<=>$b} @evens), (sort {$a<=>$b} @odds);
+}
+
+# ======= DEFAULT INPUT: =================================================================
+my @arrays =
+(
+   [1,2,3,4,5,6],
+   [1,2],
+   [1],
+   [5,-7,4,9,10,2,-8,7],
+);
+
+# ======= NON-DEFAULT INPUT: =============================================================
+if (@ARGV) {@arrays = eval($ARGV[0])}
+
+# ======= MAIN BODY OF PROGRAM: ==========================================================
+
+{ # begin main
+   my $t0 = time;
+   for (@arrays) {
+      my @sorted = ();
+      even_odd($_, \@sorted);
+      say '';
+      say " un-sorted array: (@{$_})";
+      say "Fun-Sorted array: (@sorted)";
+   }
+   my $t1 = time; my $te = 1000000*($t1 - $t0);
+   printf("\nExecution time was %.3fµs.\n", $te);
+   exit 0;
+} # end main
diff --git a/challenge-213/robbie-hatley/perl/ch-2.pl b/challenge-213/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..578faf6776
--- /dev/null
+++ b/challenge-213/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,129 @@
+#! /bin/perl -CSDA
+
+=pod
+
+------------------------------------------------------------------------------------------
+COLOPHON:
+This is a 90-character-wide UTF-8 Perl-source-code text file with hard Unix line breaks.
+=========|=========|=========|=========|=========|=========|=========|=========|=========|
+
+------------------------------------------------------------------------------------------
+TITLE BLOCK:
+ch-2.pl
+Robbie Hatley's Perl solutions for The Weekly Challenge 213-2.
+Written by Robbie Hatley on Wed Apr 19, 2023.
+
+------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+
+Task 2: Shortest Route
+Submitted by: Mohammad S Anwar
+You are given a list of bidirectional routes defining a network of nodes, as well as 
+source and destination node numbers. Write a script to find the route from source to
+destination that passes through fewest nodes, or print -1 of no such route exists.
+
+Example 1:
+Inputs: @routes = ([1,2,6], [5,6,7])
+        $source = 1
+        $destination = 7
+Output: (1,2,6,7)
+Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6
+then jump to route [5,6,7] and takes the route 6 -> 7.
+So the final route is (1,2,6,7)
+
+Example 2:
+Inputs: @routes = ([1,2,3], [4,5,6])
+        $source = 2
+        $destination = 5
+Output: -1
+(No route is possible.)
+
+Example 3:
+Inputs: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8])
+        $source = 1
+        $destination = 7
+Output: (1,2,3,8,7)
+Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3
+then jump to route [3,8,9] and takes the route 3 -> 8
+then jump to route [7,8] and takes the route 8 -> 7
+So the final route is (1,2,3,8,7)
+
+------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+
+
+------------------------------------------------------------------------------------------
+INPUT / OUTPUT 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 in correct Perl syntax, with each array
+consisting of source, followed by destination, followed by a sequence of arrays of 
+integers representing various routes, like so:
+./ch-2.pl '([4, -34, [5, -37, 4], [-3, 2, 5], [2, 6, -34]], [1, 5, [1,3,7], [5,6,7]])'
+
+Output is to STDOUT and will consist of the inputs followed by the shortest route of any,
+or -1 of no route exists from source to destination.
+
+=cut
+
+# ======= PRELIMINARIES: =================================================================
+# 
+use v5.36;
+use strict;
+use warnings;
+use utf8;
+use Sys::Binmode;
+use Time::HiRes 'time';
+use List::AllUtils;
+$"=', ';
+
+# ======= SUBROUTINES: ===================================================================
+
+sub shortest ($srce, $dest, $routes, $path) {
+   my @sri; # Srce Route Indexes.
+   my @dri; # Dest Route Indexes.
+   for ( my $i = 0 ; $i <= $#$routes ; ++$i ) {
+      push @sri, $i if any { $_ == $srce } @{${$routes}[$i]};
+      push @dri, $i if any { $_ == $dest } @{${$routes}[$i]};
+   }
+   
+   @$path = (-1);
+}
+
+# ======= DEFAULT INPUTS: ================================================================
+
+my @arrays = 
+(
+   [1, 7, [1,2,6], [5,6,7]],
+   [2, 5, [1,2,3], [4,5,6]],
+   [1, 7, [1,2,3], [4,5,6], [3,8,9], [7,8]],
+);
+
+# ======= NON-DEFAULT INPUTS: ============================================================
+
+if (@ARGV) {@arrays = eval($ARGV[0]);}
+
+# ======= MAIN BODY OF PROGRAM: ==========================================================
+
+{ # begin main
+   my $t0 = time;
+   say 'Incomplete. (Stub.)';
+   for (@arrays){
+      my $srce    = $$_[0];
+      my $dest    = $$_[1];
+      my $routes  = [@$_[2..$#$_]];
+      my $path    = [];
+      my $success = shortest ($srce, $dest, $routes, $path);
+      say '';
+      print "srce: $srce  dest: $dest  routes: ";
+      for ( my $i = 0 ; $i <= $#$routes ; ++$i ) {
+         print "[@{${$routes}[$i]}]";
+         print ', ' if $i != $#$routes;
+      }
+      print "\n";
+      say "Shortest route: @$path";
+   }
+   my $µs = 1000000 * (time - $t0);
+   printf("\nExecution time was %.3fµs.\n", $µs);
+   exit 0;
+} # end main