Robbie Hatley's Perl Solutions To The Weekly Challenge #200

For those not familiar with "The Weekly Challenge", it is a weekly programming puzzle, usually with two parts, cycling every Sunday. You can find it here:

The Weekly Challenge

This week (2023-01-15 through 2023-01-21) is weekly challenge #200.

For a change, I found this week's challenge #1 to be much more challenging than challenge #2.

Challenge #1 is: "Given an array of integers, write a script to find out all Arithmetic Slices". The problem is, these slices will come in all sizes, so a simple iterative (or nested-iterative) approach won't work. This stumped me for a long time, and I was about to resort to some complicated recursive method when it occurred to me that it's actually easy to find all subsets of a set: simply use all possible binary masks by just counting. So the function I came up with to find all arithmetic slices of an array looked like this:

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;}

Challenge #2, by contrast, I found easy: "Write a program that accepts any decimal number and draws that number as a horizontal sequence of ASCII seven segment displays." I simply made a 2D grid of characters and simply laid-out what the 7-segment displays for each of the 10 digits looks like, and wrote those patterns to appropriate slots in the grid, like so:

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;
}

That is such a no-brainer that it feels like cheating, and yet it has the visual appeal of literally being "WYSIWYG".

That's it for 200; looking forward to 201.

-- 
Cheers,
Robbie Hatley