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

3 files changed, 236 insertions, 0 deletions

diff --git a/challenge-294/robbie-hatley/blog.txt b/challenge-294/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..aa4e55c579
--- /dev/null
+++ b/challenge-294/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2024/11/robbie-hatleys-solutions-in-perl-for.html
\ No newline at end of file
diff --git a/challenge-294/robbie-hatley/perl/ch-1.pl b/challenge-294/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..974c762df3
--- /dev/null
+++ b/challenge-294/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 294-1,
+written by Robbie Hatley on Wed Nov 06, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 294-1: Consecutive Sequence
+Submitted by: Mohammad Sajid Anwar
+You are given an unsorted array of integers, @ints. Write a
+script to return the length of the longest consecutive elements
+sequence. Return -1 if none found. The algorithm must run in O(n)
+time.
+
+Example 1:
+Input: @ints = (10, 4, 20, 1, 3, 2)
+Output: 4
+The longest consecutive sequence (1, 2, 3, 4).
+The length of the sequence is 4.
+
+Example 2:
+Input: @ints = (0, 6, 1, 8, 5, 2, 4, 3, 0, 7)
+Output: 9
+
+Example 3:
+Input: @ints = (10, 30, 20)
+Output: -1
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I could first sort the array, but that would be O(n*log(n)), not O(n). Faster will be to make a hash and look
+for subsequences in that.
+
+--------------------------------------------------------------------------------------------------------------
+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 '([-4,7,82,16,4] , [-4,7,82,-3,8,16,6,4])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.16;
+
+   # Determine max consecutive-subsequence length
+   # within an array of integers:
+   sub maximum_consecutive_subsequence_length {
+      # Make a hash:
+      my %hash; for (@_) {++$hash{$_};}
+      # Declare vars for begin, end, length, and max:
+      my $beg = 0;my $end = 0;my $len = 0;my $max = 0;
+      # Examine each element of the input array to see if it's
+      # the beginning of a consecutive subsequence:
+      for my $x (@_) {
+         # Move on to next array element if $x-1 is in hash:
+         next if $hash{$x-1};
+         # We're at the beginning of a new consecutive subsequence,
+         # so set $beg and $end to here:
+         $beg = $x;$end=$x;
+         # Find the end:
+         ++$end while $hash{$end};
+         # Get the length:
+         $len = $end - $beg;
+         # Update $max if $len is greater than $max:
+         if ( $len > $max ) {$max = $len;}
+      }
+      # Return maximum consecutive subsequence length,
+      # unless it's <2 in which case return -1:
+      if ($max > 1) {return $max;} else {return -1;}
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   [10, 4, 20, 1, 3, 2],           # Expected output = 4
+   [0, 6, 1, 8, 5, 2, 4, 3, 0, 7], # Expected output = 9
+   [10, 30, 20],                   # Expected output = -1
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   my @a = @$aref;
+   my $m = maximum_consecutive_subsequence_length(@a);
+   say "Array = (@a)";
+   say "Max consecutive-subsequence length = $m";
+}
diff --git a/challenge-294/robbie-hatley/perl/ch-2.pl b/challenge-294/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..e4014d7ecb
--- /dev/null
+++ b/challenge-294/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,137 @@
+#!/usr/bin/env -S perl -CSDA
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 294-2,
+written by Robbie Hatley on Wed Nov 06, 2024.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 294-2: Next Permutation
+Submitted by: Mohammad Sajid Anwar
+You are given an array of integers, @ints. Write a script to
+find out the next permutation of the given array. The next
+permutation of an array of integers is the next
+lexicographically greater permutation of the decimal
+representations of its integers.
+
+Example 1:
+Input: @ints = (1, 2, 3)
+Output: (1, 3, 2)
+Permutations of (1, 2, 3) arranged lexicographically:
+(1, 2, 3)
+(1, 3, 2)
+(2, 1, 3)
+(2, 3, 1)
+(3, 1, 2)
+(3, 2, 1)
+
+Example 2:
+Input: @ints = (2, 1, 3)
+Output: (2, 3, 1)
+
+Example 3:
+Input: @ints = (3, 1, 2)
+Output: (3, 2, 1)
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+After doing some researching, I found a method of finding "the lexicographically 'next' permutation" of a
+list of strings which doesn't need to generate all of the permutations, just the "next". It goes like this:
+
+1. Find the "pivot", which is the rightmost index i such that array[i] lt array[i-1].
+2. Find the "successor", which is the rightmost index j such that array[j] gt array[i].
+3. Swap the pivot and the successor.
+4. Reverse the "suffix", which is the part to the right of the pivot.
+
+Note that in the above I use "lt" and "gt" instead of "<" and ">". This is because the problem specifies the
+"lexicographical" next permutation, as opposed to the "numerical" next permutation which would have used
+"<" and ">" instead. Note, for example, that 123 is lexicographically less than 34 (because "1" is less than
+"3"), and "Robbie" is lexicographically less than "girl" (because "R" is less than "g", because the capital
+letters have lower ASCII/iso-8859-1/Unicode codepoints than the small letters). If the problem had specified
+"numerical" or "natural" or "Unicode collation", those would have resulted in different collation orders.
+But I'm interpreting "lexicographical" as meaning "Unicode codepoint order", which is what "lt" and "gt" do.
+
+--------------------------------------------------------------------------------------------------------------
+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 number and/or strings, in proper Perl syntax, like so:
+./ch-2.pl '([],[42],[3,2,1],[8,1164,7,3,5],[8,1164,7,5,3],["she","Bob","he","Susan"])'
+
+Output is to STDOUT and will be each array followed by its next permutation.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.16;
+   use utf8;
+   $"=', ';
+
+   # Get the "next permutation" of an array:
+   sub next_permutation {
+      # Get a copy of the original array:
+      my @array = @_;
+      # If this array is empty, it's its own "next permutation":
+      if ( 0 == scalar(@array) ) {return -2, (@array);}
+      # If this array only has one element, it's its own "next permutation":
+      if ( 1 == scalar(@array) ) {return -1, (@array);}
+      # Find the pivot, if any:
+      my $pivot = -1;
+      for my $i (reverse 0..$#array-1) {
+         if ($array[$i] lt $array[$i+1]) {
+            $pivot = $i;
+            last;
+         }
+      }
+      # If there is no pivot, this is the last permutation, so next is first:
+      if (-1 == $pivot) {return 0, (reverse @array);}
+      # Find the successor:
+      my $successor = -1;
+      for my $j (reverse $pivot+1..$#array) {
+         if ($array[$j] gt $pivot) {
+            $successor = $j;
+            last;
+         }
+      }
+      # If there is no successor, something disastrous has happened:
+      if (-1 == $successor) {return -3, ();}
+      # Swap pivot and successor:
+      my $temp = $array[$pivot];
+      $array[$pivot] = $array[$successor];
+      $array[$successor] = $temp;
+      # Reverse the suffix (the part to the right of the pivot):
+      @array[$pivot+1..$#array] = reverse @array[$pivot+1..$#array];
+      # Return next permutation:
+      return 1, (@array);
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   [1, 2, 3], # Expected output: (1, 3, 2)
+   [2, 1, 3], # Expected output: (2, 3, 1)
+   [3, 1, 2], # Expected output: (3, 2, 1)
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+for my $aref (@arrays) {
+   say '';
+   my @array = @$aref;
+   say "Array = (@array)";
+   my ($code, @next) = next_permutation(@array);
+   if    (-3 == $code) {say 'Error: no successor in subroutine "next_permutation".';}
+   elsif (-2 == $code) {say 'Warning: array is empty, so it\'s its own "next permutation".';
+                        say "\"Next\" (empty) permutation = (@next)";}
+   elsif (-1 == $code) {say 'Warning: array only has one element, so it\'s its own "next permutation".';
+                        say "\"Next\" (single-element) permutation = (@next)";}
+   elsif ( 0 == $code) {say 'Warning: array is its own last permutation, so "next" is first.';
+                        say "\"Next\" (first) permutation = (@next)";}
+   elsif ( 1 == $code) {say "Next permutation = (@next)";}
+   else                {say 'Error: invalid return code from subroutine "next_permutation".';}
+}