Merge pull request #3505 from arnesom/branch-for-challenge-099

Arne Sommer

9 files changed, 251 insertions, 0 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;
+
+