Task 1 & 2

2 files changed, 93 insertions, 0 deletions

diff --git a/challenge-099/perlboy1967/perl/ch-1.pl b/challenge-099/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..bfda6727bf
--- /dev/null
+++ b/challenge-099/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 099
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-099/
+#
+# Task 1 - Pattern Match
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+# Unbuffered STDOUT
+$|++;
+
+@ARGV = ('abcde', 'a*c?e')
+  unless (scalar(@ARGV) == 2);
+
+my ($S, $P) = @ARGV;
+
+my $RE = $P;
+$RE =~ s#([\*\?])#.$1#g;
+
+printf "Input: \$S = '%s', \$P = '%s'\n", $S, $P;
+printf "Output: %d\n", ($S =~ m#^($RE)$# ? 1 : 0);
diff --git a/challenge-099/perlboy1967/perl/ch-2.pl b/challenge-099/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..f8f8b572c1
--- /dev/null
+++ b/challenge-099/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+# Perl Weekly Challenge - 099
+# - https://perlweeklychallenge.org/blog/perl-weekly-challenge-099/
+#
+# Task 2 - Unique Subsequence
+#
+# Author: Niels 'PerlBoy' van Dijke
+
+use v5.16;
+use strict;
+use warnings;
+
+use Algorithm::Combinatorics qw(variations_with_repetition);
+use List::Util qw(sum);
+use Data::Printer;
+
+# Unbuffered STDOUT
+$|++;
+
+@ARGV = ('this is a challenge', 'hisen')
+  unless (scalar(@ARGV) == 2);
+
+my ($S, $T) = @ARGV;
+
+my $l = length($T);
+my @L = (1 .. $l);
+
+my @U;
+
+# I admit... difficult way to find substrings of '$T'
+# I think it pays off when '$T' becomes longer
+foreach my $cCount (1 .. $l) {
+  my $v = variations_with_repetition(\@L,$cCount);
+
+  while (my $a = $v->next) {
+    next unless sum(@$a) == $l;
+  
+    my $re1 = sprintf('^(%s)$', join(')(', map { ".{$_}" } @$a));
+    $T =~ m#$re1#;
+
+    my @substrings = map {substr($T, $-[$_], $+[$_]-$-[$_]) } (1 .. scalar(@+) - 1);
+
+    my $i = 0;
+    my $re2 = sprintf("%s(?<s%d>.*?)", 
+                  join('', map { sprintf("(?<s%d>.*?)(?<t%d>$_)", $i++, $i++) } @substrings),
+                  $i);
+    
+    while ($S =~ m#$re2#g) {
+      my %m = %+;
+      my ($pre,$post) = ($`, $');
+
+      my @s;
+      foreach my $k (keys %+) {
+        if ($k =~ m#^(.)(\d+)#) { 
+          $s[$2] = ($1 eq 's' ? $m{$k} : sprintf("[%s]",$m{$k}));
+        }
+      }
+
+      push(@U, join('', $pre // '', @s, $post // ''));
+    }
+  }
+
+}
+printf "Input: \$S = '%s', \$T = '%s'\n", $S, $T;
+printf "Output: %d\n", scalar(@U);
+p @U;