From 05840b155c26bc3de273894a8d96f3cf8afb7952 Mon Sep 17 00:00:00 2001 From: Lubos Kolouch Date: Sat, 13 Feb 2021 13:36:16 +0100 Subject: Challenge 099 LK Perl --- challenge-099/lubos-kolouch/perl/ch-1.pl | 39 +++++++++++++++++++++++++++++++ challenge-099/lubos-kolouch/perl/ch-2.pl | 40 ++++++++++++++++++++++++++++++++ 2 files changed, 79 insertions(+) create mode 100644 challenge-099/lubos-kolouch/perl/ch-1.pl create mode 100644 challenge-099/lubos-kolouch/perl/ch-2.pl 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; -- cgit