Merge pull request #3521 from dcw803/master

imported my solutions to this week's challenge..

7 files changed, 1319 insertions, 36 deletions

diff --git a/challenge-099/duncan-c-white/README b/challenge-099/duncan-c-white/README
index 076c190712..1b476ca4de 100644
--- a/challenge-099/duncan-c-white/README
+++ b/challenge-099/duncan-c-white/README
@@ -1,55 +1,93 @@
-Task 1: "Read N-characters
+Task 1: "Pattern Match
 
-You are given file $FILE.
+You are given a string $S and a pattern $P.
 
-Create subroutine readN($FILE, $number) returns the first n-characters
-and moves the pointer to the (n+1)th character.
+Write a script to check if given pattern validate the entire string. Print
+1 if pass otherwise 0.
 
-Example:
+The patterns can also have the following characters:
+? - Match any single character.
+* - Match any sequence of characters.
 
-Input: Suppose the file (input.txt) contains "1234567890"
-Output:
-    print readN("input.txt", 4); # returns "1234"
-    print readN("input.txt", 4); # returns "5678"
-    print readN("input.txt", 4); # returns "90"
+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
 "
 
-My notes: weird question, hiding IO handles, so presumably a hash of filenames
-to IO handles is needed?
+My notes: oh, cool, simpler than regexes, but nice.  Two basic ways of
+doing this: 1). translate it into a regex and use Perl's regex matching,
+2). figure out a from-scratch mechanism to solve this problem.
 
+Initially, I did (1) in a few minutes, worked fine.  See ch-1.pl as usual.
 
-Task 2: "Search Insert Position
+After doing task 2, I came back to task 1, and starting to think how to do
+(2) - doing it from scratch, and I decided it should be able to extract the
+text matching each wildcard ('?' and '*') as well.  See ch-1a.pl (and API.pm
+and PosExpr.pm modules) for an incomplete (and much much bigger) attempt:
 
-You are given a sorted array of distinct integers @N and a target $N.
-Write a script to return the index of the given target if found otherwise
-place the target in the sorted array and return the index.
+I defined a set of simple Abstract Pattern Instructions, in API.pm.
+For example, a single API might be written as "M'hello'->l", which means:
+"Fail unless you can match the literal string "hello" at the End of $s,
+assuming you can: store the position at which the trailing "hello" started
+in $s into a variable called l".  Another API might be "T l>2", meaning
+"only succeed if the value of l is > 2".  Captures are handled by APIs like
+"C0 1 l-1", meaning "capture into matchedtext[0] the part of $s from char
+pos 1 to char pos l-1".
 
-Example 1:
+Then I wrote an API-interpreter for them.  Of course, this has to handle
+the general match API (see API.pm and ch-1a.pl for details) which can match
+in multiple places - requiring us to try each possible place, and backtrack.
 
-	Input: @N = (1, 2, 3, 4) and $N = 3
-	Output: 2 since the target 3 is in the array at the index 2.
+The API-interpreter successfully does pattern matching, as shown by
+"./ch-1a.pl -t" passing all tests.  So this is a successful proof of concept.
 
-Example 2:
+But as yet I have not attempted to translate our patterns such as 'a*c?e'
+into lists of API calls.
 
-	Input: @N = (1, 3, 5, 7) and $N = 6
-	Output: 3 since the target 6 is missing and
-	   should be placed at the index 3.
 
-Example 3:
+Task 2: "Unique Subsequence
 
-	Input: @N = (12, 14, 16, 18) and $N = 10
-	Output: 0 since the target 10 is missing and
-	   should be placed at the index 0.
+You are given two strings $S and $T.
 
-Example 4:
+Write a script to find out count of different unique subsequences
+in $S matching $T without changing the position of characters.  UPDATE:
+2021-02-08 09:00AM (UK TIME) suggested by Jonas Berlin, missing entry [5].
+
+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
 
-	Input: @N = (11, 13, 15, 17) and $N = 19
-	Output: 4 since the target 19 is missing and
-	   should be placed at the index 4.
+    1: [lon] don
+    2: [lo] ndo [n]
+    3: [l] ond [on]
 "
 
-My notes: nice question.  Clearly defined for once:-)
-Note that inserting the element in the list only matters if
-we print the list out, so let's do that.
-Also added decent amount of input checking (is the list sorted etc)
-Also added test suite [invoke with --test]
+My notes: nice question.  Of course one could do this by translating $T
+into a Task-1-style pattern, so lit becomes *l*i*t* and figuring out
+how many different ways that pattern can apply.  But as $T has no meta-chars,
+an easy approach may be possible (locate all positions in $S where head($T)
+appears, for each of them recursively match subtr($S,pos+1) against tail($T))
diff --git a/challenge-099/duncan-c-white/perl/API.pm b/challenge-099/duncan-c-white/perl/API.pm
new file mode 100644
index 0000000000..cca4048499
--- /dev/null
+++ b/challenge-099/duncan-c-white/perl/API.pm
@@ -0,0 +1,286 @@
+package API;
+
+# automatically generated implementation of recursive data type
+# API	=	F(string lit,string name)
+#	or	L(string lit,string name)
+#	or	M(string lit,posexpr atorafter,string name)
+#	or	T(posexpr pe1,string op,posexpr pe2)
+#	or	C(int mn,posexpr pe1,posexpr pe2)
+
+
+use strict;
+use warnings;
+use feature 'say';
+
+use overload '""' => \&as_string;
+use overload 'eq' => \&streq;
+
+
+
+# API->F: Constructor or get method, use:
+#   my $obj = API->F($lit, $name) OR
+#   my ($lit, $name) = $obj->F
+sub F ($;$$)
+{
+	my( $thing, $lit, $name ) = @_;	
+	if( @_ == 3 )		# constructor
+	{
+		die "API->F: classname $thing is not 'API'\n"
+			unless $thing eq "API";
+		return bless ["F", $lit, $name], "API";
+	} else			# get method
+	{	
+		die "API->F: $thing is not a API\n"
+			unless ref($thing) eq "API";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "API->F: malformed object $thing\n"
+			unless @x == 2 && $t eq "F";
+		return @x;
+	}
+}
+
+
+# API->L: Constructor or get method, use:
+#   my $obj = API->L($lit, $name) OR
+#   my ($lit, $name) = $obj->L
+sub L ($;$$)
+{
+	my( $thing, $lit, $name ) = @_;	
+	if( @_ == 3 )		# constructor
+	{
+		die "API->L: classname $thing is not 'API'\n"
+			unless $thing eq "API";
+		return bless ["L", $lit, $name], "API";
+	} else			# get method
+	{	
+		die "API->L: $thing is not a API\n"
+			unless ref($thing) eq "API";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "API->L: malformed object $thing\n"
+			unless @x == 2 && $t eq "L";
+		return @x;
+	}
+}
+
+
+# API->M: Constructor or get method, use:
+#   my $obj = API->M($lit, $atorafter, $name) OR
+#   my ($lit, $atorafter, $name) = $obj->M
+sub M ($;$$$)
+{
+	my( $thing, $lit, $atorafter, $name ) = @_;	
+	if( @_ == 4 )		# constructor
+	{
+		die "API->M: classname $thing is not 'API'\n"
+			unless $thing eq "API";
+		return bless ["M", $lit, $atorafter, $name], "API";
+	} else			# get method
+	{	
+		die "API->M: $thing is not a API\n"
+			unless ref($thing) eq "API";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "API->M: malformed object $thing\n"
+			unless @x == 3 && $t eq "M";
+		return @x;
+	}
+}
+
+
+# API->T: Constructor or get method, use:
+#   my $obj = API->T($pe1, $op, $pe2) OR
+#   my ($pe1, $op, $pe2) = $obj->T
+sub T ($;$$$)
+{
+	my( $thing, $pe1, $op, $pe2 ) = @_;	
+	if( @_ == 4 )		# constructor
+	{
+		die "API->T: classname $thing is not 'API'\n"
+			unless $thing eq "API";
+		return bless ["T", $pe1, $op, $pe2], "API";
+	} else			# get method
+	{	
+		die "API->T: $thing is not a API\n"
+			unless ref($thing) eq "API";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "API->T: malformed object $thing\n"
+			unless @x == 3 && $t eq "T";
+		return @x;
+	}
+}
+
+
+# API->C: Constructor or get method, use:
+#   my $obj = API->C($mn, $pe1, $pe2) OR
+#   my ($mn, $pe1, $pe2) = $obj->C
+sub C ($;$$$)
+{
+	my( $thing, $mn, $pe1, $pe2 ) = @_;	
+	if( @_ == 4 )		# constructor
+	{
+		die "API->C: classname $thing is not 'API'\n"
+			unless $thing eq "API";
+		return bless ["C", $mn, $pe1, $pe2], "API";
+	} else			# get method
+	{	
+		die "API->C: $thing is not a API\n"
+			unless ref($thing) eq "API";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "API->C: malformed object $thing\n"
+			unless @x == 3 && $t eq "C";
+		return @x;
+	}
+}
+
+
+sub kind ($)
+{
+	my( $self ) = @_;
+	die "API->kind: $self is not a API\n"
+		unless ref($self) eq "API";
+	return $self->[0];
+}
+
+
+sub as_string ($)
+{
+	my( $self ) = @_;
+	die "API->as_string: $self is not a API\n"
+		unless ref($self) eq "API";
+	my @x = @$self;
+	my $t  = shift @x;
+
+	# stringify all params
+	@x = map { "$_" } @x;
+	
+	# specific printing rules
+	return "C $x[0] $x[1] $x[2]" if $t eq 'C';
+	return "F '$x[0]' -> $x[1]" if $t eq 'F';
+	return "L '$x[0]' -> $x[1]" if $t eq 'L';
+	return "M '$x[0]' $x[1] -> $x[2]" if $t eq 'M';
+	return "T $x[0]$x[1]$x[2]" if $t eq 'T';
+
+	# general case
+	my $args = join( ',', @x );
+	return $args ne "" ? "$t($args)" : "$t";
+}
+
+
+
+sub streq ($$)
+{
+	my( $a, $b ) = @_;
+	#print "API->streq called with a=$a, b=$b\n";
+	return "$a" eq "$b" ? 1 : 0;		# the sneaky way
+}
+
+
+
+
+my $debug = 0;
+sub setdebug { my($d) = @_; $debug = $d; }
+
+#
+# my @api = parse( $input );
+#	Parse $input, a string containing a comma-separated sequence
+#	of Abstract Pattern Instructions, return the list of apis.
+#	Die screaming if parsing fails.
+#	For example, matching the pattern a*e is represented by the
+#	following api string:
+#	F'a'->pa,L'e'->plast,Tplast>pa-1,C0 pa+1 plast-1
+#	The individual api forms are:
+#		F'str'->name
+#		L'str'->name
+#		M'str' posexpr->name
+#		Tposexpr ('>'|'=') posexpr
+#		C\d+ posexpr [posexpr]
+#	where posexpr = \d+ or name or name '+'|'-' \d+
+#
+sub parse ($)
+{
+	my( $input ) = @_;
+	my @result;
+	while( $input )
+	{
+		# F'str'->name
+		if( $input =~ s/^F\s*// )
+		{
+			$input =~ s/^'([^']+)'\s*->\s*(\w+)// ||
+				die "bad input $input in F..\n";
+			my $api = API->F($1, $2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# L'str'->name
+		elsif( $input =~ s/^L\s*// )
+		{
+			$input =~ s/^'([^']+)'\s*->\s*(\w+)// ||
+				die "bad input $input in L..\n";
+			my $api = API->L($1, $2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# M'str' posexpr->name
+		elsif( $input =~ s/^M\s*// )
+		{
+			$input =~ s/^'([^']+)'\s+// ||
+				die "bad input $input in M..\n";
+			my $str = $1;
+			(my $pe,$input) = PosExpr::parse($input);
+			die "bad input $input in M$str $pe...\n"
+				unless $input =~ s/^\s*->\s*(\w+)//;
+			my $pname = $1;
+			my $api = API->M($str, $pe, $pname);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# Tposexpr ('>'|'=') posexpr
+		elsif( $input =~ s/^T\s*// )
+		{
+			(my $pe,$input) = PosExpr::parse($input);
+			$input =~ s/^(>|=)// ||
+				die "bad input $input in T$pe, > or = expected\n";
+			my $op = $1;
+			(my $pe2,$input) = PosExpr::parse($input);
+			my $api = API->T($pe, $op, $pe2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# C\d+ posexpr [posexpr]
+		elsif( $input =~ s/^C\s*// )
+		{
+			$input =~ s/^(\d+)\s*// ||
+				die "bad input $input in C.. integer expected\n";
+			my $mn = $1;
+			(my $pe,$input) = PosExpr::parse($input);
+			$input =~ s/^\s*//;
+
+			# second posexpr is optional:
+			# present if next ch is not ','
+			my $pe2 = $pe;
+			if( $input ne '' && $input !~ /^,/ )
+			{
+				($pe2,$input) = PosExpr::parse($input);
+			}
+			my $api = API->C($mn, $pe, $pe2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		$input =~ s/^\s*,\s*//;
+	}
+	die "bad input $input, non empty but not F|L|M|T|C..\n" if $input;
+	return @result;
+}
+
+
+1;
+
diff --git a/challenge-099/duncan-c-white/perl/PosExpr.pm b/challenge-099/duncan-c-white/perl/PosExpr.pm
new file mode 100644
index 0000000000..0ff243c1e9
--- /dev/null
+++ b/challenge-099/duncan-c-white/perl/PosExpr.pm
@@ -0,0 +1,198 @@
+package PosExpr;
+
+# automatically generated implementation of recursive data type
+# PosExpr	=	I(int n)
+#	or	N(string name)
+#	or	NO(string name,char op,int n)
+
+
+use strict;
+use warnings;
+use feature 'say';
+
+use overload '""' => \&as_string;
+use overload 'eq' => \&streq;
+
+
+
+# PosExpr->I: Constructor or get method, use:
+#   my $obj = PosExpr->I($n) OR
+#   my $n = $obj->I
+sub I ($;$)
+{
+	my( $thing, $n ) = @_;	
+	if( @_ == 2 )		# constructor
+	{
+		die "PosExpr->I: classname $thing is not 'PosExpr'\n"
+			unless $thing eq "PosExpr";
+		return bless ["I", $n], "PosExpr";
+	} else			# get method
+	{	
+		die "PosExpr->I: $thing is not a PosExpr\n"
+			unless ref($thing) eq "PosExpr";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "PosExpr->I: malformed object $thing\n"
+			unless @x == 1 && $t eq "I";
+		return $x[0];
+	}
+}
+
+
+# PosExpr->N: Constructor or get method, use:
+#   my $obj = PosExpr->N($name) OR
+#   my $name = $obj->N
+sub N ($;$)
+{
+	my( $thing, $name ) = @_;	
+	if( @_ == 2 )		# constructor
+	{
+		die "PosExpr->N: classname $thing is not 'PosExpr'\n"
+			unless $thing eq "PosExpr";
+		return bless ["N", $name], "PosExpr";
+	} else			# get method
+	{	
+		die "PosExpr->N: $thing is not a PosExpr\n"
+			unless ref($thing) eq "PosExpr";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "PosExpr->N: malformed object $thing\n"
+			unless @x == 1 && $t eq "N";
+		return $x[0];
+	}
+}
+
+
+# PosExpr->NO: Constructor or get method, use:
+#   my $obj = PosExpr->NO($name, $op, $n) OR
+#   my ($name, $op, $n) = $obj->NO
+sub NO ($;$$$)
+{
+	my( $thing, $name, $op, $n ) = @_;	
+	if( @_ == 4 )		# constructor
+	{
+		die "PosExpr->NO: classname $thing is not 'PosExpr'\n"
+			unless $thing eq "PosExpr";
+		return bless ["NO", $name, $op, $n], "PosExpr";
+	} else			# get method
+	{	
+		die "PosExpr->NO: $thing is not a PosExpr\n"
+			unless ref($thing) eq "PosExpr";
+		my @x = @$thing;
+		my $t = shift @x;
+		die "PosExpr->NO: malformed object $thing\n"
+			unless @x == 3 && $t eq "NO";
+		return @x;
+	}
+}
+
+
+sub kind ($)
+{
+	my( $self ) = @_;
+	die "PosExpr->kind: $self is not a PosExpr\n"
+		unless ref($self) eq "PosExpr";
+	return $self->[0];
+}
+
+
+sub as_string ($)
+{
+	my( $self ) = @_;
+	die "PosExpr->as_string: $self is not a PosExpr\n"
+		unless ref($self) eq "PosExpr";
+	my @x = @$self;
+	my $t  = shift @x;
+
+	# stringify all params
+	@x = map { "$_" } @x;
+	
+	# specific printing rules
+	return "$x[0]" if $t eq 'I';
+	return "$x[0]" if $t eq 'N';
+	return "$x[0]$x[1]$x[2]" if $t eq 'NO';
+
+	# general case
+	my $args = join( ',', @x );
+	return $args ne "" ? "$t($args)" : "$t";
+}
+
+
+
+sub streq ($$)
+{
+	my( $a, $b ) = @_;
+	#print "PosExpr->streq called with a=$a, b=$b\n";
+	return "$a" eq "$b" ? 1 : 0;		# the sneaky way
+}
+
+
+
+
+my $debug = 0;
+sub setdebug { my($d) = @_; $debug = $d; }
+
+#
+# my($pe,$leftover) = parse($input);
+#	Parse $input, a string starting with a position expression,
+#	delivering the position expression in $pe and the leftover
+#	input in $leftover.  Die screaming if no well formed pos expr
+#	can be found at the start of $input.
+#	A position expression is either \d+ or name or name '+'|'-' \d+
+#	The internal form of a posexpr is ['I', int const] or ['N', name]
+#	or ['NO', name, +-, offset]
+#
+sub parse ($)
+{
+	my( $input ) = @_;
+	if( $input =~ s/^(\d+)\s*// )
+	{
+		return ( PosExpr->I($1), $input );
+	}
+	$input =~ s/^(\w+)\s*// ||
+		die "bad input in pos expr $input, name expected\n";
+	my $name = $1;
+	if( $input =~ s/^([\+-])\s*(\d+)\s*// )
+	{
+		return ( PosExpr->NO($name,$1,$2), $input );
+	}
+	return ( PosExpr->N($name), $input );
+}
+
+#
+# my $pos = $pe->eval($poshash);
+#	Evaluate the given PosExpr $pe, using %$poshash
+#	for name lookup.  Returns the actual position (a number).
+#
+sub eval ($$)
+{
+	my( $self, $poshash ) = @_;
+	if( $self->kind eq 'I' )
+	{
+		return $self->I;
+	} elsif( $self->kind eq 'N' )
+	{
+		my $name = $self->N;
+		die "error in PosExpr::eval($self): ".
+		    "no such name $name in poshash ". Dumper($poshash)
+			unless exists $poshash->{$name};
+		return $poshash->{$name};
+	} else    # if( $self->kind eq 'NO' )
+	{
+		my ($name, $op, $n) = $self->NO;
+		die "error in PosExpr::eval($self): ".
+		    "no such name $name in poshash ". Dumper($poshash)
+			unless exists $poshash->{$name};
+		die "error in PosExpr::eval($self): bad op $op\n" unless
+			$op eq '+' || $op eq '-';
+		$n = - $n if $op eq '-';
+		return $poshash->{$name} + $n;
+	}
+}
+
+
+
+
+
+1;
+
diff --git a/challenge-099/duncan-c-white/perl/ch-1.pl b/challenge-099/duncan-c-white/perl/ch-1.pl
new file mode 100755
index 0000000000..d065cc611a
--- /dev/null
+++ b/challenge-099/duncan-c-white/perl/ch-1.pl
@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+#
+# Task 1: "Pattern Match
+# 
+# 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
+# "
+# 
+# My notes: oh, cool, simpler than regexes, but nice.  Two basic ways of
+# doing this: 1). translate it into a regex and use Perl's regex matching,
+# 2). figure out a from-scratch mechanism to solve this problem.
+# (1) is much simpler, let's do that first: so write a "pat2regex" function.
+# Note: I also added a test suite (the above examples) with --test.
+# 
+
+use strict;
+use warnings;
+use Getopt::Long;
+use feature 'say';
+use Data::Dumper;
+
+my $debug=0;
+my $test=0;
+die "Usage: pattern-match [--test] [--debug]\n".
+    "Or...  pattern-match [--debug] S P\n"
+	unless GetOptions( "debug" => \$debug, "test" => \$test )
+	    && ($test && @ARGV==0 || !$test && @ARGV==2);
+if( $test )
+{
+	dotests();
+	exit 0;
+}
+
+my( $s, $p ) = @ARGV;
+die "bad patten $p (contains '*'->['?']*->'*' sequence)\n" if
+	$p =~ /\*\?*\*/;
+my $match = patmatch( $p, $s );
+say "Output: $match";
+
+
+#
+# my $match = patmatch( $p, $s );
+#	Pattern match $p against $s, returning 1 iff it matches
+#	the whole of $s, 0 otherwise.
+#
+sub patmatch
+{
+	my( $p, $s ) = @_;
+	my $re = pat2regex( $p );
+	my $match = ($s =~ /$re/) ? 1 : 0;
+	say "patmatch( p:$p, re:$re, s:$s )=$match" if $debug;
+	return $match;
+}
+
+
+#
+# my $re = pat2regex( $p );
+#	Convert the pattern $p to a regex string and return it.
+#
+sub pat2regex
+{
+	my( $p ) = @_;
+	my $inner = $p;
+	$inner =~ s/\*/.*/g;	# * -> .*
+	$inner =~ s/\?/./g;	# ? -> .
+	return '^'.$inner.'$';
+}
+
+#
+# dotests();
+#	Do a load of tests.
+#
+sub dotests
+{
+	eval "use Test::More"; die $@ if $@;
+
+# format of each test: S:P:result
+my @tests = (
+	"abcde:a*e:1",
+	"abcde:a*d:0",
+	"abcde:?b*d:0",
+	"abcde:a*c?e:1",
+	"hellotherehowareyou:*ll*u:1",	# mine own exemplar..
+);
+
+	say "dotests() entry" if $debug;
+	say "dotests(): tests=". Dumper(\@tests) if $debug;
+	foreach my $test (@tests)
+	{
+		say "test $test" if $debug;
+		my( $s, $p, $result ) = split( /:/, $test );
+		$result //= '0';
+		my $match = patmatch( $p, $s );
+		#say "p=$p, s=$s, match=$match" if $debug;
+		is( $result, $match, " match($s,$p)=$result" );
+
+	}
+	done_testing();
+}
diff --git a/challenge-099/duncan-c-white/perl/ch-1a.pl b/challenge-099/duncan-c-white/perl/ch-1a.pl
new file mode 100755
index 0000000000..e0f8dcbade
--- /dev/null
+++ b/challenge-099/duncan-c-white/perl/ch-1a.pl
@@ -0,0 +1,245 @@
+#!/usr/bin/perl
+#
+# Task 1: "Pattern Match
+# 
+# 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
+# "
+# 
+# My notes: oh, cool, simpler than regexes, but nice.  Two basic ways of
+# doing this: 1). translate it into a regex and use Perl's regex matching,
+# 2). figure out a from-scratch mechanism to solve this problem.
+# In this version (having already got (1) working in ch-1.pl), let's do (2).
+# I've invented "Abstract Pattern Instructions (APIs)", and am writing an
+# interpreter for them in order to do the matching.  To make life interesting,
+# let's also capture the matching text for each '?' and '*'.  I've got this
+# working; see API.pm and PosExpr.pm too..
+#
+# Of course I'll eventually need to work out how to translate our patterns
+# into a list of APIs, but I haven't got time for this now.  So this is an
+# incomplete proof-of-concept, that "interpreting a list of APIs" will do
+# pattern matching, even if I don't yet know how to translater a pattern into
+# a list of APIs.
+#
+# Note: I also added a test suite (the above examples) with --test.
+# 
+
+use strict;
+use warnings;
+use Getopt::Long;
+use feature 'say';
+use Function::Parameters;
+use Data::Dumper;
+
+use lib qw(.);
+use API;
+use PosExpr;
+
+my $debug=0;
+my $test=0;
+die "Usage: pattern-match [--test] [--debug]\n".
+    "Or...  pattern-match [--debug] S cvslist(API)\n"
+	unless GetOptions( "debug" => \$debug, "test" => \$test )
+	    && ($test && @ARGV==0 || !$test && @ARGV>=2);
+API::setdebug( $debug );
+PosExpr::setdebug( $debug );
+
+if( $test )
+{
+	dotests();
+	exit 0;
+}
+
+my( $s, @apistr ) = @ARGV;
+my @api = API::parse( join(',',@apistr) );
+say "apis:";
+say join("\n", map { "  $_" } @api );
+my( $matched, @matchtext ) = patmatch( $s, @api );
+say "Output: $matched";
+if( $matched )
+{
+	foreach my $i (0..$#matchtext)
+	{
+		say " match text $i: $matchtext[$i]";
+	}
+}
+
+
+#
+# my @litpos = findliteral( $lit, $p, $s );
+#	Find all instances of $lit atorafter position $p in $s,
+#	build and return a list of possible starting positions.
+#
+fun findliteral( $lit, $p, $s )
+{
+	my $slen = length($s);
+	my $llen = length($lit);
+	my @result = grep { substr($s,$_,$llen) eq $lit; } $p..$slen-1;
+	#die "findliteral: lit=$lit, s=$s, results=".Dumper(\@result);
+	return @result;
+}
+
+
+#
+# my $match = interprete( $s, $apilist, $poshash, $mtlist );
+#	Interprete @$apilist against the string $s, using (and modifying)
+#	%$poshash which maps names to their positions.
+#	Return 1 for a match (filling in @$mtlist) or 0 for no match.
+#
+fun interprete( $s, $apilist, $poshash, $mtlist )
+{
+	my $slen = length($s);
+	my $n = 0;
+	foreach my $api (@$apilist)
+	{
+		my $kind = $api->kind;
+		if( $kind eq 'F' )
+		{
+			my( $lit, $name ) = $api->F;
+			return 0 unless substr($s,0,length($lit)) eq $lit;
+			$poshash->{$name} = 0;
+			say "debug: F: set pos[$name] = 0" if $debug;
+		}
+		elsif( $kind eq 'L' )
+		{
+			my( $lit, $name ) = $api->L;
+			my $startpos = $slen-length($lit);
+			return 0 unless substr($s,$startpos) eq $lit;
+			$poshash->{$name} = $startpos;
+			say "debug: L: set pos[$name] = $startpos" if $debug;
+		}
+		elsif( $kind eq 'M' )		# Match at or after - tricky
+		{
+			my( $lit, $atorafterpos, $name ) = $api->M;
+			my $atorafter = $atorafterpos->eval($poshash);
+			my @litpos = findliteral( $lit, $atorafter, $s );
+			return 0 if @litpos==0;
+
+			# must try each possible position in @litpos in turn
+			if( @litpos == 1 )
+			{
+				$poshash->{$name} = $litpos[0];
+	say "debug: M: set pos[$name] = $litpos[0]" if $debug;
+			} else
+			{
+	say "debug: M: try each pos ".join(',',@litpos) if $debug;
+				# Try the rest of the api list..
+				my @restapi = @$apilist[$n+1..$#$apilist];
+
+				# for each possible pos of the match
+				foreach my $pos (@litpos)
+				{
+					$poshash->{$name} = $pos;
+	say "debug: try pos[$name] = $pos" if $debug;
+					my $match = interprete(
+					   $s, \@restapi, $poshash, $mtlist );
+	say "debug: matchrest = $match" if $debug;
+					return 1 if $match;
+					undef $poshash->{$name};
+				}
+				return 0;
+			}
+		}
+		elsif( $kind eq 'T' )
+		{
+			my( $pe1, $op, $pe2 ) = $api->T;
+			my $pv1 = $pe1->eval($poshash);
+			my $pv2 = $pe2->eval($poshash);
+			return 0 if $op eq '>' && $pv1 <= $pv2;
+			return 0 if $op eq '=' && $pv1 != $pv2;
+	say "debug: test $api succeeded" if $debug;
+		}
+		elsif( $kind eq 'C' )
+		{
+			my ($mn, $pe1, $pe2) = $api->C;
+			my $from = $pe1->eval($poshash);
+			my $to = $pe2->eval($poshash);
+			$mtlist->[$mn] = substr($s,$from,$to-$from+1);
+			say "debug: C: set mt[$mn] to $mtlist->[$mn]" if $debug;
+		}
+		else
+		{
+			die "interprete: not yet implemented $kind\n";
+		}
+		$n++;
+	}
+	return 1;
+}
+
+
+#
+# my( $matched, @matchtext ) = patmatch( $s, @api );
+#	Pattern match @api against $s, returning ( 1, @matchtext ) iff it
+#	matches the whole of $s, ( 0 ) otherwise.  Basically this is an
+#	Interpreter for the list @api.
+#
+sub patmatch
+{
+	my( $s, @api ) = @_;
+	say "patmatch: matching api rules against $s" if $debug;
+	my %pos;
+	$pos{"slen"} = length($s);
+	my @mt;
+	my $match = interprete( $s, \@api, \%pos, \@mt );
+	return ( $match, @mt );
+}
+
+
+#
+# dotests();
+#	Do a load of tests.
+#
+sub dotests
+{
+	eval "use Test::More"; die $@ if $@;
+
+# format of each test: S:P:API(p):expmatch:expmt
+my @tests = (
+	"abcde:a*e:F'a'->a,L'e'->e,Te>a-1,C0 a+1 e-1:1:bcd",
+	"abcde:a*d:F'a'->pa,L'd'->plast,Tplast>pa-1,C0 pa+1 plast-1:0:",
+	"abcde:?b*d:L'd'->plast,M'b' 1->pb,Tpb=1,C0 0,C1 pb+1 plast-1:0:",
+	"abcde:a*c?e:F'a'->a,L'e'->e,M'c' 1->c,Tc>a,Te=c+2,C0 a+1 c-1,C1 c+1:1:b,d",
+	"hellotherehowareyou:*ll*u:L'u'->u,M'll' 0->l,Tu>l+1,C0 0 l-1,C1 l+2 u-1:1:he,otherehowareyo",	# mine own exemplar..
+);
+
+	say "dotests(): tests=". Dumper(\@tests) if $debug;
+	foreach my $test (@tests)
+	{
+		say "test $test" if $debug;
+		my( $s, $p, $api, $expmatch, $expmts ) = split( /:/, $test );
+		$expmatch //= '0';
+		my @expectedmt = split(/,/,$expmts);
+		my @api = API::parse( $api );
+		my( $match, @mt ) = patmatch( $s, @api );
+		say "p=$p, s=$s, match=$match, mt=".Dumper(\@mt) if $debug;
+		is( $match, $expmatch, " match($s,$p)=$expmatch" );
+		is( scalar(@mt), scalar(@expectedmt), "match($s,$p).#matches" );
+		foreach my $i (0..$#mt)
+		{
+			is( $mt[$i], $expectedmt[$i], "match($s,$p).match[$i]" );
+		}
+	}
+	done_testing();
+}
diff --git a/challenge-099/duncan-c-white/perl/ch-2.pl b/challenge-099/duncan-c-white/perl/ch-2.pl
new file mode 100755
index 0000000000..6917771771
--- /dev/null
+++ b/challenge-099/duncan-c-white/perl/ch-2.pl
@@ -0,0 +1,195 @@
+#!/usr/bin/perl
+# 
+# Task 2: "Unique Subsequence
+# 
+# You are given two strings $S and $T.
+# 
+# Write a script to find out count of different unique subsequences
+# in $S matching $T without changing the position of characters.  UPDATE:
+# 2021-02-08 09:00AM (UK TIME) suggested by Jonas Berlin, missing entry [5].
+# 
+# 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]
+# "
+# 
+# My notes: nice question.  Of course one could do this by translating $T
+# into a Task-1-style pattern, so lit becomes *l*i*t* and figuring out
+# how many different ways that pattern can apply.  But as $T has no meta-chars,
+# an easier approach may be possible:
+#  - locate all positions in $S where head($T) appears, for each of them
+#    recursively match subtr($S,pos+1) against tail($T))
+# However, if we want to produce the "[lo] ndo [n]" explanation of each match,
+# that's slightly trickier to code.  Suppose we represent a specific match
+# by a "match tag" like "..ndo.", representing the explanation "[lo] ndo [n]".
+# it's easy enough to produce the match tags while counting matches, and easy
+# enough to convert match tag "..ndo." (and t="lon") into "[lo] ndo [n]" after.
+# NB: Also added test suite [invoke with --test]
+# 
+
+use strict;
+use warnings;
+use feature 'say';
+use Getopt::Long;
+use Function::Parameters;
+use Data::Dumper;
+
+my $debug=0;
+my $test=0;
+die "Usage: unique-subsequnces [--test] [--debug]\n".
+    "Or...  unique-subsequnces [--debug] S T\n"
+	unless GetOptions( "debug" => \$debug, "test" => \$test )
+	    && ($test && @ARGV==0 || !$test && @ARGV==2);
+
+if( $test )
+{
+	dotests();
+	exit 0;
+}
+
+my( $s, $t ) = @ARGV;
+my @match = find_the_ways( $s, $t );
+my $nways = @match;
+say "Input: s=$s, t=$t";
+say "Output: $nways";
+foreach my $mn (0..$#match)
+{
+	say( '    ' . ($mn+1) . ': ' . explain_matchtag($t,$match[$mn]) );
+}
+
+#
+# my @match = find_the_ways( $s, $t );
+#	Find all different ways that $s can contain the chars in $t
+#	in that order.  For each way that we find, generate a match tag, a
+#	string like $s, but in which every position in the tag that matches a
+#	char in $t replaced with a '.'.
+#	Return a list of a