Merge branch 'master' into contrib

68 files changed, 3112 insertions, 1531 deletions

diff --git a/challenge-098/alexander-pankoff/perl/ch-1.pl b/challenge-098/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..19294205aa
--- /dev/null
+++ b/challenge-098/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+{
+    my ( $FILE, @numbers ) = @ARGV;
+    say readN( $FILE, $_ ) for @numbers;
+}
+
+sub readN ( $file, $chars ) {
+    state $filehandles = {};
+
+    my $fh;
+    if ( $filehandles->{$file} ) {
+        $fh = $filehandles->{$file};
+    }
+    else {
+        open( $fh, '<', $file );
+        $fh->binmode( ':utf8' );
+        $filehandles->{$file} = $fh;
+    }
+
+    my $out;
+    while ( $chars-- && !$fh->eof ) {
+        $out .= $fh->getc;
+    }
+
+    return $out;
+}
diff --git a/challenge-098/alexander-pankoff/perl/ch-2.pl b/challenge-098/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..6031dfaebf
--- /dev/null
+++ b/challenge-098/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+use v5.20;
+use utf8;
+use strict;
+use warnings;
+use feature qw(say signatures);
+no warnings 'experimental::signatures';
+
+use List::Util qw(first);
+
+{
+    my @N = @ARGV;
+    my $N = pop @N;
+
+    say join( " ", '@N:', @N );
+    say join( " ", '$N:', $N );
+    my ( $index, @new_N ) = search_insert_position( $N, @N );
+
+    my $human_index = $index + 1;
+
+    say @new_N == @N
+      ? "$human_index since the target $N is in the array at the index $human_index."
+      : "$human_index since the target $N is missing and should be placed at the index $human_index."
+}
+
+sub search_insert_position ( $target, @xs ) {
+    my $index = first_index( sub($x) { $x >= $target }, @xs );
+
+    if ( !$index ) {
+        return ( $#xs + 1, @xs, $target );
+    }
+    elsif ( $xs[$index] && $xs[$index] == $target ) {
+        return ( $index, @xs );
+    }
+    else {
+        return ( $index, @xs[ 0 .. $index - 1 ], $target, @xs[ $index .. $#xs ] );
+    }
+}
+
+sub first_index ( $cond, @xs ) {
+    first { $cond->( $xs[$_] ) } 0 .. $#xs;
+}
diff --git a/challenge-098/bob-lied/README b/challenge-098/bob-lied/README
index be9398e9a3..07a4221a5d 100644
--- a/challenge-098/bob-lied/README
+++ b/challenge-098/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 83 by Bob Lied.
+Solutions to weekly challenge 98 by Bob Lied.
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-083/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-098/
diff --git a/challenge-098/bob-lied/perl/ch-1.pl b/challenge-098/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..59dfafcfe8
--- /dev/null
+++ b/challenge-098/bob-lied/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 098 Challenge 1
+# You are given file $FILE.
+# Create subroutine readN($FILE, $number) returns the first n-characters and
+# moves the pointer to the (n+1)th character.
+# Example:
+# 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"
+#=============================================================================
+
+use strict;
+use warnings;
+use v5.20;
+
+use experimental qw/signatures /;
+
+sub Usage { "Usage: $0 filename N" };
+
+my $FILE = shift;
+my $N        = shift;
+
+die Usage() unless $FILE;
+die Usage() unless $N;
+die "Need positive N" if ( $N <= 0 );
+
+# Cache open file handles per file.  The file handle will
+# keep track of the position in the file, advancing each time
+# that we call read().
+my %fileToFH;
+
+sub readN($s, $n)
+{
+    my $fh;
+    if ( exists $fileToFH{$s} )
+    {
+        $fh = $fileToFH{$s};
+    }
+    elsif ( open($fh, "<:utf8", $s) )
+    {
+        $fileToFH{$s} = $fh;
+    }
+    else
+    {
+        die "Invalid filename $s ($!)";
+    }
+    my $howmany = read($fh, my $bytes, $n);
+    return $bytes;
+}
+binmode(STDOUT, "utf8");
+say readN($FILE, $N);
+say readN($FILE, $N);
+say readN($FILE, $N);
diff --git a/challenge-098/jaldhar-h-vyas/blog.txt b/challenge-098/jaldhar-h-vyas/blog.txt
new file mode 100644
index 0000000000..88437d4900
--- /dev/null
+++ b/challenge-098/jaldhar-h-vyas/blog.txt
@@ -0,0 +1 @@
+https://www.braincells.com/perl/2021/02/perl_weekly_challenge_week_98.html
diff --git a/challenge-098/jaldhar-h-vyas/input.txt b/challenge-098/jaldhar-h-vyas/input.txt
new file mode 100644
index 0000000000..6a537b5b36
--- /dev/null
+++ b/challenge-098/jaldhar-h-vyas/input.txt
@@ -0,0 +1 @@
+1234567890
\ No newline at end of file
diff --git a/challenge-098/jaldhar-h-vyas/perl/ch-1.pl b/challenge-098/jaldhar-h-vyas/perl/ch-1.pl
new file mode 100755
index 0000000000..ab82a8e5e7
--- /dev/null
+++ b/challenge-098/jaldhar-h-vyas/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use 5.020;
+use warnings;
+use English qw / -no_match_vars /;
+
+sub readN {
+    my ($filename, $number) = @_;
+    my $buffer;
+    state $fh = undef;
+
+    if (!defined $fh) {
+        open $fh, '<', $filename or die "$OS_ERROR\n";
+    }
+
+    read $fh, $buffer, $number or die "$OS_ERROR\n";
+
+    return $buffer;
+}
+
+say readN('input.txt', 4);
+say readN('input.txt', 4);
+say readN('input.txt', 4);
diff --git a/challenge-098/jaldhar-h-vyas/perl/ch-2.pl b/challenge-098/jaldhar-h-vyas/perl/ch-2.pl
new file mode 100755
index 0000000000..d2785f19d7
--- /dev/null
+++ b/challenge-098/jaldhar-h-vyas/perl/ch-2.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+use 5.020;
+use warnings;
+use English qw / -no_match_vars /;
+
+sub usage {
+    print <<"-USAGE-";
+  $PROGRAM_NAME [<N> ...]
+  
+    [<N> ...]    a series of atleast 2 distinct integers. The last element will be used as a target to search in the previous elements.
+-USAGE-
+    exit 0;
+}
+
+if (scalar @ARGV < 2) {
+    usage();
+}
+
+my $N = pop @ARGV;
+my $pos = scalar @ARGV;
+
+for my $i (0 .. scalar @ARGV - 1) {
+    if ($ARGV[$i] >= $N) {
+        $pos = $i;
+        last;
+    }
+}
+
+say $pos;
\ No newline at end of file
diff --git a/challenge-098/jaldhar-h-vyas/raku/ch-1.raku b/challenge-098/jaldhar-h-vyas/raku/ch-1.raku
new file mode 100755
index 0000000000..9db5d0fa5c
--- /dev/null
+++ b/challenge-098/jaldhar-h-vyas/raku/ch-1.raku
@@ -0,0 +1,21 @@
+#!/usr/bin/raku
+
+sub readN(Str $filename, Int $number) {
+    state IO::Handle $fn = Nil;
+
+    try {
+        unless $fn {
+            $fn = $filename.IO.open(:r);
+        }
+
+        return $fn.readchars($number);
+    }
+
+    die $!;
+}
+
+sub MAIN() {
+    say readN('input.txt', 4);
+    say readN('input.txt', 4);
+    say readN('input.txt', 4);
+}
\ No newline at end of file
diff --git a/challenge-098/jaldhar-h-vyas/raku/ch-2.raku b/challenge-098/jaldhar-h-vyas/raku/ch-2.raku
new file mode 100755
index 0000000000..b96823fe58
--- /dev/null
+++ b/challenge-098/jaldhar-h-vyas/raku/ch-2.raku
@@ -0,0 +1,19 @@
+#!/usr/bin/raku
+
+sub MAIN(
+    *@N #= a series of atleast 2 distinct integers. The last element will be
+        #= used as a target to search in the previous elements.
+    where {@_.elems > 1 }
+) {
+    my $N = @N.pop;
+    my $pos = @N.elems;
+
+    for 0 ..^ @N.elems -> $i {
+        if @N[$i] >= $N {
+            $pos = $i;
+            last;
+        }
+    }
+
+    say $pos;
+}
\ No newline at end of file
diff --git a/challenge-099/e-choroba/perl/ch-1.pl b/challenge-099/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..46a0adc6e0
--- /dev/null
+++ b/challenge-099/e-choroba/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub pattern_match {
+    my ($string, $pattern) = @_;
+    $pattern = quotemeta $pattern;
+    s/\\\?/./g, s/\\\*/.*/g for $pattern;
+    return $string =~ /^$pattern$/ ? 1 : 0
+}
+
+use Test::More tests => 8;
+
+is pattern_match('abcde', 'a*e'),   1, 'Example 1';
+is pattern_match('abcde', 'a*d'),   0, 'Example 2';
+is pattern_match('abcde', '?b*d'),  0, 'Example 3';
+is pattern_match('abcde', 'a*c?e'), 1, 'Example 4';
+
+is pattern_match('abcde', 'a*'),  1, 'Trailing star';
+is pattern_match('abcde', '*de'), 1, 'Leading star';
+is pattern_match('abcde', 'a*c*e'), 1, 'Two stars';
+is pattern_match('(a!)b{c}$1d', '(?!)b{?}$1*'), 1, 'No injection';
diff --git a/challenge-099/e-choroba/perl/ch-1a.pl b/challenge-099/e-choroba/perl/ch-1a.pl
new file mode 100755
index 0000000000..ffd3e6075e
--- /dev/null
+++ b/challenge-099/e-choroba/perl/ch-1a.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub pattern_match {
+    my ($string, $pattern) = @_;
+    return 1 if "" eq $string . $pattern;
+
+    my ($string_first,  $string_rest)  = $string  =~ /(.)(.*)/;
+    my ($pattern_first, $pattern_rest) = $pattern =~ /(.)(.*)/;
+
+    my $action = {
+        '?' => sub {
+            return 0 unless length $pattern;
+            return pattern_match($string_rest, $pattern_rest)
+        },
+        '*' => sub {
+            for my $pos (1 .. length $string) {
+                return 1
+                    if pattern_match(substr($string, $pos), $pattern_rest);
+            }
+            return 0
+        },
+    }->{ $pattern_first // "" } || sub {
+        return 0 if ($pattern_first // "") ne ($string_first // "");
+
+        return pattern_match($string_rest, $pattern_rest)
+    };
+    return $action->()
+}
+
+use Test::More tests => 8;
+
+is pattern_match('abcde', 'a*e'),   1, 'Example 1';
+is pattern_match('abcde', 'a*d'),   0, 'Example 2';
+is pattern_match('abcde', '?b*d'),  0, 'Example 3';
+is pattern_match('abcde', 'a*c?e'), 1, 'Example 4';
+
+is pattern_match('abcde', 'a*'),    1, 'Trailing star';
+is pattern_match('abcde', '*de'),   1, 'Leading star';
+is pattern_match('abcde', 'a*c*e'), 1, 'Two stars';
+is pattern_match('(a!)b{c}$1d', '(?!)b{?}$1*'), 1, 'Random garbage';
diff --git a/challenge-099/e-choroba/perl/ch-2.pl b/challenge-099/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..d32a396c8d
--- /dev/null
+++ b/challenge-099/e-choroba/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# Count the subsequences.
+sub unique_subsequence {
+    my ($string, $subsequence) = @_;
+    if (1 == length $subsequence) {
+        my $count = () = $string =~ /\Q$subsequence/g;
+        return $count
+    }
+    my $char = substr $subsequence, 0, 1, "";
+    my ($count, $pos) = (0, 0);
+    $count += unique_subsequence(substr($string, $pos++), $subsequence)
+        while -1 != ($pos = index $string, $char, $pos);
+    return $count
+}
+
+# Return all the possible positions that match the subsequence.
+sub show_unique_subsequence {
+    my ($string, $subsequence) = @_;
+    my @solutions;
+    for my $sub_pos (0 .. length($subsequence) - 1) {
+        my $sub_char = substr $subsequence, $sub_pos, 1;
+        my $str_pos = 0;
+        my @partial;
+        push @partial, $str_pos++
+            while -1 != ($str_pos = index $string, $sub_char, $str_pos);
+        @solutions = map {
+            my $solution = $_;
+            map { $_ > $solution->[-1] ? [@$solution, $_] : () } @partial;
+        } @solutions;
+        @solutions = map [$_], @partial unless @solutions;  # First character.
+    }
+    return \@solutions
+}
+
+use Test::More tests => 6;
+
+is unique_subsequence('littleit', 'lit'), 5, 'Example 1';
+is unique_subsequence('london', 'lon'), 3, 'Example 2';
+is unique_subsequence('london', 'par'), 0, 'Zero';
+
+
+is_deeply show_unique_subsequence('littleit', 'lit'),
+          [[0, 1, 2], [0, 1, 3], [0, 1, 7], [0, 6, 7], [4, 6, 7]],
+          'Show Example 1';
+
+is_deeply show_unique_subsequence('london', 'lon'),
+          [[0, 1, 2], [0, 1, 5], [0, 4, 5]],
+          'Show Example 2';
+
+is_deeply show_unique_subsequence('london', 'par'), [], 'Show Zero';
diff --git a/challenge-099/gustavo-chaves/perl/ch-1.pl b/challenge-099/gustavo-chaves/perl/ch-1.pl
new file mode 100755
index 0000000000..a11b6d7390
--- /dev/null
+++ b/challenge-099/gustavo-chaves/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-099/
+# TASK #1 › Pattern Match
+
+use 5.030;
+use warnings;
+
+my ($S, $P) = @ARGV;
+
+say "Pattern: '$P'";
+
+say match($P, $S) ? "Matches: " : "Does not match: ", "'$S'";
+
+sub match {
+    my ($pattern, $string) = @_;
+
+    my ($s, $p) = (0, 0);
+
+  CHAR:
+    while ($p < length($pattern) && $s < length($string)) {
+        my $c = substr($pattern, $p, 1);
+
+        if ($c eq '?') {
+            ++$s;
+            ++$p;
+        } elsif ($c eq '*') {
+            my $patterntail = substr($pattern, $p+1);
+            for (my $i=$s; $i < length($string); ++$i) {
+                return 1 if match($patterntail, substr($string, $i));
+            }
+            return 0;
+        } elsif ($c eq substr($string, $s, 1)) {
+            ++$s;
+            ++$p;
+        } else {
+            return 0;
+        }
+    }
+
+    return $p == length($pattern) && $s == length($string);
+}
diff --git a/challenge-099/gustavo-chaves/perl/ch-2.pl b/challenge-099/gustavo-chaves/perl/ch-2.pl
new file mode 100755
index 0000000000..25f36ff228
--- /dev/null
+++ b/challenge-099/gustavo-chaves/perl/ch-2.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-099/
+# TASK #2 › Unique Subsequence
+
+use 5.030;
+use warnings;
+
+my ($S, $T) = @ARGV;
+
+sub matches {
+    my ($s, $t) = @_;
+
+    return 1 if $t == length($T);
+
+    my $matches = 0;
+
+    my $c = substr($T, $t, 1);
+    foreach my $i ($s .. length($S)-1) {
+        if ($c eq substr($S, $i, 1)) {
+            $matches += matches($i+1, $t+1);
+        }
+    }
+
+    return $matches;
+}
+
+say matches(0, 0);
diff --git a/challenge-099/luca-ferrari/blog-1.txt b/challenge-099/luca-ferrari/blog-1.txt
new file mode 100644
index 0000000000..57e7046809
--- /dev/null
+++ b/challenge-099/luca-ferrari/blog-1.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2021/02/08/PerlWeeklyChallenge99.html#task1
diff --git a/challenge-099/luca-ferrari/blog-2.txt b/challenge-099/luca-ferrari/blog-2.txt
new file mode 100644
index 0000000000..8247db63d4
--- /dev/null
+++ b/