aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordrbaggy <js5@sanger.ac.uk>2021-02-13 23:25:20 +0000
committerdrbaggy <js5@sanger.ac.uk>2021-02-13 23:25:20 +0000
commit10f9036a427c3d38ec3dbc5ef1428b90b4443c27 (patch)
tree3575b20177879553f3f711dc838a8ed8baace83d
parent034057dcb7b2a08bee0a408726121320c1355fb2 (diff)
parentb3daee64ed733af78f2141d074fcc8ace8071ea2 (diff)
downloadperlweeklychallenge-club-10f9036a427c3d38ec3dbc5ef1428b90b4443c27.tar.gz
perlweeklychallenge-club-10f9036a427c3d38ec3dbc5ef1428b90b4443c27.tar.bz2
perlweeklychallenge-club-10f9036a427c3d38ec3dbc5ef1428b90b4443c27.zip
Merge remote-tracking branch 'upstream/master'
-rw-r--r--challenge-099/arne-sommer/blog.txt1
-rwxr-xr-xchallenge-099/arne-sommer/perl/ch-1.pl24
-rwxr-xr-xchallenge-099/arne-sommer/perl/ch-2.pl52
-rwxr-xr-xchallenge-099/arne-sommer/perl/pattern-match-perl24
-rwxr-xr-xchallenge-099/arne-sommer/perl/unique-subsequence-perl52
-rwxr-xr-xchallenge-099/arne-sommer/raku/ch-1.raku11
-rwxr-xr-xchallenge-099/arne-sommer/raku/ch-2.raku38
-rwxr-xr-xchallenge-099/arne-sommer/raku/pattern-match11
-rwxr-xr-xchallenge-099/arne-sommer/raku/unique-subsequence38
-rw-r--r--challenge-099/colin-crain/blog.txt1
-rwxr-xr-xchallenge-099/jo-37/perl/ch-1.pl118
-rwxr-xr-xchallenge-099/jo-37/perl/ch-2.pl107
-rw-r--r--challenge-099/laurent-rosenfeld/blog.txt1
-rw-r--r--challenge-099/laurent-rosenfeld/perl/ch-1.pl17
-rw-r--r--challenge-099/laurent-rosenfeld/perl/ch-2.pl23
-rw-r--r--challenge-099/laurent-rosenfeld/raku/ch-1.raku21
-rw-r--r--challenge-099/laurent-rosenfeld/raku/ch-2.raku12
-rw-r--r--challenge-099/wambash/raku/ch-1.raku19
-rw-r--r--challenge-099/wambash/raku/ch-2.raku17
-rw-r--r--stats/pwc-current.json263
-rw-r--r--stats/pwc-language-breakdown-summary.json62
-rw-r--r--stats/pwc-language-breakdown.json666
-rw-r--r--stats/pwc-leaders.json760
-rw-r--r--stats/pwc-summary-1-30.json50
-rw-r--r--stats/pwc-summary-121-150.json54
-rw-r--r--stats/pwc-summary-151-180.json94
-rw-r--r--stats/pwc-summary-181-210.json44
-rw-r--r--stats/pwc-summary-211-240.json64
-rw-r--r--stats/pwc-summary-31-60.json56
-rw-r--r--stats/pwc-summary-61-90.json44
-rw-r--r--stats/pwc-summary-91-120.json44
-rw-r--r--stats/pwc-summary.json496
32 files changed, 1983 insertions, 1301 deletions
diff --git a/challenge-099/arne-sommer/blog.txt b/challenge-099/arne-sommer/blog.txt
new file mode 100644
index 0000000000..0c47295e92
--- /dev/null
+++ b/challenge-099/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/subsequently-matched.html
diff --git a/challenge-099/arne-sommer/perl/ch-1.pl b/challenge-099/arne-sommer/perl/ch-1.pl
new file mode 100755
index 0000000000..632204f90c
--- /dev/null
+++ b/challenge-099/arne-sommer/perl/ch-1.pl
@@ -0,0 +1,24 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use Getopt::Long;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $S = shift(@ARGV);
+my $P = shift(@ARGV);
+
+die '"$S" must have length' unless length $S;
+die '"$P" must have length' unless length $P;
+
+$P =~ s/\*/.*/g;
+$P =~ s/\?/./g;
+
+say ": Perl Regex: $P " if $verbose;
+
+say $S =~ /^$P$/ ? 1 : 0;
diff --git a/challenge-099/arne-sommer/perl/ch-2.pl b/challenge-099/arne-sommer/perl/ch-2.pl
new file mode 100755
index 0000000000..584e01992e
--- /dev/null
+++ b/challenge-099/arne-sommer/perl/ch-2.pl
@@ -0,0 +1,52 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use Getopt::Long;
+use List::Util qw(sum);
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $S = shift(@ARGV);
+my $T = shift(@ARGV);
+
+die '"$S" must have length' unless length $S;
+die '"$T" must have length' unless length $T;
+
+my $S_length = length $S;
+my $T_length = length $T;
+my $binary = '1' x $S_length;
+
+my $max = oct('0b' . $binary);
+my $matches = 0;
+
+for my $current (1 .. $max)
+{
+ my $mask = sprintf("%0" . $S_length ."b", $current);
+
+ if (sum(split(//, $mask)) != $T_length)
+ {
+ say ": Skipped binary mask '{ $mask }' - wrong number of 1s" if $verbose;
+ next;
+ }
+
+ my $candidate = join("", map { substr($mask, $_, 1) eq '1' ? substr($S, $_,1) : '' } (0 .. $S_length -1));
+
+ if ($candidate eq $T)
+ {
+ $matches++;
+ say ": + Match found with binary mask '$mask'." if $verbose;
+ }
+ else
+ {
+ say ": Considering binary mask ' $mask' - no match" if $verbose;
+ }
+}
+
+say $matches;
+
+
diff --git a/challenge-099/arne-sommer/perl/pattern-match-perl b/challenge-099/arne-sommer/perl/pattern-match-perl
new file mode 100755
index 0000000000..632204f90c
--- /dev/null
+++ b/challenge-099/arne-sommer/perl/pattern-match-perl
@@ -0,0 +1,24 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use Getopt::Long;
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $S = shift(@ARGV);
+my $P = shift(@ARGV);
+
+die '"$S" must have length' unless length $S;
+die '"$P" must have length' unless length $P;
+
+$P =~ s/\*/.*/g;
+$P =~ s/\?/./g;
+
+say ": Perl Regex: $P " if $verbose;
+
+say $S =~ /^$P$/ ? 1 : 0;
diff --git a/challenge-099/arne-sommer/perl/unique-subsequence-perl b/challenge-099/arne-sommer/perl/unique-subsequence-perl
new file mode 100755
index 0000000000..584e01992e
--- /dev/null
+++ b/challenge-099/arne-sommer/perl/unique-subsequence-perl
@@ -0,0 +1,52 @@
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+use Getopt::Long;
+use List::Util qw(sum);
+
+my $verbose = 0;
+
+GetOptions("verbose" => \$verbose);
+
+my $S = shift(@ARGV);
+my $T = shift(@ARGV);
+
+die '"$S" must have length' unless length $S;
+die '"$T" must have length' unless length $T;
+
+my $S_length = length $S;
+my $T_length = length $T;
+my $binary = '1' x $S_length;
+
+my $max = oct('0b' . $binary);
+my $matches = 0;
+
+for my $current (1 .. $max)
+{
+ my $mask = sprintf("%0" . $S_length ."b", $current);
+
+ if (sum(split(//, $mask)) != $T_length)
+ {
+ say ": Skipped binary mask '{ $mask }' - wrong number of 1s" if $verbose;
+ next;
+ }
+
+ my $candidate = join("", map { substr($mask, $_, 1) eq '1' ? substr($S, $_,1) : '' } (0 .. $S_length -1));
+
+ if ($candidate eq $T)
+ {
+ $matches++;
+ say ": + Match found with binary mask '$mask'." if $verbose;
+ }
+ else
+ {
+ say ": Considering binary mask ' $mask' - no match" if $verbose;
+ }
+}
+
+say $matches;
+
+
diff --git a/challenge-099/arne-sommer/raku/ch-1.raku b/challenge-099/arne-sommer/raku/ch-1.raku
new file mode 100755
index 0000000000..7b7a160d80
--- /dev/null
+++ b/challenge-099/arne-sommer/raku/ch-1.raku
@@ -0,0 +1,11 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str $S where $S.chars > 0,
+ Str $P is copy where $P.chars > 0,
+ :v(:$verbose));
+
+$P.=trans( [ '*', '?' ] => [ '.*' , '.' ]);
+
+say ": Regex: $P " if $verbose;
+
+say $S ~~ /^ <$P> $/ ?? 1 !! 0
diff --git a/challenge-099/arne-sommer/raku/ch-2.raku b/challenge-099/arne-sommer/raku/ch-2.raku
new file mode 100755
index 0000000000..9cd85cf00d
--- /dev/null
+++ b/challenge-099/arne-sommer/raku/ch-2.raku
@@ -0,0 +1,38 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str $S where $S.chars > 0,
+ Str $T where $T.chars > 0,
+ :v(:$verbose));
+
+my $S-length = $S.chars;
+my $T-length = $T.chars;
+my $binary = '1' x $S-length;
+my $max = $binary.parse-base(2);
+my $matches = 0;
+
+for 1 .. $max -> $current
+{
+ my $mask = $current.fmt('%0' ~ $S-length ~ 'b');
+
+ if $mask.comb.sum != $T-length
+ {
+ say ": Skipped binary mask '{ $mask }' - wrong number of 1s" if $verbose;
+ next;
+ }
+
+ my $candidate = (^$S-length).map({ $mask.substr($_, 1) eq '1' ?? $S.substr($_,1) !! '' }).join;
+
+ if $candidate eq $T
+ {
+ $matches++;
+ say ": + Match found with binary mask '{ $mask }'." if $verbose;
+ }
+ else
+ {
+ say ": Considering binary mask '{ $mask}' - no match" if $verbose;
+ }
+}
+
+say $matches;
+
+
diff --git a/challenge-099/arne-sommer/raku/pattern-match b/challenge-099/arne-sommer/raku/pattern-match
new file mode 100755
index 0000000000..7b7a160d80
--- /dev/null
+++ b/challenge-099/arne-sommer/raku/pattern-match
@@ -0,0 +1,11 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str $S where $S.chars > 0,
+ Str $P is copy where $P.chars > 0,
+ :v(:$verbose));
+
+$P.=trans( [ '*', '?' ] => [ '.*' , '.' ]);
+
+say ": Regex: $P " if $verbose;
+
+say $S ~~ /^ <$P> $/ ?? 1 !! 0
diff --git a/challenge-099/arne-sommer/raku/unique-subsequence b/challenge-099/arne-sommer/raku/unique-subsequence
new file mode 100755
index 0000000000..9cd85cf00d
--- /dev/null
+++ b/challenge-099/arne-sommer/raku/unique-subsequence
@@ -0,0 +1,38 @@
+#! /usr/bin/env raku
+
+unit sub MAIN (Str $S where $S.chars > 0,
+ Str $T where $T.chars > 0,
+ :v(:$verbose));
+
+my $S-length = $S.chars;
+my $T-length = $T.chars;
+my $binary = '1' x $S-length;
+my $max = $binary.parse-base(2);
+my $matches = 0;
+
+for 1 .. $max -> $current
+{
+ my $mask = $current.fmt('%0' ~ $S-length ~ 'b');
+
+ if $mask.comb.sum != $T-length
+ {
+ say ": Skipped binary mask '{ $mask }' - wrong number of 1s" if $verbose;
+ next;
+ }
+
+ my $candidate = (^$S-length).map({ $mask.substr($_, 1) eq '1' ?? $S.substr($_,1) !! '' }).join;
+
+ if $candidate eq $T
+ {
+ $matches++;
+ say ": + Match found with binary mask '{ $mask }'." if $verbose;
+ }
+ else
+ {
+ say ": Considering binary mask '{ $mask}' - no match" if $verbose;
+ }
+}
+
+say $matches;
+
+
diff --git a/challenge-099/colin-crain/blog.txt b/challenge-099/colin-crain/blog.txt
new file mode 100644
index 0000000000..26ee0b615a
--- /dev/null
+++ b/challenge-099/colin-crain/blog.txt
@@ -0,0 +1 @@
+https://colincrain.com/2021/02/13/diffraction-gratings-producing-a-wildcard-wonderland/
diff --git a/challenge-099/jo-37/perl/ch-1.pl b/challenge-099/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..5125ed3951
--- /dev/null
+++ b/challenge-099/jo-37/perl/ch-1.pl
@@ -0,0 +1,118 @@
+#!/usr/bin/perl -s
+
+use v5.20;
+use Test2::V0;
+use experimental 'signatures';
+
+our ($tests, $examples, $verbose);
+
+run_tests() if $tests || $examples; # does not return
+
+die <<EOS unless @ARGV == 2;
+usage: $0 [-examples] [-tests] [-verbose] [string pattern]
+
+-examples
+ run the examples from the challenge
+
+-tests
+ run some tests
+
+-verbose
+ print generated regex
+
+string
+ string to be matched against pattern
+
+pattern
+ shell-like pattern
+
+Use '?' inside pattern to match one arbitrary character, '*' to match
+any number of characters and '\\' to interpret the following single
+character literally.
+
+EOS
+
+
+### Input and Output
+
+say patmatch($ARGV[0], $ARGV[1]) + 0;
+
+
+### Implementation
+
+# Convert pattern part to regex:
+# * -> .*
+# ? -> .
+# \x -> x
+# other: quote if necessary
+#
+# Processes $_.
+sub convmeta {
+ return '.*?' if /^\*$/;
+ return '.' if /^\?$/;
+ return quotemeta $1 if /^\\(.)$/;
+ # else:
+ quotemeta;
+}
+
+# Match string against pattern. Pattern meta characters are:
+# ? : match one character
+# * : match any number of characters
+# \ : use next character literally
+# The special treatment of quoted characters is beyond the specification
+# of this task but it seems to be useful and needful.
+sub patmatch ($str, $pat) {
+
+ # Convert pattern to regex.
+ my $re = sub {qr/^ @_ $/x}->(
+ map convmeta,
+ $pat =~ m{
+ \G # start at previous end-of-match position and
+ ( # capture
+ [^*?\\]+ # a group of non-meta chars
+ | # or
+ [*?] # a meta-char
+ | # or
+ \\. # a quoted char
+ )
+ }gx);
+ # Reject incomplete patterns.
+ die "invalid pattern: '$'' in '$pat'" if $';
+
+ say "pattern: '$pat'\nregex: $re" if $verbose;
+
+ $str =~ $re;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+ SKIP: {
+ skip "examples" unless $examples;
+ ok patmatch('abcde', 'a*e'), 'example 1';
+ ok !patmatch('abcde', 'a*d'), 'example 2';
+ ok !patmatch('abcde', '?b*d'), 'example 3';
+ ok patmatch('abcde', 'a*c?e'), 'example 4';
+ }
+
+ SKIP: {
+ skip "tests" unless $tests;
+ ok patmatch('ch-1.pl', '*.pl'), 'literal dot matches';
+ ok !patmatch('ch-1-pl', '*.pl'), 'literal dot only matches dot';
+ ok patmatch('abc.*', '*.\*'), 'literal asterisk matches';
+ ok !patmatch('abc.pl', '*.\*'), 'literal asterisk required';
+ ok patmatch('ch-[12].pl', '*-[12].pl'), 'literal charclass matches';
+ ok !patmatch('ch-1.pl', '*-[12].pl'), 'literal charclass required';
+ ok patmatch('ch-1.pl', '*.\p\l'), 'escaped characters';
+ ok patmatch('ab\\cd', '??\\\\??'), 'escaped backslash';
+ ok patmatch('abbccdde', 'a?*?*?e'), 'matching consecutive meta chars';
+ ok !patmatch('abde', 'a?*?*?e'), 'non-matching consecuteive meta chars';
+ ok patmatch('äöü', 'ä?ü'), 'handle multi-byte characters';
+ like dies {patmatch('ab', 'ab\\')}, qr/invalid pattern/,
+ 'incomplete quoting sequence';
+ }
+
+ done_testing;
+ exit;
+}
diff --git a/challenge-099/jo-37/perl/ch-2.pl b/challenge-099/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..9f7e22f188
--- /dev/null
+++ b/challenge-099/jo-37/perl/ch-2.pl
@@ -0,0 +1,107 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use experimental 'signatures';
+use charnames ':full';
+
+our ($tests, $examples, $verbose);
+
+run_tests() if $tests || $examples; # does not return
+
+die <<EOS unless @ARGV == 2;
+usage: $0 [-examples] [-tests] [-verbose] [string sequence]
+
+-examples
+ run the examples from the challenge
+
+-tests
+ run some tests
+
+-verbose
+ show subsequence in string
+
+string
+ string to examine
+
+sequence
+ sequence of chars to search for in <string>
+
+EOS
+
+
+### Input and Output
+
+say matchseq($ARGV[0], $ARGV[1]);
+
+
+### Implementation
+
+# Count occurences of a character sequence within a string.
+sub matchseq ($str, $seq) {
+
+ # Create a regex that matches the character sequence and captures
+ # all of its characters individually.
+ # Example transformation chain:
+ # 'x*' -> ('x', '*') -> ('x', '\\*') -> (?:(x).*?(\*))
+ my $seqmatch = sub {
+ local $" = ').*?(';
+ qr{(@_)};
+ }->(map quotemeta, split //, $seq);
+
+ # Find all sequence matches and collect the character match offsets.
+ my @match;
+ $str =~ m{ $seqmatch (?{push @match, [@-]}) (*FAIL) }x;
+
+ explainseq($str, $seq, $seqmatch, \@match) if $verbose;
+
+ # Return the number of matches.
+ scalar @match;
+}
+
+# Show the locations of the character sequence within the string.
+sub explainseq ($str, $seq, $re, $matches) {
+
+ say "sequence: '$seq'";
+ say "matcher: $re";
+ say $str;
+
+ for my $match (@$matches) {
+
+ # Discard match offset, keeping submatches only. (See @-)
+ shift @$match;
+
+ # Prepare a string having the same length as $str.
+ my $seqloc = "\N{MIDDLE DOT}" x length $str;
+
+ # Overwrite the string at match offsets with chars from the
+ # sequence.
+ while (my ($idx, $offs) = each @$match) {
+ substr($seqloc, $offs, 1) = substr($seq, $idx, 1);
+ }
+ say $seqloc;
+ }
+}
+
+### Examples and tests
+
+sub run_tests {
+SKIP: {
+ skip "examples" unless $examples;
+ is matchseq('littleit', 'lit'), 5, 'example 1';
+ is matchseq('london', 'lon'), 3, 'example 2';
+}
+
+SKIP: {
+ skip "tests" unless $tests;
+ is matchseq('xxaxxbxxcxx', 'abc'), 1, 'unique sequence';
+ is matchseq('aaaaa', 'a'), 5, 'repetition';
+ is matchseq('ihgfedcba', 'def'), 0, 'not found';
+ is matchseq('a.b*c[d0e-f9g]h', '.*[0-9]'), 1, 'meta characters';
+ is matchseq('aa1', '.*[0-9]'), 0, 'not matching "regex"';
+ is matchseq('a.b.c', '.'), 2, 'matching literal dot'
+ }
+
+ done_testing;
+ exit;
+}
diff --git a/challenge-099/laurent-rosenfeld/blog.txt b/challenge-099/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..061b21b81d
--- /dev/null
+++ b/challenge-099/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/laurent_r/2021/02/perl-weekly-challenge-99-pattern-match-and-unique-subsequence.html
diff --git a/challenge-099/laurent-rosenfeld/perl/ch-1.pl b/challenge-099/laurent-rosenfeld/perl/ch-1.pl
new file mode 100644
index 0000000000..dbd4ff781b
--- /dev/null
+++ b/challenge-099/laurent-rosenfeld/perl/ch-1.pl
@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+use feature "say";
+
+my $input = "abcde";
+my @test_patterns = qw/a*e a*d ?b*d a*c?e/;
+for my $pat (@test_patterns) {
+ say "$pat: ", match($input, $pat)
+}
+
+sub match {
+ my ($in, $pattern) = @_;
+ $pattern =~ s/\*/.*/g;
+ $pattern =~ s/\?/./g;
+ $pattern = "^$pattern\$";
+ return $in =~ /$pattern/ ? 1 : 0;
+}
diff --git a/challenge-099/laurent-rosenfeld/perl/ch-2.pl b/challenge-099/laurent-rosenfeld/perl/ch-2.pl
new file mode 100644
index 0000000000..3f446f1853
--- /dev/null
+++ b/challenge-099/laurent-rosenfeld/perl/ch-2.pl
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use feature "say";
+
+my @input_tests = ( [ "littleit", "lit"], ["london", "lon"], ["aaaa", "aa"]);
+my $count;
+for my $in (@input_tests) {
+ $count = 0;
+ search_substr (@$in);
+ say "@$in: $count";
+}
+sub search_substr {
+ my ($in, $searched) = @_;
+ my $start = substr $searched, 0, 1;
+ my $index = 0;
+ while (1) {
+ $index = index $in, $start, $index;
+ return if $index < 0;
+ $index++;
+ ++$count and next if length $searched == 1;
+ search_substr (substr($in, $index), substr($searched, 1));
+ }
+}
diff --git a/challenge-099/laurent-rosenfeld/raku/ch-1.raku b/challenge-099/laurent-rosenfeld/raku/ch-1.raku
new file mode 100644
index 0000000000..881b11b7ab
--- /dev/null
+++ b/challenge-099/laurent-rosenfeld/raku/ch-1.raku
@@ -0,0 +1,21 @@
+use v6;
+
+my $in = "abcde";
+my @test-patterns = <a*e a*d ?b*d a*c?e>;
+for @test-patterns -> $test {
+ say "$test: ", match $test, $in;
+}
+
+sub match (Str $pattern, Str $in) {
+ my $regex =
+ join "", gather {
+ take '^';
+ for $pattern.comb {
+ when '*' { take '.*' }
+ when '?' { take '.' }
+ default { take $_ }
+ }
+ take '$';
+ }
+ return $in ~~ /<$regex>/ ?? 1 !! 0;
+}
diff --git a/challenge-099/laurent-rosenfeld/raku/ch-2.raku b/challenge-099/laurent-rosenfeld/raku/ch-2.raku
new file mode 100644
index 0000000000..a7b7ab274a
--- /dev/null
+++ b/challenge-099/laurent-rosenfeld/raku/ch-2.raku
@@ -0,0 +1,12 @@
+use v6;
+
+my @input-tests = [ "littleit", "lit"], ["london", "lon"];
+
+for @input-tests -> $test {
+ my ($in, $substr) = $test[0..1];
+ say "$test: ", search-substr $in, $substr;
+}
+sub search-substr (Str $in, Str $substr) {
+ my @results = $in.comb.combinations($substr.\
+ chars)>>.join("").grep({$_ eq $substr}).elems;
+}
diff --git a/challenge-099/wambash/raku/ch-1.raku b/challenge-099/wambash/raku/ch-1.raku
new file mode 100644
index 0000000000..46fb53a006
--- /dev/null
+++ b/challenge-099/wambash/raku/ch-1.raku
@@ -0,0 +1,19 @@
+#!/usr/bin/env raku
+
+sub pattern-match ( $s, $p ) {
+ my $re = $p.trans: < * ? > => < .* . >;
+ $s.match: / ^ <$re> $ /
+}
+
+multi MAIN (Bool :$test!) {
+ use Test;
+ ok pattern-match('abcde', 'a*e');
+ nok pattern-match('abcde', 'a*d');
+ nok pattern-match('abcde', '?b*d');
+ ok pattern-match('abcde', 'a*c?e');
+ done-testing;
+}
+
+multi MAIN ($s, $p) {
+ say +so pattern-match $s, $p
+}
diff --git a/challenge-099/wambash/raku/ch-2.raku b/challenge-099/wambash/raku/ch-2.raku
new file mode 100644
index 0000000000..2b554b28fe
--- /dev/null
+++ b/challenge-099/wambash/raku/ch-2.raku
@@ -0,0 +1,17 @@
+#!/usr/bin/env raku
+
+sub unique-subsequence ( $s, $t ) {
+ my $re = $t.comb.join: '.*';
+ $s.match: /<$re>/,:ex
+}
+
+multi MAIN (Bool :$test!) {
+ use Test;
+ is unique-subsequence('littleit', 'lit').Int,5;
+ is unique-subsequence('london', 'lon').Int, 3;
+ done-testing;
+}
+
+multi MAIN ($s, $t) {
+ say +unique-subsequence $s, $t,
+}
diff --git a/stats/pwc-current.json b/stats/pwc-current.json
index 21211d1c81..56a2e61d1a 100644
--- a/stats/pwc-current.json
+++ b/stats/pwc-current.json
@@ -1,18 +1,36 @@
{
- "legend" : {
- "enabled" : 0
- },
- "tooltip" : {
- "pointFormat" : "<span style='color:{point.color}'>{point.name}</span>: <b>{point.y:f}</b><br/>",
- "followPointer" : 1,
- "headerFormat" : "<span style='font-size:11px'>{series.name}</span><br/>"
- },
- "title" : {
- "text" : "Perl Weekly Challenge - 099"
- },
"drilldown" : {
"series" : [
{
+ "name" : "Arne Sommer",
+ "id" : "Arne Sommer",
+ "data" : [
+ [
+ "Perl",
+ 2
+ ],
+ [
+ "Raku",
+ 2
+ ],
+ [
+ "Blog",
+ 1
+ ]
+ ]
+ },
+ {
+ "name" : "Colin Crain",
+ "id" : "Colin Crain",
+ "data" : [
+ [
+ "Blog",
+ 1
+ ]
+ ]
+ },
+ {
+ "id" : "Dave Jacoby",
"data" : [
[
"Perl",
@@ -23,8 +41,7 @@
1
]
],
- "name" : "Dave Jacoby",
- "id" : "Dave Jacoby"
+ "name" : "Dave Jacoby"
},
{
"data" : [
@@ -33,12 +50,12 @@
2
]
],
- "name" : "E. Choroba",
- "id" : "E. Choroba"
+ "id" : "E. Choroba",
+ "name" : "E. Choroba"
},
{
- "id" : "Flavio Poletti",
"name" : "Flavio Poletti",
+ "id" : "Flavio Poletti",
"data" : [
[
"Perl",
@@ -51,8 +68,8 @@
]
},
{
- "id" : "Gustavo Chaves",
"name" : "Gustavo Chaves",
+ "id" : "Gustavo Chaves",
"data" : [
[
"Perl",
@@ -61,18 +78,59 @@
]
},
{
- "id" : "James Smith",
+ "name" : "James Smith",
+ "data" : [
+ [
+ "Perl",
+ 2
+ ],
+ [
+ "Blog",
+ 1
+ ]
+ ],
+ "id" : "James Smith"
+ },
+ {
+ "id" : "Jan Krnavek",
+ "data" : [
+ [
+ "Raku",
+ 2
+ ]
+ ],
+ "name" : "Jan Krnavek"
+ },
+ {
+ "id" : "Jorg Sommrey",
+ "data" : [
+ [
+ "Perl",
+ 2
+ ]
+ ],
+ "name" : "Jorg Sommrey"
+ },
+ {
+ "name" : "Laurent Rosenfeld",
"data" : [
[
"Perl",
2
+ ],
+ [
+ "Raku",
+ 2
+ ],
+ [
+ "Blog",
+ 1
]
],
- "name" : "James Smith"
+ "id" : "Laurent Rosenfeld"
},
{
"id" : "Luca Ferrari",
- "name" : "Luca Ferrari",
"data" : [
[
"Raku",
@@ -82,37 +140,38 @@
"Blog",
2
]
- ]
+ ],
+ "name" : "Luca Ferrari"
},
{
- "id" : "Mark Anderson",
+ "name" : "Mark Anderson",
"data" : [
[
"Raku",
2
]
],
- "name" : "Mark Anderson"
+ "id" : "Mark Anderson"
},
{
- "id" : "Nuno Vieira",
"data" : [
[
"Perl",
2
]
],
+ "id" : "Nuno Vieira",
"name" : "Nuno Vieira"
},
{
"name" : "Paulo Custodio",
+ "id" : "Paulo Custodio",
"data" : [
[
"Perl",
2
]
- ],<