Merge pull request #11923 from robbie-hatley/rh318

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

3 files changed, 252 insertions, 0 deletions

diff --git a/challenge-318/robbie-hatley/blog.txt b/challenge-318/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..46717e80ee
--- /dev/null
+++ b/challenge-318/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/04/robbie-hatleys-solutions-in-perl-for_23.html
\ No newline at end of file
diff --git a/challenge-318/robbie-hatley/perl/ch-1.pl b/challenge-318/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..6d7cda27a8
--- /dev/null
+++ b/challenge-318/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,104 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 318-1,
+written by Robbie Hatley on Wed Apr 23, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 318-1: Task 1: Group Position
+Submitted by: Mohammad Sajid Anwar
+You are given a string of lowercase letters. Write a script to
+find the position of all groups in the given string. Three or
+more consecutive letters form a group. Return "" if none found.
+
+Example #1:
+Input: $str = "abccccd"
+Output: "cccc"
+
+Example #2:
+Input: $str = "aaabcddddeefff"
+Output: "aaa", "dddd", "fff"
+
+Example #3:
+Input: $str = "abcdd"
+Output: ""
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+I find the examples (which print group contents) to contradict the problem description (which asks for group
+indexes). So I'll write a sub that gives both. All groups of 3+ contiguous identical characters in a string
+can be found by matching the string to regexp "(.)\1{2,}" using the "m//" operator in scalar context in a
+while loop. Then for each match $m I'll get its index $i within the string using "index", set next offset to
+$i+1 (to start next index search one-past previous), and push ordered pair [$m,$i] to the output array.
+After all matches (if any) have been found, I'll simply return the output array.
+
+--------------------------------------------------------------------------------------------------------------
+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 double-quoted strings of any characters, in proper Perl syntax, like so:
+
+./ch-1.pl '("01101010001011011100101000","ppiiiiigg","茶銀銀金銀銀銀金茶茶銀銀銀金金金金茶茶茶")'
+
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8::all;
+
+   # Find all places where a single-character group is immediately
+   # followed by 2-or-more copies of itself. For each such case,
+   # push to an output array an ordered pair consisting of
+   # [match,index]. Then return the output array.
+   sub group_position ($x) {
+      my @o = () ; # Output array.
+      my $m = '' ; # Match.
+      my $i =  0 ; # Index of match.
+      my $o =  0 ; # Offset for indexing.
+      while ($x =~ m/(.)\1{2,}/g){ # For each group of 3+:
+         $m = $&;              # Match.
+         $i = index($x,$m,$o); # Index.
+         $o = $i + 1; # Start next index search past last match.
+         push @o,[$m,$i]}      # Push [$m,$i] to @o.
+      @o}                      # Return @o.
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @strings = @ARGV ? eval($ARGV[0]) :
+(
+   # Input:          # Expected output:
+
+   "abccccd",        # cccc at index 2
+
+   "aaabcddddeefff", # aaa at index 0
+                     # dddd at index 5
+                     # fff at index 11
+
+   "abcdd"           # none
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+foreach my $string (@strings) {
+   say '';
+   my @matches = group_position($string);
+   say "String = \"$string\"";
+   say "Clusters of 3+ contiguous identical characters found:";
+   if (0 == scalar @matches) {
+      say "none";
+   }
+   else {
+      for (@matches) {
+         say "$_->[0] at index $_->[1]";
+      }
+   }
+}
diff --git a/challenge-318/robbie-hatley/perl/ch-2.pl b/challenge-318/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..d473da0b3e
--- /dev/null
+++ b/challenge-318/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,147 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 318-2,
+written by Robbie Hatley on Wed Apr 23, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 318-2: Reverse Equals
+Submitted by: Roger Bell_West
+You are given two arrays of integers, each containing the same
+elements as the other. Write a script to return true if one array
+can be made to equal the other by reversing exactly one
+contiguous subarray.
+
+Example #1:
+Input: @source = (3, 2, 1, 4)
+       @target = (1, 2, 3, 4)
+Output: true
+Reverse elements: 0-2
+
+Example #2:
+Input: @source = (1, 3, 4)
+       @target = (4, 1, 3)
+Output: false
+
+Example #3:
+Input: @source = (2)
+       @target = (2)
+Output: true
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+The only approach I can see is to laboriously reverse each subarray of array 1 and see if the altered array 1
+now equals array 2.
+
+--------------------------------------------------------------------------------------------------------------
+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. Each inner pair of arrays
+should have the same elements (though possibly in different orders). For example:
+
+./ch-2.pl '([[2,4,8,6,10,12],[2,4,6,8,10,12]],[[1,8,3,6,5,7,4,2],[1,2,3,4,5,6,7,8]])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8::all;
+
+   # Do two arrays of integers have the same elements?
+   sub same_elements ($aref1, $aref2) {
+      return 0 if 'ARRAY' ne ref $aref1;
+      return 0 if 'ARRAY' ne ref $aref2;
+      my $m = scalar @$aref1;
+      my $n = scalar @$aref2;
+      return 0 if $m != $n;
+      return 1 if 0 == $m && 0 == $n;
+      my @sorted1 = sort {$a<=>$b}  @$aref1;
+      my @sorted2 = sort {$a<=>$b}  @$aref2;
+      for (0..$m-1){
+         return 0 if $sorted1[$_] != $sorted2[$_];
+      }
+      return 1;
+   }
+
+   # Are two arrays of integers equal?
+   sub are_equal ($aref1, $aref2) {
+      return 0 if 'ARRAY' ne ref $aref1;
+      return 0 if 'ARRAY' ne ref $aref2;
+      my $m = scalar @$aref1;
+      my $n = scalar @$aref2;
+      return 0 if $m != $n;
+      return 1 if 0 == $m && 0 == $n;
+      for (0..$m-1){
+         return 0 if $$aref1[$_] != $$aref2[$_];
+      }
+      return 1;
+   }
+
+   # Can one array of integers be made equal to another by
+   # reversing exactly 1 contiguous subarray?
+   sub reverse_equals ($aref1, $aref2) {
+      # For "equality through reversal" to be possible,
+      # the two arrays must have the same elements:
+      return 'False.' unless same_elements($aref1, $aref2);
+      # For two identical arrays, the target can be made from
+      # the source by reversing any length 0 or 1 subarray:
+      return 'True.' if are_equal($aref1, $aref2);
+      # Now look at each reversible subarray of @$aref1;
+      # if we reverse it, will @$aref1 be equal to @$aref2?
+      my $m = scalar(@$aref1);
+      for    ( my $i = 0 ; $i <= $m-2  ; ++$i ) {
+         for ( my $s = 2 ; $s <= $m-$i ; ++$s ) {
+            my @altered;
+            push @altered, @$aref1[0..$i-1];
+            push @altered, @$aref1[reverse $i..$i+$s-1];
+            push @altered, @$aref1[$i+$s..$m-1];
+            if (are_equal(\@altered,$aref2)) {return 'True.'}
+         }
+      }
+      return 'False.';
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Inputs for Example #1:
+   [
+      [3, 2, 1, 4],
+      [1, 2, 3, 4],
+   ],
+   # Expected output: true
+
+   # Inputs for Example #2:
+   [
+      [1, 3, 4],
+      [4, 1, 3],
+   ],
+   # Expected output: false
+
+   # Inputs for Example #3:
+   [
+      [2],
+      [2],
+   ],
+   # Expected output: true
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   say "Source array = (@{$$aref[0]})";
+   say "Target array = (@{$$aref[1]})";
+   my $answer = reverse_equals($$aref[0], $$aref[1]);
+   say "Can make target from source by reversing 1 subarray? $answer";
+}