Solve PWC190

3 files changed, 65 insertions, 0 deletions

diff --git a/challenge-190/wlmb/blog.txt b/challenge-190/wlmb/blog.txt
new file mode 100644
index 0000000000..b26859dcd3
--- /dev/null
+++ b/challenge-190/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io//2022/11/07/PWC190.org
diff --git a/challenge-190/wlmb/perl/ch-1.pl b/challenge-190/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..a5b52f2cd9
--- /dev/null
+++ b/challenge-190/wlmb/perl/ch-1.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 190
+# Task 1:  Capital Detection
+#
+# See https://wlmb.github.io/2022/11/07/PWC190/#task-1-capital-detection
+use v5.36;
+use List::Util qw(any);
+die <<"EOF" unless @ARGV;
+Usage: $0 W1 [W2...]
+to test appropriate case for the words W1, W2,...
+EOF
+for my $word(@ARGV){
+    say "$word -> ",
+    (any {$word eq $_} lc $word, uc $word, ucfirst lc $word)
+    ? "appropriate": "inappropriate"}
diff --git a/challenge-190/wlmb/perl/ch-2.pl b/challenge-190/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..a91f330b1a
--- /dev/null
+++ b/challenge-190/wlmb/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 190
+# Task 2:  Decoded List
+#
+# See https://wlmb.github.io/2022/11/07/PWC190/#task-2-decoded-list
+use v5.36;
+use experimental qw(try);
+die <<"EOF" unless @ARGV;
+Usage: $0 N1 [N2...]
+to decode the numbers N1, N2...
+EOF
+my @letters=("", "A".."Z"); # Base 1 array of ascii letters
+sub iterator($n){ #Create an iterator for all decodings of the number $n
+    my $counter=0;
+    my $length=length $n; # number of digits
+    my @digits0=split "", $n;
+    sub {
+        COUNTER: while($counter<2**$length){
+            my @digits=@digits0; # copy digits
+            my @bits=split "",
+                my $bits=sprintf "%0.${length}b", $counter++; # convert to binary, advance counter
+            next COUNTER if $bits=~/11/; # Don't stick more than 2 consecutive letters
+            my @output;
+            while(@bits && @digits){
+                my $bit=pop @bits;
+                next COUNTER if @digits<2 && $bit==1; # Not enough digits to join
+                splice(@digits,-2,2,$digits[-2].$digits[-1]),next if $bit==1; # Join last two digits
+                unshift @output, my $m=pop @digits if $bit==0; # or pop last number
+                next COUNTER if $m==0 or $m>=@letters; # Number too large or too small, restart
+            }
+            return @letters[@output]; # Found a decoding. Convert numbers to letters and return them
+        }
+        (); # Didn't find another decoding, return a null list
+    }
+}
+for(@ARGV){
+    try {
+	die "Only digits allowed: $_" unless /^\d*$/;
+        die "Empty input" unless /./;
+	my $it=iterator($_);
+	print "$_ -> ";
+	my @decoded;
+	print @decoded," " while(@decoded=$it->()); # Print all possible decodings
+	say "";
+    }
+    catch($m){
+        say "Error: $m";
+    }
+}