Add solution to 099 Pattern Match & Unique Subsequence by E. Choroba

Two different solutions are given for the Pattern Match: One
transforms the pattern into a regex, while the other really implements
the searching for the pattern character by character.

Similarly, there are two subroutines in the Unique Subsequence: One
just returns the final count of solutions, the other one enumarates
all the valid positions in the string.

3 files changed, 117 insertions, 0 deletions

diff --git a/challenge-099/e-choroba/perl/ch-1a.pl b/challenge-099/e-choroba/perl/ch-1a.pl
new file mode 100755
index 0000000000..ffd3e6075e
--- /dev/null
+++ b/challenge-099/e-choroba/perl/ch-1a.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub pattern_match {
+    my ($string, $pattern) = @_;
+    return 1 if "" eq $string . $pattern;
+
+    my ($string_first,  $string_rest)  = $string  =~ /(.)(.*)/;
+    my ($pattern_first, $pattern_rest) = $pattern =~ /(.)(.*)/;
+
+    my $action = {
+        '?' => sub {
+            return 0 unless length $pattern;
+            return pattern_match($string_rest, $pattern_rest)
+        },
+        '*' => sub {
+            for my $pos (1 .. length $string) {
+                return 1
+                    if pattern_match(substr($string, $pos), $pattern_rest);
+            }
+            return 0
+        },
+    }->{ $pattern_first // "" } || sub {
+        return 0 if ($pattern_first // "") ne ($string_first // "");
+
+        return pattern_match($string_rest, $pattern_rest)
+    };
+    return $action->()
+}
+
+use Test::More tests => 8;
+
+is pattern_match('abcde', 'a*e'),   1, 'Example 1';
+is pattern_match('abcde', 'a*d'),   0, 'Example 2';
+is pattern_match('abcde', '?b*d'),  0, 'Example 3';
+is pattern_match('abcde', 'a*c?e'), 1, 'Example 4';
+
+is pattern_match('abcde', 'a*'),    1, 'Trailing star';
+is pattern_match('abcde', '*de'),   1, 'Leading star';
+is pattern_match('abcde', 'a*c*e'), 1, 'Two stars';
+is pattern_match('(a!)b{c}$1d', '(?!)b{?}$1*'), 1, 'Random garbage';
diff --git a/challenge-099/e-choroba/perl/ch-1b.pl b/challenge-099/e-choroba/perl/ch-1b.pl
new file mode 100755
index 0000000000..46a0adc6e0
--- /dev/null
+++ b/challenge-099/e-choroba/perl/ch-1b.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub pattern_match {
+    my ($string, $pattern) = @_;
+    $pattern = quotemeta $pattern;
+    s/\\\?/./g, s/\\\*/.*/g for $pattern;
+    return $string =~ /^$pattern$/ ? 1 : 0
+}
+
+use Test::More tests => 8;
+
+is pattern_match('abcde', 'a*e'),   1, 'Example 1';
+is pattern_match('abcde', 'a*d'),   0, 'Example 2';
+is pattern_match('abcde', '?b*d'),  0, 'Example 3';
+is pattern_match('abcde', 'a*c?e'), 1, 'Example 4';
+
+is pattern_match('abcde', 'a*'),  1, 'Trailing star';
+is pattern_match('abcde', '*de'), 1, 'Leading star';
+is pattern_match('abcde', 'a*c*e'), 1, 'Two stars';
+is pattern_match('(a!)b{c}$1d', '(?!)b{?}$1*'), 1, 'No injection';
diff --git a/challenge-099/e-choroba/perl/ch-2.pl b/challenge-099/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..d32a396c8d
--- /dev/null
+++ b/challenge-099/e-choroba/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# Count the subsequences.
+sub unique_subsequence {
+    my ($string, $subsequence) = @_;
+    if (1 == length $subsequence) {
+        my $count = () = $string =~ /\Q$subsequence/g;
+        return $count
+    }
+    my $char = substr $subsequence, 0, 1, "";
+    my ($count, $pos) = (0, 0);
+    $count += unique_subsequence(substr($string, $pos++), $subsequence)
+        while -1 != ($pos = index $string, $char, $pos);
+    return $count
+}
+
+# Return all the possible positions that match the subsequence.
+sub show_unique_subsequence {
+    my ($string, $subsequence) = @_;
+    my @solutions;
+    for my $sub_pos (0 .. length($subsequence) - 1) {
+        my $sub_char = substr $subsequence, $sub_pos, 1;
+        my $str_pos = 0;
+        my @partial;
+        push @partial, $str_pos++
+            while -1 != ($str_pos = index $string, $sub_char, $str_pos);
+        @solutions = map {
+            my $solution = $_;
+            map { $_ > $solution->[-1] ? [@$solution, $_] : () } @partial;
+        } @solutions;
+        @solutions = map [$_], @partial unless @solutions;  # First character.
+    }
+    return \@solutions
+}
+
+use Test::More tests => 6;
+
+is unique_subsequence('littleit', 'lit'), 5, 'Example 1';
+is unique_subsequence('london', 'lon'), 3, 'Example 2';
+is unique_subsequence('london', 'par'), 0, 'Zero';
+
+
+is_deeply show_unique_subsequence('littleit', 'lit'),
+          [[0, 1, 2], [0, 1, 3], [0, 1, 7], [0, 6, 7], [4, 6, 7]],
+          'Show Example 1';
+
+is_deeply show_unique_subsequence('london', 'lon'),
+          [[0, 1, 2], [0, 1, 5], [0, 4, 5]],
+          'Show Example 2';
+
+is_deeply show_unique_subsequence('london', 'par'), [], 'Show Zero';