Solve PWC200

3 files changed, 52 insertions, 0 deletions

diff --git a/challenge-200/wlmb/blog.txt b/challenge-200/wlmb/blog.txt
new file mode 100644
index 0000000000..e30e46072e
--- /dev/null
+++ b/challenge-200/wlmb/blog.txt
@@ -0,0 +1,2 @@
+https://wlmb.github.io/2023/01/16/PWC200/
+
diff --git a/challenge-200/wlmb/perl/ch-1.pl b/challenge-200/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..0a88c48eec
--- /dev/null
+++ b/challenge-200/wlmb/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 200
+# Task 1:  Arithmetic Slices
+#
+# See https://wlmb.github.io/2023/01/16/PWC200/#task-1-arithmetic-slices
+use v5.36;
+use List::Util qw(uniq);
+say(<<~"FIN"), exit unless @ARGV;
+    Usage: $0 N1 [N2...]
+    to find all arithmetic slices of the array N1 N2...
+    FIN
+my @in=@ARGV;
+say "The arithmetic slices of [ ", join " ", @in, "] are\n[";
+my @results=
+    grep {
+	my @m=@$_;
+	my @diff;
+	$diff[$_]=$m[$_+1]-$m[$_] for 0..@m-2;
+	uniq(@diff)==1
+    }
+    map {
+	my $start=$_;
+	map {[@in[$start..$_]]}$start+2..@in-1
+    } 0..@in-3;
+say "    [@$_]" for @results;
+say "]";
diff --git a/challenge-200/wlmb/perl/ch-2.pl b/challenge-200/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..1e7a9faead
--- /dev/null
+++ b/challenge-200/wlmb/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 200
+# Task 2:  Seven Segment 200
+#
+# See https://wlmb.github.io/2023/01/16/PWC200/#task-2-seven-segment-200
+use v5.36;
+say(<<~"FIN"), exit unless @ARGV;
+    Usage: $0 N1 [N2...]
+    to print N1, N2... as 7 segments.
+    FIN
+my @truth=qw(012345 12 01346 01236 1256 02356 023456 012 0123456 01256); #0-6 instead of a-g
+# Binary masks for each segment
+my @masks=(558551906910208, 34628173824, 16512, 127, 1056768, 2216203124736, 266338304);
+for(@ARGV){ # for each number
+    my @lines=('')x7;
+    for(split '', $_){ # for each digit
+        my $code=0;
+        $code|=$masks[$_] for split "", $truth[$_];
+        my @bin=split "", sprintf "%049b", $code; # As binary array
+        my @bits=map {my $x=$_; [map{!$_?" ":$x%3?"|":"-"} @bin[7*$_..7*$_+6]]} (0..6);
+        $lines[$_].="  ". join "", @{$bits[$_]} for (0..6);
+    }
+    say $_ for @lines;
+}