Merge pull request #3509 from LubosKolouch/master

Challenge 099 LK Perl

2 files changed, 79 insertions, 0 deletions

diff --git a/challenge-099/lubos-kolouch/perl/ch-1.pl b/challenge-099/lubos-kolouch/perl/ch-1.pl
new file mode 100644
index 0000000000..34d56af204
--- /dev/null
+++ b/challenge-099/lubos-kolouch/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-1.pl
+#
+#        USAGE: ./ch-1.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge
+#               https://www.perlweeklychallenge.org
+#               Task 1 - Pattern Match
+#
+#       AUTHOR: YOUR NAME (), 
+#      CREATED: 02/13/2021 12:22:27 PM
+#===============================================================================
+
+use strict;
+use warnings;
+
+sub pattern_match {
+    my $what = shift;
+
+    # convert the pattern to regex
+    $what->{p} =~ s/\?/./g;
+    $what->{p} =~ s/\*/.*/g;
+    $what->{p} = '^'.$what->{p}.'$';
+
+    my $match = $what->{s} =~ /$what->{p}/;
+    return 0 unless $match;
+    return 1;
+}
+
+use Test::More;
+
+is(pattern_match({'s' => 'abcde', 'p' => 'a*e'}), 1);
+is(pattern_match({'s' => 'abcde', 'p' => 'a*d'}), 0);
+is(pattern_match({'s' => 'abcde', 'p' => '?b*d'}), 0);
+is(pattern_match({'s' => 'abcde', 'p' => 'a*c?e'}), 1);
+
+done_testing;
diff --git a/challenge-099/lubos-kolouch/perl/ch-2.pl b/challenge-099/lubos-kolouch/perl/ch-2.pl
new file mode 100644
index 0000000000..450e3576c7
--- /dev/null
+++ b/challenge-099/lubos-kolouch/perl/ch-2.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-2.pl
+#
+#        USAGE: ./ch-2.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge
+#               https://www.perlweeklychallenge.org
+#               Task 1 - Unique Subsequence
+#
+#       AUTHOR: Lubos Kolouch
+#      CREATED: 02/13/2021 12:22:27 PM
+#===============================================================================
+
+use strict;
+use warnings;
+use feature qw/say/;
+
+#FIXME: This does not work
+
+sub unique_subsequences {
+    my $what = shift;
+
+    # let's change the pattern a bit
+    my $mod_pattern = $what->{t};
+    $mod_pattern =~ s/(.)/$1\(\?=.*/g;
+    $mod_pattern .= ')' x length($what->{t});
+    say $mod_pattern;
+
+    my @matches = ($what->{s} =~ m/($mod_pattern)/g);
+    say for @matches;
+    say scalar @matches;
+    return 1;
+}
+
+use Test::More;
+is(unique_subsequences({'s' => 'littleit', 't' => 'lit'}), 1);
+
+done_testing;