Merge pull request #3487 from wlmb/challenges

Solutions to ch. 99

3 files changed, 53 insertions, 0 deletions

diff --git a/challenge-099/wlmb/blog.txt b/challenge-099/wlmb/blog.txt
new file mode 100644
index 0000000000..a44a320332
--- /dev/null
+++ b/challenge-099/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/02/08/PWC099/
diff --git a/challenge-099/wlmb/perl/ch-1.pl b/challenge-099/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..8dc4f05eba
--- /dev/null
+++ b/challenge-099/wlmb/perl/ch-1.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 099
+# Task 1: Pattern match
+#
+# See https://wlmb.github.io/2021/02/08/PWC099/#task-1-pattern-match
+  use warnings;
+  use strict;
+  use v5.12;
+
+  my ($S, $P0)=@ARGV;
+  my $P=quotemeta $P0; # quote anything suspicious
+  $P=~s/^\\\*/.*/; # Replace originally unquoted asterisks
+  $P=~s/([^\\])\\\*/$1.*/g;
+  $P=~s/\\\\\*/\*/g; #Replace originally quoted asterisks
+  $P=~s/^\\\?/./; # Replace originally unquoted question marks
+  $P=~s/([^\\])\\\?/$1./g;
+  $P=~s/\\\\\?/\?/g; #Replace originally quoted question marks
+  say "Input: \$S=\"$S\" \$P=\"$P0\"\nOutput: ", $S=~/^$P$/?1:0;
diff --git a/challenge-099/wlmb/perl/ch-2.pl b/challenge-099/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..5161cbcf61
--- /dev/null
+++ b/challenge-099/wlmb/perl/ch-2.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 099
+# Task 2: unique subsequence
+#
+# See https://wlmb.github.io/2021/02/08/PWC099/#task-2-unique-subsequence
+
+
+  use warnings;
+  use strict;
+  use v5.12;
+  use Memoize;
+
+  memoize qw(sequences);
+  my ($S, $T)=@ARGV;
+  my @sequences=sequences($S, $T);
+  say "Input: \$S=\"$S\", \$T=\"$T\"";
+  say "Output: ", scalar @sequences;
+  say "$_: $sequences[$_-1]" for (1..@sequences);
+  sub sequences { #Recursively find all matches of $S to $T
+      my ($S, $T)=@_;
+      return ("$S") if $T=~/^$/; #nothing more to match
+      return () if $S=~/^$/; #end of string without match
+      my ($firstS, $firstT)=map {escape(substr $_,0,1)} $S, $T;
+      my ($restS, $restT)=map {substr $_,1} $S, $T;
+      my @sequences=();
+      @sequences=(map {"[$firstS]$_"} sequences($restS, $restT)) if $firstS eq $firstT;
+      @sequences=(@sequences, map {"$firstS$_"} sequences($restS, $T));
+      return @sequences;
+  }
+  sub escape { #Escape brackets
+      my $string=shift;
+      $string=~s/([][])/\\$1/g;
+      return $string;
+  }