# Perl Weekly Challenge 99.

My solutions (task 1 and task 2) to the The Weekly Challenge - 099.

You are given a string `\$S` and a pattern `\$P`.

Write a script to check if given pattern validate the entire string. Print 1 if pass otherwise 0.

The patterns can also have the following characters:

? - Match any single character.

* - Match any sequence of characters.

Example 1:

``````Input: \$S = "abcde" \$P = "a*e"
Output: 1
``````

Example 2:

``````Input: \$S = "abcde" \$P = "a*d"
Output: 0
``````

Example 3:

``````Input: \$S = "abcde" \$P = "?b*d"
Output: 0
``````

Example 4:

``````Input: \$S = "abcde" \$P = "a*c?e"
Output: 1
``````

I solve the problem by replacing the pattern by a perl’s regular expression: I add a start of string `^` and end of string `\$` markers, and I replaced `?` and `*` by `.` and `.*` . Then I ask perl to match the resulting regular expression. This may be done in a oneliner:

``````perl -E '(\$S, \$P0)=@ARGV; \$P=\$P0; \$P=~s/\*/.*/g; \$P=~s/\?/./g;' \
-E 'say "Input: \\$S=\"\$S\" \\$P=\"\$P0\"\nOutput: ", \$S=~/^\$P\$/?1:0' "abcde" "a*e"
perl -E '(\$S, \$P0)=@ARGV; \$P=\$P0; \$P=~s/\*/.*/g;' \
-E 'say "Input: \\$S=\"\$S\" \\$P=\"\$P0\"\nOutput: ", \$S=~/^\$P\$/?1:0' "abcde" "a*d"
perl -E '(\$S, \$P0)=@ARGV; \$P=\$P0; \$P=~s/\*/.*/g;' \
-E 'say "Input: \\$S=\"\$S\" \\$P=\"\$P0\"\nOutput: ", \$S=~/^\$P\$/?1:0' "abcde" "?b*d"
perl -E '(\$S, \$P0)=@ARGV; \$P=\$P0; \$P=~s/\*/.*/g;' \
-E 'say "Input: \\$S=\"\$S\" \\$P=\"\$P0\"\nOutput: ", \$S=~/^\$P\$/?1:0' "abcde" "a*c?e"
``````

Results:

``````Input: \$S="abcde" \$P="a*e"
Output: 1
Input: \$S="abcde" \$P="a*d"
Output: 0
Input: \$S="abcde" \$P="?b*d"
Output: 0
Input: \$S="abcde" \$P="a*c?e"
Output: 1
``````

Notice that the code would fail if `\$P` contains magical regexp characters. Thus in the full solution, I escape out any suspicious character and allow quoted asterisks and question marks.

``````# Perl weekly challenge 099
#
use warnings;
use strict;
use v5.12;

my (\$S, \$P0)=@ARGV;
my \$P=quotemeta \$P0; # quote anything suspicious
\$P=~s/^\\\*/.*/; # Replace originally unquoted asterisks
\$P=~s/([^\\])\\\*/\$1.*/g;
\$P=~s/\\\\\*/\*/g; #Replace originally quoted asterisks
\$P=~s/^\\\?/./; # Replace originally unquoted question marks
\$P=~s/([^\\])\\\?/\$1./g;
\$P=~s/\\\\\?/\?/g; #Replace originally quoted question marks
say "Input: \\$S=\"\$S\" \\$P=\"\$P0\"\nOutput: ", \$S=~/^\$P\$/?1:0;
``````

Examples 1-4:

``````./ch-1.pl "abcde" "a*e"
./ch-1.pl "abcde" "a*d"
./ch-1.pl "abcde" "?b*d"
./ch-1.pl "abcde" "a*c?e"
``````

Results:

``````Input: \$S="abcde" \$P="a*e"
Output: 1
Input: \$S="abcde" \$P="a*d"
Output: 0
Input: \$S="abcde" \$P="?b*d"
Output: 0
Input: \$S="abcde" \$P="a*c?e"
Output: 1
``````

Examples with escaped asterisks and question marks;

``````./ch-1.pl "abc*def" "a*\**f"
./ch-1.pl "abcdef" "a*\**f"
./ch-1.pl "ab?de" "a?\??e"
./ch-1.pl "abcde" "a?\??d"
``````

Results:

``````Input: \$S="abc*def" \$P="a*\**f"
Output: 1
Input: \$S="abcdef" \$P="a*\**f"
Output: 0
Input: \$S="ab?de" \$P="a?\??e"
Output: 1
Input: \$S="abcde" \$P="a?\??d"
Output: 0
``````

Examples with unintended regexp char. Not being a true regexp, the dot should not have its regexp meaning, it should only match itself.

``````./ch-1.pl "a.c" "a.c"
./ch-1.pl "abc" "a.c"
``````

Results:

``````Input: \$S="a.c" \$P="a.c"
Output: 1
Input: \$S="abc" \$P="a.c"
Output: 0
``````

You are given two strings \$S and \$T.

Write a script to find out count of different unique subsequences matching \$T without changing the position of characters.

Example 1:

``````Input: \$S = "littleit', \$T = 'lit'
Output: 5

1: [lit] tleit
2: [li] t [t] leit
3: [li] ttlei [t]
4: litt [l] e [it]
5: [l] ittle [it]
``````

Example 2:

``````Input: \$S = "london', \$T = 'lon'
Output: 3

1: [lon] don
2: [lo] ndo [n]
3: [l] ond [on]
``````

I present a recursive solution: If the first character matches, then try to match rest of pattern to rest of string. In any case, also try to match the full pattern to rest of string. For display, matched characters are enclosed in square brackets, and square brackets in the input are escaped.

``````# Perl weekly challenge 099
#

use warnings;
use strict;
use v5.12;
use Memoize;

memoize qw(sequences);
my (\$S, \$T)=@ARGV;
my @sequences=sequences(\$S, \$T);
say "Input: \\$S=\"\$S\", \\$T=\"\$T\"";
say "Output: ", scalar @sequences;
say "\$_: \$sequences[\$_-1]" for (1..@sequences);
sub sequences { #Recursively find all matches of \$S to \$T
my (\$S, \$T)=@_;
return ("\$S") if \$T=~/^\$/; #nothing more to match
return () if \$S=~/^\$/; #end of string without match
my (\$firstS, \$firstT)=map {escape(substr \$_,0,1)} \$S, \$T;
my (\$restS, \$restT)=map {substr \$_,1} \$S, \$T;
my @sequences=();
@sequences=(map {"[\$firstS]\$_"} sequences(\$restS, \$restT)) if \$firstS eq \$firstT;
@sequences=(@sequences, map {"\$firstS\$_"} sequences(\$restS, \$T));
return @sequences;
}
sub escape { #Escape brackets
my \$string=shift;
\$string=~s/([][])/\\\$1/g;
return \$string;
}
``````

Examples 1 and 2:

``````./ch-2.pl littleit lit
./ch-2.pl london lon
``````

Results:

``````Input: \$S="littleit", \$T="lit"
Output: 5
1: [l][i][t]tleit
2: [l][i]t[t]leit
3: [l][i]ttlei[t]
4: [l]ittle[i][t]
5: litt[l]e[i][t]
Input: \$S="london", \$T="lon"
Output: 3
1: [l][o][n]don
2: [l][o]ndo[n]
3: [l]ond[o][n]
``````

Example with brackets:

``````./ch-2.pl [abc] []
``````

Results:

``````Input: \$S="[abc]", \$T="[]"
Output: 1
1: [\[]abc[\]]
``````

Example with no matches:

``````./ch-2.pl abc def
``````

Results:

``````Input: \$S="abc", \$T="def"
Output: 0
``````
Written on February 8, 2021