Merge pull request #11573 from robbie-hatley/rh308

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

3 files changed, 201 insertions, 0 deletions

diff --git a/challenge-308/robbie-hatley/blog.txt b/challenge-308/robbie-hatley/blog.txt
new file mode 100644
index 0000000000..6b0e209d19
--- /dev/null
+++ b/challenge-308/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2025/02/robbie-hatleys-solutions-in-perl-for_12.html
\ No newline at end of file
diff --git a/challenge-308/robbie-hatley/perl/ch-1.pl b/challenge-308/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..d61feaf217
--- /dev/null
+++ b/challenge-308/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,108 @@
+#!/usr/bin/env -S perl -C63
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 308-1,
+written by Robbie Hatley on Mon Feb 10, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 308-1: Count Common
+Submitted by: Mohammad Sajid Anwar
+You are given two array of strings, @str1 and @str2. Write a
+script to return the count of common strings in both arrays.
+
+Example #1:
+Input: @str1 = ("perl", "weekly", "challenge")
+       @str2 = ("raku", "weekly", "challenge")
+Output: 2
+
+Example #2:
+Input: @str1 = ("perl", "raku", "python")
+       @str2 = ("python", "java")
+Output: 1
+
+Example #3:
+Input: @str1 = ("guest", "contribution")
+       @str2 = ("fun", "weekly", "challenge")
+Output: 0
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+For each set of strings I'll make a hash counting occurrences. Then I'll make a (sorted, deduped) "combined"
+string set from the two originals. Then I'll push any element of @combined which has greater-than-zero
+occurrences in both original string sets to an array "@common" and return 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 two arrays of double-quoted strings, in proper Perl syntax:
+./ch-1.pl '([["Bob","Sam","Steve"],["Bill","Susan","Bob"]],[["兔","狗","猫"],["猫","猪","狗"]])'
+
+Output is to STDOUT and will be each pair of string sets followed by the corresponding set of items in-common.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   use utf8;
+   use List::Util qw( uniq );
+   no warnings "uninitialized";
+   # What strings do a pair of string sets have in-common?
+   sub common ($aref1, $aref2) {
+      my %occurrences1; for (@$aref1) {++$occurrences1{$_}}
+      my %occurrences2; for (@$aref2) {++$occurrences2{$_}}
+      my @combined = uniq sort (@$aref1, @$aref2);
+      my @common = ();
+      for (@combined) {
+         if ($occurrences1{$_} > 0 && $occurrences2{$_} > 0) {
+            push @common, $_;
+         }
+      }
+      return @common;
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example #1 inputs:
+   [
+      ["perl", "weekly", "challenge"],
+      ["raku", "weekly", "challenge"],
+   ],
+   # Expected output: 2
+
+   # Example #2 inputs:
+   [
+      ["perl", "raku", "python"],
+      ["python", "java"],
+   ],
+   # Expected output: 1
+
+   # Example #3 inputs:
+   [
+      ["guest", "contribution"],
+      ["fun", "weekly", "challenge"],
+   ],
+   # Expected output: 0
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   my $aref1 = $aref->[0];
+   my $aref2 = $aref->[1];
+   my @common = common($aref1,$aref2);
+   my $n = scalar(@common);
+   say "First  string set = (@$aref1)";
+   say "Second string set = (@$aref2)";
+   say "Found $n common strings:";
+   say "Common string set = (@common)";
+}
diff --git a/challenge-308/robbie-hatley/perl/ch-2.pl b/challenge-308/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..6215427304
--- /dev/null
+++ b/challenge-308/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/env perl
+
+=pod
+
+--------------------------------------------------------------------------------------------------------------
+TITLE AND ATTRIBUTION:
+Solutions in Perl for The Weekly Challenge 308-2,
+written by Robbie Hatley on Mon Feb 10, 2025.
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM DESCRIPTION:
+Task 308-2: Decode XOR
+Submitted by: Mohammad Sajid Anwar
+You are given an encoded array and an initial integer. Write a
+script to find the original array that produced the given
+encoded array. It was encoded such that
+encoded[i] = orig[i] XOR orig[i + 1].
+
+Example #1:
+Input: @encoded = (1, 2, 3), $initial = 1
+Output: (1, 0, 2, 1)
+Encoded array created like below, if the original array was (1, 0, 2, 1)
+$encoded[0] = (1 xor 0) = 1
+$encoded[1] = (0 xor 2) = 2
+$encoded[2] = (2 xor 1) = 3
+
+Example #2:
+Input: @encoded = (6, 2, 7, 3), $initial = 4
+Output: (4, 2, 0, 7, 4)
+
+--------------------------------------------------------------------------------------------------------------
+PROBLEM NOTES:
+Though the problem description does not specify whether "XOR" refers to "logical XOR" or "bit-wise XOR",
+the examples make it clear that "XOR" means "the decimal representation of the bit-wise XOR of the binary
+representations of two small non-negative decimal integers". I say "small" and "non-negative" because
+otherwise there is no unambiguous meaning to Perl expression "$a ^ $b". So I'll make the stipulation in my
+program that all numbers involved must be "small non-negative integers in the closed interval [0,255]".
+In that case, if we let $c = $a ^ $b, then $c ^ $b == $a and $c ^ $a == $b, by the rules of how "XOR" works.
+So, given the initial (index 0) element of the original, we can then easily recreate the rest of the original
+by letting each subsequent $orig[i] = $orig[i-1] ^ $encoded[i-1].
+
+--------------------------------------------------------------------------------------------------------------
+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 0 <= $x <= 255, in proper Perl syntax. The first value of each
+inner array will be construed as the initial value of an "original" array, and the remaining elements will be
+construed as the XOR-encoded version of the original array. For example:
+./ch-2.pl '([17,54,209,73,0,137],[222,8,0,187,44,201])'
+
+Output is to STDOUT and will be each input followed by the corresponding output.
+
+=cut
+
+# ------------------------------------------------------------------------------------------------------------
+# PRAGMAS, MODULES, AND SUBS:
+
+   use v5.36;
+   # Given an initial value and an encoded array,
+   # reconstruct what the initial array must have been:
+   sub reconstruct ($initial, @encoded) {
+      my @reconstructed = ($initial);
+      for (@encoded) {
+         push @reconstructed, ($_ ^ $reconstructed[-1]);
+      }
+      return @reconstructed;
+   }
+
+# ------------------------------------------------------------------------------------------------------------
+# INPUTS:
+my @arrays = @ARGV ? eval($ARGV[0]) :
+(
+   # Example 1 input:
+   [1, 1, 2, 3],
+   # Expected output: (1, 0, 2, 1)
+
+   # Example 2 input:
+   [4, 6, 2, 7, 3],
+   # Expected output: (4, 2, 0, 7, 4)
+);
+
+# ------------------------------------------------------------------------------------------------------------
+# MAIN BODY OF PROGRAM:
+$"=', ';
+for my $aref (@arrays) {
+   say '';
+   my @encoded  = @$aref;
+   my $initial  = shift @encoded;
+   my @original = reconstruct($initial, @encoded);
+   say "Encoded  array = (@encoded)";
+   say "Initial  value = $initial";
+   say "Original array = (@original)";
+}