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