Perl Weekly Challenge 200.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 200.

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.

I’m not sure about the meaning of slices. I’ll assume it means consecutive array fragments. Thus a slice is defined by its first and last index. I solve the task by producing all possible slices of three or more elements and filtering trough the number of uniq values in the array of differences. This fits a two liner:

perl -MList::Util=uniq -E '
@l=@ARGV; say "[@$_]", for grep {@m=@$_; my @d; $d[$_]=$m[$_+1]-$m[$_] for 0..@m-2; uniq(@d)==1}
map {$s=$_; map {[@l[$s..$_]]}$s+2..@l-1}(0..@l-3)
' 1 2 3 4

Results:

[1 2 3]
[1 2 3 4]
[2 3 4]

perl -MList::Util=uniq -E '
@l=@ARGV; say "[@$_]", for grep {@m=@$_; my @d; $d[$_]=$m[$_+1]-$m[$_] for 0..@m-2; uniq(@d)==1}
map {$s=$_; map {[@l[$s..$_]]}$s+2..@l-1}(0..@l-3)
' 2

Results: (none)

An example with different strides:

perl -MList::Util=uniq -E '
@l=@ARGV; say "[@$_]", for grep {@m=@$_; my @d; $d[$_]=$m[$_+1]-$m[$_] for 0..@m-2; uniq(@d)==1}
map {$s=$_; map {[@l[$s..$_]]}$s+2..@l-1}(0..@l-3)
' 1 1 2 3 4 6 8

Results:

[1 2 3]
[1 2 3 4]
[2 3 4]
[4 6 8]

The full code is almost identical

 1  # Perl weekly challenge 200
 2  # Task 1:  Arithmetic Slices
 3  #
 4  # See https://wlmb.github.io/2023/01/16/PWC200/#task-1-arithmetic-slices
 5  use v5.36;
 6  use List::Util qw(uniq);
 7  say(<<~"FIN"), exit unless @ARGV;
 8      Usage: $0 N1 [N2...]
 9      to find all arithmetic slices of the array N1 N2...
10      FIN
11  my @in=@ARGV;
12  say "The arithmetic slices of [ ", join " ", @in, "] are\n[";
13  my @results=
14      grep {
15  	my @m=@$_;
16  	my @diff;
17  	$diff[$_]=$m[$_+1]-$m[$_] for 0..@m-2;
18  	uniq(@diff)==1
19      }
20      map {
21  	my $start=$_;
22  	map {[@in[$start..$_]]}$start+2..@in-1
23      } 0..@in-3;
24  say "    [@$_]" for @results;
25  say "]";

Example:

./ch-1.pl  1 2 3 4
./ch-1.pl  2
./ch-1.pl  1 2 3 4 6 8

Results:

The arithmetic slices of [ 1 2 3 4 ] are
[
    [1 2 3]
    [1 2 3 4]
    [2 3 4]
]
The arithmetic slices of [ 2 ] are
[
]
The arithmetic slices of [ 1 2 3 4 6 8 ] are
[
    [1 2 3]
    [1 2 3 4]
    [2 3 4]
    [4 6 8]
]

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|  g  | b
   -------
   |     |
  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>;
For example, $truth[1] = ‘bc’. The digit 1 would have segments ‘b’ and ‘c’ enabled.

Write a program that accepts any decimal number and draws that number as a horizontal
sequence of ASCII seven segment displays, similar to the following:


-------  -------  -------
      |  |     |  |     |
      |  |     |  |     |
-------
|        |     |  |     |
|        |     |  |     |
-------  -------  -------
To qualify as a seven segment display, each segment must be drawn (or not drawn)
according to your @truth table.

The number "200" was of course chosen to celebrate our 200th week!

For simplicity I use numbers 0-6 instead of the letters a-g for the truth table. I make a binary mask to determine which positions in the 7×7=49 matrix of ascii characters should be turned on for each segment:

1111111000000000000000000000000000000000000000000
0000000000000100000010000000000000000000000000000
0000000000000000000000000000000000100000010000000
0000000000000000000000000000000000000000001111111
0000000000000000000000000000100000010000000000000
0000000100000010000000000000000000000000000000000
0000000000000000000001111111000000000000000000000

which correspond in decimal to

558551906910208, 34628173824, 16512, 127, 1056768, 2216203124736, 266338304

For each digit, I or the corresponding bits and map each to “ “, “-“ or “|” according to its value (0 or 1) and position (multiple of 3 or not). The code is the following:

 1  # Perl weekly challenge 200
 2  # Task 2:  Seven Segment 200
 3  #
 4  # See https://wlmb.github.io/2023/01/16/PWC200/#task-2-seven-segment-200
 5  use v5.36;
 6  say(<<~"FIN"), exit unless @ARGV;
 7      Usage: $0 N1 [N2...]
 8      to print N1, N2... as 7 segments.
 9      FIN
10  my @truth=qw(012345 12 01346 01236 1256 02356 023456 012 0123456 01256); #0-6 instead of a-g
11  # Binary masks for each segment
12  my @masks=(558551906910208, 34628173824, 16512, 127, 1056768, 2216203124736, 266338304);
13  for(@ARGV){ # for each number
14      my @lines=('')x7;
15      for(split '', $_){ # for each digit
16          my $code=0;
17          $code|=$masks[$_] for split "", $truth[$_];
18          my @bin=split "", sprintf "%049b", $code; # As binary array
19          my @bits=map {my $x=$_; [map{!$_?" ":$x%3?"|":"-"} @bin[7*$_..7*$_+6]]} (0..6);
20          $lines[$_].="  ". join "", @{$bits[$_]} for (0..6);
21      }
22      say $_ for @lines;
23  }

Example:

./ch-2.pl 200 9876543210

Results:

-------  -------  -------
      |  |     |  |     |
      |  |     |  |     |
-------
|        |     |  |     |
|        |     |  |     |
-------  -------  -------
-------  -------  -------  -------  -------           -------  -------           -------
|     |  |     |        |  |        |        |     |        |        |        |  |     |
|     |  |     |        |  |        |        |     |        |        |        |  |     |
-------  -------           -------  -------  -------  -------  -------
      |  |     |        |  |     |        |        |        |  |              |  |     |
      |  |     |        |  |     |        |        |        |  |              |  |     |
         -------           -------  -------           -------  -------           -------

I can compress the code to an ugly three and a half liner:

perl -E '
@t=qw(012345 12 01346 01236 1256 02356 023456 012 0123456 01256);@s=(558551906910208,34628173824,
16512,127,1056768,2216203124736,266338304);@l=("")x7; for(split "", shift){my $s; $s|=$s[$_] for
split "",$t[$_]; @b=split "", sprintf "%049b", $s; for my $i(0..6){$l[$i].= "  ".join "",
map{!$_?" ":$i%3?"|":"-"} @b[7*$i..7*$i+6]}}say $_ for @l;
' 9876543210

Results:

-------  -------  -------  -------  -------           -------  -------           -------
|     |  |     |        |  |        |        |     |        |        |        |  |     |
|     |  |     |        |  |        |        |     |        |        |        |  |     |
-------  -------           -------  -------  -------  -------  -------
      |  |     |        |  |     |        |        |        |  |              |  |     |
      |  |     |        |  |     |        |        |        |  |              |  |     |
         -------           -------  -------           -------  -------           -------

If I use a bit map instead of a truth table the code can be further reduced slightly.

perl -E '
@d=(63,6,91,79,102,109,125,7,127,103);@s=(558551906910208,34628173824,16512,127,1056768,2216203124736,
266338304);my @l=("")x7;for(split "", shift){$x=$d[$_];my $s;$x&(1<<$_)&&($s|=$s[$_])for 0..6;
@b=split "", sprintf "%049b", $s;for my $i(0..6){$l[$i].= "  ". join "", map{!$_?" ":$i%3?"|":"-"}
@b[7*$i..7*$i+6]}}say $_ for @l;
' 9876543210

Results:

-------  -------  -------  -------  -------           -------  -------           -------
|     |  |     |        |  |        |        |     |        |        |        |  |     |
|     |  |     |        |  |        |        |     |        |        |        |  |     |
-------  -------           -------  -------  -------  -------  -------
      |  |     |        |  |     |        |        |        |  |              |  |     |
      |  |     |        |  |     |        |        |        |  |              |  |     |
         -------           -------  -------           -------  -------           -------

Actually, it is not necessary to build the binary codes for each digit repeatedly. I can do that once:

perl -E '
@d=(63,6,91,79,102,109,125,7,127,103);@s=(558551906910208,34628173824,16512,127,1056768,2216203124736,
266338304);my @l=("")x7;for(0..9){$x=$d[$_];my $s;$x&(1<<$_)&&($s|=$s[$_])for 0..6;
say sprintf "%049b %d", $s, $s;}
'

1111111100000110000010000000100000110000011111111  560802739282175
0000000000000100000010000000000000100000010000000  34628190336
1111111000000100000011111111100000010000001111111  558586802479231
1111111000000100000011111111000000100000011111111  558586801438975
0000000100000110000011111111000000100000010000000  2251097653376
1111111100000010000001111111000000100000011111111  560768376389887
1111111100000010000001111111100000110000011111111  560768377446655
1111111000000100000010000000000000100000010000000  558586535100544
1111111100000110000011111111100000110000011111111  560803005620479
1111111100000110000011111111000000100000010000000  560803004563584

Then, I can incorporate the result in a simpler program:

perl -E '
@d=(560802739282175,34628190336,558586802479231,558586801438975,2251097653376,560768376389887,
560768377446655,558586535100544,560803005620479,560803004563584); my @l=("")x7;for(split "", shift)
{@b=split "", sprintf "%049b", $d[$_];for my $i(0..6){$l[$i].= "  ". join "", map{!$_?" ":$i%3?"|":"-"}
@b[7*$i..7*$i+6]}}say $_ for @l;
' 9876543210

Results:

-------  -------  -------  -------  -------           -------  -------           -------
|     |  |     |        |  |        |        |     |        |        |        |  |     |
|     |  |     |        |  |        |        |     |        |        |        |  |     |
-------  -------           -------  -------  -------  -------  -------
      |  |     |        |  |     |        |        |        |  |              |  |     |
      |  |     |        |  |     |        |        |        |  |              |  |     |
         -------           -------  -------           -------  -------           -------

Nevertheless, it is still too long for a one-liner.

perl -E 'say $_ for (0b111_101_000_101_111,
                     0b000_001_000_001_000,
		     0b111_001_111_100_111,
		     0b111_001_111_001_111,
		     0b000_101_111_001_000,
		     0b111_100_111_001_111,
		     0b000_100_111_101_111,
		     0b111_001_000_001_000,
		     0b111_101_111_101_111,
		     0b111_101_111_001_000)'

I can shorten it to a reasonable 2+liner using a smaller 3x5 matrix instead of a 7x7 one. Shorter, but still doesn’t fit a tweet.

perl -E '@d=(31279,520,29671,29647,3016,31183,2543,29192,31727,31688);for(@ARGV){my @l=("")x5;
for(split ""){@b=split "", sprintf "%015b", $d[$_];for my $i(0..5){$l[$i].= "  ". join "",
map{!$_?" ":$i%2?"|":"-"} @b[3*$i..3*$i+2]}}say $_ for @l};' 200 9876543210
Written on January 16, 2023