Merge pull request #7449 from robbie-hatley/200

Robbie Hatley's Perl solutions to Weekly Challenge #200.

4 files changed, 235 insertions, 0 deletions

diff --git a/challenge-200/robbie-hatley/README b/challenge-200/robbie-hatley/README
index 1b1dc91203..1b1dc91203 100644..100755
--- a/challenge-200/robbie-hatley/README
+++ b/challenge-200/robbie-hatley/README
diff --git a/challenge-200/robbie-hatley/blog.txt b/challenge-200/robbie-hatley/blog.txt
new file mode 100755
index 0000000000..8889821122
--- /dev/null
+++ b/challenge-200/robbie-hatley/blog.txt
@@ -0,0 +1 @@
+https://hatley-software.blogspot.com/2023/01/robbie-hatleys-perl-solutions-to-weekly_22.html
\ No newline at end of file
diff --git a/challenge-200/robbie-hatley/perl/ch-1.pl b/challenge-200/robbie-hatley/perl/ch-1.pl
new file mode 100755
index 0000000000..99f752f39b
--- /dev/null
+++ b/challenge-200/robbie-hatley/perl/ch-1.pl
@@ -0,0 +1,73 @@
+#! /usr/bin/perl
+# Robbie Hatley's Perl solution to The Weekly Challenge #200-1
+
+=pod
+
+Task 1: Arithmetic Slices
+Submitted by: Mohammad S Anwar
+You are given an array of integers. Write a script to find out all Arithmetic
+Slices for the given array of integers. An integer array is called "arithmetic"
+if it has at least 3 elements and the differences between any three
+consecutive elements are the same.
+
+Example 1:  Input: @array = (1,2,3,4)  Output: (1,2,3), (2,3,4), (1,2,3,4)
+Example 2:  Input: @array = (2)        Output: () as no slice found.
+
+=cut
+
+# IO NOTES:
+#
+# NOTE: Input is by either built-in array of arrays, or by @ARGV. If using
+#       @ARGV, input should be a space-separated list of integers, which will
+#       be interpreted as a single array.
+#
+# NOTE: Output is to stdout and will be a list of all arithmetic slice for
+#       each input array.
+
+# PRELIMINARIES:
+use v5.36;
+$,=" ";
+
+# SUBROUTINES:
+
+sub is_arith($slice_ref){
+   my @slice = @{$slice_ref};
+   my $size = scalar @slice;
+   if ( $size < 3 ) {return 0;}
+   my $init = $slice[1]-$slice[0];
+   for ( my $idx = 2 ; $idx <= $#slice ; ++$idx ){
+      if ($slice[$idx] - $slice[$idx-1] != $init) {return 0}}
+   return 1;}
+
+sub get_arith_slices($array_ref){
+   my @array = @{$array_ref};
+   my @slices = ();
+   my @arith_slices = ();
+   my $size = scalar @array;
+   my @masks = (0..((2**$size)-1));                   
+   foreach my $mask (@masks){                         # For each possible mask,
+      my @slice = ();                                 # create a slice.
+      for ( my $idx = 0 ; $idx <= $#array ; ++$idx ){ # For each index in @array,
+         my $yesno = ($mask/2**$idx)%2;               # examine corresponding binary digit in mask,
+         if ($yesno) {push @slice, $array[$idx]}}     # and do-or-don't include $array[$idx] in @slice,
+      push @slices, \@slice;}                         # depending on whether digit is 0 or 1.
+   foreach my $slice_ref (@slices){                   # But only return slices that are arithmetic.
+      if (is_arith($slice_ref)) {push @arith_slices, $slice_ref}}
+   return @arith_slices;}
+
+# DEFAULT INPUT:
+my @arrays = ([1,2,3,4],[2]);
+
+# NON-DEFAULT INPUT:
+if (@ARGV) {@arrays = ([@ARGV])}
+
+# MAIN BODY OF SCRIPT:
+for (@arrays){
+   my $array_ref = $_;
+   my @array = @{$array_ref};
+   my @arith_slices = get_arith_slices($array_ref);
+   my $num_arith_slices = scalar @arith_slices;
+   say '';
+   say "Array = (@array)";
+   say "Found $num_arith_slices arithmetic slices:";
+   for (@arith_slices) {my @slice=@{$_}; say "(@slice)";}}
\ No newline at end of file
diff --git a/challenge-200/robbie-hatley/perl/ch-2.pl b/challenge-200/robbie-hatley/perl/ch-2.pl
new file mode 100755
index 0000000000..e06aab39d2
--- /dev/null
+++ b/challenge-200/robbie-hatley/perl/ch-2.pl
@@ -0,0 +1,161 @@
+#! /usr/bin/perl
+# Robbie Hatley's Perl solution to The Weekly Challenge #200-2
+
+=pod
+
+Task 2: Seven Segment 200
+Submitted by: Ryan J Thompson
+A seven segment display is an electronic component, usually used to display
+digits. The segments are labeled 'a' through 'g' as shown:
+
+    a
+  f   b
+    g
+  e   c
+    d
+
+The encoding of each digit can thus be represented compactly as a truth table:
+my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>;
+$truth[1] would thus be "bc", indicating that the digit 1 would have segments
+"b" and "c" enabled. Write a program that accepts any [non-negative integer 
+of 1-9 digits] and draws that number as a horizontal sequence of seven-segment
+digit displays, similar to the following:
+  -------  -------  -------
+        |  |     |  |     |
+        |  |     |  |     |
+  -------
+  |        |     |  |     |
+  |        |     |  |     |
+  -------  -------  -------
+Note that each row consists of 7 lines of 9*n characters, where n is the number
+of digits to be displayed.
+
+=cut
+
+# NOTE: Input is by @ARGV and should be a single integer in the range
+#       0 to 999999999.
+
+# NOTE: Output is to stdout and will be a row of 7-segment digit displays for
+#       the digits of the input number.
+
+# PRELIMINARIES:
+use v5.36;
+
+# SUBROUTINES:
+sub display_row($x)
+{
+   my $l = length($x);
+   my @digits = split //,$x;
+   my @lines =
+   (' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l),' 'x(9*$l));
+   for ( my $idx = 0; $idx < $l ; ++$idx )
+   {
+      if ( '0' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '|     |';
+         substr $lines[2], 9*$idx+2, 7, '|     |';
+         substr $lines[3], 9*$idx+2, 7, '       ';
+         substr $lines[4], 9*$idx+2, 7, '|     |';
+         substr $lines[5], 9*$idx+2, 7, '|     |';
+         substr $lines[6], 9*$idx+2, 7, '-------';
+      }
+      elsif ( '1' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '       ';
+         substr $lines[1], 9*$idx+2, 7, '      |';
+         substr $lines[2], 9*$idx+2, 7, '      |';
+         substr $lines[3], 9*$idx+2, 7, '       ';
+         substr $lines[4], 9*$idx+2, 7, '      |';
+         substr $lines[5], 9*$idx+2, 7, '      |';
+         substr $lines[6], 9*$idx+2, 7, '       ';
+      }
+      elsif ( '2' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '      |';
+         substr $lines[2], 9*$idx+2, 7, '      |';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '|      ';
+         substr $lines[5], 9*$idx+2, 7, '|      ';
+         substr $lines[6], 9*$idx+2, 7, '-------';
+      }
+      elsif ( '3' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '      |';
+         substr $lines[2], 9*$idx+2, 7, '      |';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '      |';
+         substr $lines[5], 9*$idx+2, 7, '      |';
+         substr $lines[6], 9*$idx+2, 7, '-------';
+      }
+      elsif ( '4' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '       ';
+         substr $lines[1], 9*$idx+2, 7, '|     |';
+         substr $lines[2], 9*$idx+2, 7, '|     |';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '      |';
+         substr $lines[5], 9*$idx+2, 7, '      |';
+         substr $lines[6], 9*$idx+2, 7, '       ';
+      }
+      elsif ( '5' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '|      ';
+         substr $lines[2], 9*$idx+2, 7, '|      ';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '      |';
+         substr $lines[5], 9*$idx+2, 7, '      |';
+         substr $lines[6], 9*$idx+2, 7, '-------';
+      }
+      elsif ( '6' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '|      ';
+         substr $lines[2], 9*$idx+2, 7, '|      ';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '|     |';
+         substr $lines[5], 9*$idx+2, 7, '|     |';
+         substr $lines[6], 9*$idx+2, 7, '-------';
+      }
+      elsif ( '7' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '      |';
+         substr $lines[2], 9*$idx+2, 7, '      |';
+         substr $lines[3], 9*$idx+2, 7, '       ';
+         substr $lines[4], 9*$idx+2, 7, '      |';
+         substr $lines[5], 9*$idx+2, 7, '      |';
+         substr $lines[6], 9*$idx+2, 7, '       ';
+      }
+      elsif ( '8' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '|     |';
+         substr $lines[2], 9*$idx+2, 7, '|     |';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '|     |';
+         substr $lines[5], 9*$idx+2, 7, '|     |';
+         substr $lines[6], 9*$idx+2, 7, '-------';
+      }
+      elsif ( '9' eq $digits[$idx] )
+      {
+         substr $lines[0], 9*$idx+2, 7, '-------';
+         substr $lines[1], 9*$idx+2, 7, '|     |';
+         substr $lines[2], 9*$idx+2, 7, '|     |';
+         substr $lines[3], 9*$idx+2, 7, '-------';
+         substr $lines[4], 9*$idx+2, 7, '      |';
+         substr $lines[5], 9*$idx+2, 7, '      |';
+         substr $lines[6], 9*$idx+2, 7, '       ';
+      }
+   }
+   say for @lines;
+}
+
+# SCRIPT BODY:
+my $x = 200;
+if (@ARGV) {$x=$ARGV[0]}
+die if $x !~ m/^\d{1,9}$/;
+display_row($x);