From 623bce98290cdba0b37fa6e4fda42b1222188682 Mon Sep 17 00:00:00 2001
From: Dave Jacoby <jacoby.david@gmail.com>
Date: Mon, 8 Feb 2021 23:43:05 -0500
Subject: 9 and 90 challenges...

---
 challenge-099/dave-jacoby/perl/ch-1.pl | 29 +++++++++++++++
 challenge-099/dave-jacoby/perl/ch-2.pl | 68 ++++++++++++++++++++++++++++++++++
 2 files changed, 97 insertions(+)
 create mode 100644 challenge-099/dave-jacoby/perl/ch-1.pl
 create mode 100644 challenge-099/dave-jacoby/perl/ch-2.pl

diff --git a/challenge-099/dave-jacoby/perl/ch-1.pl b/challenge-099/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..465034f599
--- /dev/null
+++ b/challenge-099/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{say signatures };
+no warnings qw{experimental};
+
+my @arr;
+push @arr, [ 'abcde', 'a*e' ];
+push @arr, [ 'abcde', 'a*d' ];
+push @arr, [ 'abcde', '?b*d' ];
+push @arr, [ 'abcde', 'a?c*e' ];
+
+for my $n (@arr) {
+    my $p = pattern_match( $n->@* );
+    say $n->[0];
+    say $n->[1];
+    say $p;
+}
+
+sub pattern_match ( $S, $P ) {
+    my $pattern = $P;
+    $pattern =~ s/\*/.*/g;
+    $pattern =~ s/\?/.?/g;
+    $pattern = qq{^$pattern\$};
+    return $S =~ /$pattern/mix ? 1 : 0;
+}
+
diff --git a/challenge-099/dave-jacoby/perl/ch-2.pl b/challenge-099/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..65ba78ecd8
--- /dev/null
+++ b/challenge-099/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,68 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use feature qw{say state signatures };
+no warnings qw{experimental};
+
+use List::Util qw{ uniq };
+
+my @arr;
+push @arr, [ 'littleit', 'lit' ];
+push @arr, [ 'london',   'lon' ];
+
+for my $n (@arr) {
+    my @p = unique_sub( $n->@* );
+    say ' ';
+    for my $o (@p) {
+        state $c = 0;
+        $c++;
+        my $string = display_sub( $n->[0], $o );
+        say qq{  $c:  $string };
+
+    }
+}
+
+sub unique_sub ( $S, $T, $p = 0, $q = 0, $done = undef ) {
+    if ( $p > length $S ) { return }
+    $done //= [];
+    my @output;
+    my $l1 = substr $S, $p, 1;
+    my $l2 = substr $T, $q, 1;
+    my $key = join '.', $done->@*;
+
+    if ( $q == length $T ) {
+        push @output, $key;
+    }
+    my $copy->@* = $done->@*;
+    push @output, unique_sub( $S, $T, $p + 1, $q, $copy );
+    if ( $l1 eq $l2 ) {
+        push $copy->@*, $p;
+        push @output, unique_sub( $S, $T, $p + 1, $q + 1, $copy );
+    }
+    return uniq sort @output;
+}
+
+sub display_sub ( $string, $key ) {
+    my @key = split /\D/, $key;
+    my %key = map { $_ => 1 } @key;
+    my $state = 0;
+    my $output;
+
+    for my $i ( 0 .. length $string ) {
+        my $l = substr( $string, $i, 1 );
+        my $k = $key{$i} || 0;
+        my $L = $k ? uc $l : $l;
+        # $output .= $L;
+
+        $output .= ' [' if $state == 0 && $k == 1;
+        $output .= '] ' if $state == 1 && $k == 0;
+        $output .= $l;
+        $state = $k;
+    }
+
+    $output .= '] ' if $state == 1;
+    $output =~ s/^\s+//mix;
+    return $output;
+}
-- 
cgit 


From fe8bf82ab0300914ba58aa60d84e16ddbf7a921d Mon Sep 17 00:00:00 2001
From: Dave Jacoby <jacoby.david@gmail.com>
Date: Tue, 9 Feb 2021 17:21:48 -0500
Subject: additions

---
 challenge-099/dave-jacoby/perl/ch-1.pl | 22 ++++++++++++++++++++--
 challenge-099/dave-jacoby/perl/ch-2.pl |  3 +--
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/challenge-099/dave-jacoby/perl/ch-1.pl b/challenge-099/dave-jacoby/perl/ch-1.pl
index 465034f599..afc18c48b7 100644
--- a/challenge-099/dave-jacoby/perl/ch-1.pl
+++ b/challenge-099/dave-jacoby/perl/ch-1.pl
@@ -21,8 +21,26 @@ for my $n (@arr) {
 
 sub pattern_match ( $S, $P ) {
     my $pattern = $P;
-    $pattern =~ s/\*/.*/g;
-    $pattern =~ s/\?/.?/g;
+
+    # this was my first pass on this part
+    # $pattern =~ s/\*/.*/g;
+    # $pattern =~ s/\?/.?/g;  
+    #
+    # a comment from Jonas Berlin (xkr47) 
+    # made me reconsider. By the rules of the
+    # task, ? is ONE character and * is MANY 
+    # CHARACTERS, but in Perl's regular 
+    # expressions, .? is ZERO OR ONE CHARACTER
+    # and .* is ZERO OR MORE CHARACTERS
+    # to get ONE OR MORE CHARACTERS, we instead
+    # use .+ and to get ONE CHARACTER, we use .
+    # 
+    # but of course, we need to match the WHOLE
+    # string, so we're matching the beginning (^)
+    # and the end ($)
+
+    $pattern =~ s/\*/.+/g;
+    $pattern =~ s/\?/./g;  
     $pattern = qq{^$pattern\$};
     return $S =~ /$pattern/mix ? 1 : 0;
 }
diff --git a/challenge-099/dave-jacoby/perl/ch-2.pl b/challenge-099/dave-jacoby/perl/ch-2.pl
index 65ba78ecd8..aabda6b46c 100644
--- a/challenge-099/dave-jacoby/perl/ch-2.pl
+++ b/challenge-099/dave-jacoby/perl/ch-2.pl
@@ -11,6 +11,7 @@ use List::Util qw{ uniq };
 my @arr;
 push @arr, [ 'littleit', 'lit' ];
 push @arr, [ 'london',   'lon' ];
+push @arr, [ 'abracadabra',   'abra' ];
 
 for my $n (@arr) {
     my @p = unique_sub( $n->@* );
@@ -53,8 +54,6 @@ sub display_sub ( $string, $key ) {
     for my $i ( 0 .. length $string ) {
         my $l = substr( $string, $i, 1 );
         my $k = $key{$i} || 0;
-        my $L = $k ? uc $l : $l;
-        # $output .= $L;
 
         $output .= ' [' if $state == 0 && $k == 1;
         $output .= '] ' if $state == 1 && $k == 0;
-- 
cgit