Merge remote-tracking branch 'upstream/master'

49 files changed, 2920 insertions, 693 deletions

diff --git a/challenge-021/andrezgz/perl5/ch-1.pl b/challenge-021/andrezgz/perl5/ch-1.pl
new file mode 100644
index 0000000000..c7bb8de8d7
--- /dev/null
+++ b/challenge-021/andrezgz/perl5/ch-1.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-021/
+# Task #1
+# Write a script to calculate the value of e, also known as Euler's number and Napier's constant.
+# Please checkout wiki page for more information.
+# https://en.wikipedia.org/wiki/E_(mathematical_constant)
+
+use strict;
+use warnings;
+
+my $e_aprox = 0;
+my $fact = 1;
+for (1, 1 .. 100) { #tricky - additional 1 to represent 0!
+    $fact *= $_;
+    $e_aprox += 1/$fact;
+}
+
+print $e_aprox;
diff --git a/challenge-021/andrezgz/perl5/ch-2.pl b/challenge-021/andrezgz/perl5/ch-2.pl
new file mode 100644
index 0000000000..b20bb2c2da
--- /dev/null
+++ b/challenge-021/andrezgz/perl5/ch-2.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+
+# https://perlweeklychallenge.org/blog/perl-weekly-challenge-021/
+# Task #2
+# Write a script for URL normalization based on rfc3986. This task was shared by Anonymous Contributor.
+# https://en.wikipedia.org/wiki/URL_normalization
+# According to Wikipedia, URL normalization is the process by which URLs are modified and standardized
+# in a consistent manner. The goal of the normalization process is to transform a URL into a normalized URL
+# so it is possible to determine if two syntactically different URLs may be equivalent.
+
+use strict;
+use warnings;
+
+my $url_in = $ARGV[0]
+  || 'HTTPS://www.Example.com:443/a%c2%b1b/%7Eandrezgz/bar.html?pi=3%2e14#hi%2Dthere';
+
+print 'Original:'.$/;
+print $url_in.$/.$/;
+
+my ($scheme, $auth, $path, $query, $frag, $userinfo, $host, $port);
+
+($scheme, $auth, $path, $query, $frag) = uri_split($url_in);
+($userinfo, $host, $port) = auth_split($auth) if $auth;
+
+# Normalizations that preserve semantics
+
+## Converts the scheme and host to lower case.
+($scheme, $host) = map { lc $_ } ($scheme, $host);
+
+## Capitalizes letters in escape sequences.
+## Decodes percent-encoded octets of unreserved characters.
+($path, $query, $frag) =
+    map { my $comp = $_;
+          $comp =~ s{%([A-Fa-f0-9]{2})}
+                    { my $chr = chr(hex($1));
+                      $chr =~ /^[A-Za-z0-9\-_\.~]$/ ? $chr : '%'.uc $1;
+                    }ge if $comp;
+          $comp;
+        } ($path, $query, $frag);
+
+## Removes the default port (port 80 for http).
+my %default_ports = (
+    ftp     => 21,    gopher  => 70,    http    => 80,    https   => 443,
+    ldap    => 389,   ldaps   => 636,   mms     => 1755,  news    => 119,
+    pop     => 110,   rlogin  => 513,   rsync   => 873,   rtsp    => 554,
+    rstpu   => 554,   sip     => 5060,  sips    => 5061,  snews   => 563,
+    ssh     => 22,    telnet  => 23,    tn3270  => 23,
+);
+$port = '' if ($port == $default_ports{$scheme});
+
+print 'Normalized:'.$/;
+print uri_join($scheme, $userinfo, $host, $port, $path, $query, $frag).$/;
+
+
+sub uri_join {
+  my ($scheme, $userinfo, $host, $port, $path, $query, $frag) = @_;
+
+  my $uri = $scheme . ':';
+  if ($host) {
+    $uri .= '//';
+    $uri .= $userinfo . '@' if ($userinfo);
+    $uri .= $host;
+    $uri .= ':' . $port if ($port);
+  }
+  $uri .= $path;
+  $uri .= '?' . $query if ($query);
+  $uri .= '#' . $frag if ($frag);
+
+  return $uri;
+}
+
+
+# functions created in challenge-017/andrezgz/perl5/ch-2.pl
+sub uri_split {
+     return $_[0] =~ m|
+                        ^                       # string start
+                        ([^/?\#]+) :            # scheme
+                        (?: // ([^/?\#]*) )?    # authority (optional)
+                        ([^?\#]*)               # path
+                        (?: \? ([^\#]*) )?      # query (optional)
+                        (?: \# (.*) )?          # fragment (optional)
+                        $                       # string end
+                    |x;
+}
+
+sub auth_split {
+     return $_[0] =~ m|
+                        (?: ([^@]+) @ )?        # userinfo (optional)
+                        ([^:/?\#]+)             # host
+                        (?: : (\d+) )?          # port (optional)
+                    |x;
+}
diff --git a/challenge-021/arne-sommer/blog.txt b/challenge-021/arne-sommer/blog.txt
new file mode 100644
index 0000000000..af82960451
--- /dev/null
+++ b/challenge-021/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://perl6.eu/eulers-url.html
diff --git a/challenge-021/arne-sommer/perl6/ch-1.p6 b/challenge-021/arne-sommer/perl6/ch-1.p6
new file mode 100755
index 0000000000..d741dba7ee
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/ch-1.p6
@@ -0,0 +1,20 @@
+#! /usr/bin/env perl6
+
+my $e-seq := gather
+{
+  take 1;
+
+  my $current = 1;
+
+  for 1 .. Inf
+  {
+    $current /= $_;
+    take $current;
+  }
+}
+
+sub MAIN (:$steps = 10)
+{
+  say $e-seq[^$steps].sum;
+}
+
diff --git a/challenge-021/arne-sommer/perl6/ch-2.p6 b/challenge-021/arne-sommer/perl6/ch-2.p6
new file mode 100755
index 0000000000..da361df95d
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/ch-2.p6
@@ -0,0 +1,109 @@
+#! /usr/bin/env perl6
+
+grammar URL
+{
+  regex TOP       { <SchemeW> <Hostinfo>? <Path>? <QueryW>? <FragmentW>? }
+  regex SchemeW   { <Scheme> <SchemeS> }
+  regex SchemeS   { ':' }
+  regex Scheme    { <[a..z A..Z]><[a..z A..Z 0..9 + . : \-]>* }
+  regex Hostinfo  { '//' <UserinfoW>? <Host> <PortW>? }
+  regex UserinfoW { <Userinfo> <UserinfoS> }
+  regex Userinfo  { .*[\:.+]? }
+  regex UserinfoS { '@' }
+  regex Host      { <[\w \. \-]>* }
+  regex PortW     { <PortS> <Port> }
+  regex PortS     { ':' }
+  regex Port      { \d+ }
+  regex Path      { '/'? <[\w \d / % \. - ] - [#?]>+ }
+  regex QueryW    { <QueryS> <Query> }
+  regex QueryS    { '?'  }
+  regex Query     { <[\w \d \- =]>* }
+  regex FragmentW { <FragmentS> <Fragment> }
+  regex FragmentS { '#' }
+  regex Fragment  { .+ }
+}
+
+sub MAIN ($url, :$verbose)
+{
+  my %ports = ( ftp => 20, http => 80, https => 443 );
+  my Set $unreserved = ("41" ... "49", "4A" ... "4F", "50" ... "59", "5A", "30" ... "39", "2D", "2E", "5F", "7E").flat.Set;
+
+  my %translate; %translate{'%' ~ $_} = chr( $_.parse-base(16) ) for $unreserved.keys;
+
+  my $result = URL.parse($url);
+
+  if $result
+  {
+    say $result, "\n" if $verbose;
+    
+    my $scheme = $result<SchemeW><Scheme>.lc;
+    my $new    = $scheme ~ ":";
+    say "scheme:   $result<SchemeW><Scheme> -> $scheme" if $verbose;
+
+    my $userinfo = ""; if $result<Hostinfo><UserinfoW><Userinfo>
+    {
+      $userinfo = $result<Hostinfo><UserinfoW><Userinfo>;
+      $new ~= $userinfo ~ '@';
+      say "userinfo: $userinfo" if $verbose;
+    }
+
+    my $host = ""; if $result<Hostinfo><Host>
+    {
+      $host = $result<Hostinfo><Host>.lc;
+      $new ~= "//$host" if $host;
+      say "host:     $result<Hostinfo><Host> -> $host" if $verbose;
+    }
+
+    my $port = ""; if $result<Hostinfo><PortW><Port>
+    {
+      $port = $result<Hostinfo><PortW><Port> unless %ports{$scheme} == $result<Hostinfo><PortW><Port>;
+      $new ~= ":$port" if $port;
+      say "port:     $result<Hostinfo><PortW><Port> -> $port" if $verbose;
+    }
+
+    my $path = ""; if $result<Path>
+    {
+      $path = $result<Path>;
+      my $new-path = $path;
+      
+      if $path ~~ /\%/
+      {   
+        $new-path .= subst(/\%../, *.uc, :g);
+
+        for %translate.keys -> $key
+	{
+	  if $new-path ~~ /$key/
+	  {
+	    say "          (path translate $key -> %translate{$key})" if $verbose;
+            $new-path .= subst($key, %translate{$key}, :g);
+          }
+        }
+      }
+      $new ~= $new-path;
+      say "path:     $path -> $new-path" if $verbose;
+    }
+
+    my $query; if $result<QueryW><Query>
+    {
+      $query = $result<QueryW><Query>;
+      $new ~= "?$query";
+      say "query:    $query" if $verbose;
+    }
+
+    my $fragment = ""; if $result<FragmentW><Fragment>
+    {
+      $fragment = $result<FragmentW><Fragment>;
+      $new ~= "#$fragment";
+      say "fragment: $fragment" if $verbose;
+    }
+
+    print "\n" if $verbose;
+    
+    say "Original: $url";
+    say "New:      $new";
+  }
+  else
+  {
+    say "Invalid URL.";
+  }
+}
diff --git a/challenge-021/arne-sommer/perl6/finding-e-fatrat b/challenge-021/arne-sommer/perl6/finding-e-fatrat
new file mode 100755
index 0000000000..cbc9b9b6be
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/finding-e-fatrat
@@ -0,0 +1,22 @@
+#! /usr/bin/env perl6
+
+my $e-seq := gather
+{
+  take 1;
+
+  my FatRat $current = 1.FatRat;
+
+  for 1 .. Inf
+  {
+    $current /= $_;
+    take $current;
+  }
+}
+
+sub MAIN (:$steps = 10, :$verbose)
+{
+  $verbose && say "{$_ + 1}: { $e-seq[$_].perl }" for ^$steps;
+  
+  say $e-seq[^$steps].sum;
+}
+
diff --git a/challenge-021/arne-sommer/perl6/finding-e-fatrat-test b/challenge-021/arne-sommer/perl6/finding-e-fatrat-test
new file mode 100755
index 0000000000..2a4cd7d413
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/finding-e-fatrat-test
@@ -0,0 +1,55 @@
+#! /usr/bin/env perl6
+
+my $e-seq := gather
+{
+  take 1;
+
+  my FatRat $current = 1.FatRat;
+
+  for 1 .. Inf
+  {
+    $current /= $_;
+    take $current;
+  }
+}
+
+sub MAIN (:$steps = 10, :$verbose, :$test)
+{
+  $verbose && say "{$_ + 1}: { $e-seq[$_].perl }" for ^$steps;
+
+  my $value = $e-seq[^$steps].sum;
+
+  if $test
+  {
+    my $long = get-euler-from-web;
+
+    print "Answer:  ";
+    for ^$value.chars -> $pos
+    {
+      $value.substr($pos, 1) eq $long.substr($pos, 1)
+      ?? print $value.substr($pos, 1)
+      !! print "\x1b[41m" ~ $value.substr($pos, 1) ~ "\x1b[0m";
+    }
+    print "\n";
+    say "Correct: " ~ $long.substr(0, $value.chars + 2) ~ "...";
+
+  }
+  else
+  {
+    say $e-seq[^$steps].sum;
+  }
+}
+
+sub get-euler-from-web
+{
+  use LWP::Simple;
+
+  my $e-string = "";
+
+  for LWP::Simple.get('http://www-history.mcs.st-and.ac.uk/HistTopics/e_10000.html').lines -> $line
+  {
+    $e-string ~= $line.trim unless $line ~~ /<[a .. z A .. Z]>/; # Skip lines with html tags
+  }
+
+  return $e-string;
+}
diff --git a/challenge-021/arne-sommer/perl6/finding-e-fatrat-test-cached b/challenge-021/arne-sommer/perl6/finding-e-fatrat-test-cached
new file mode 100755
index 0000000000..2d66fde1c7
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/finding-e-fatrat-test-cached
@@ -0,0 +1,67 @@
+#! /usr/bin/env perl6
+
+my $e-seq := gather
+{
+  take 1;
+
+  my FatRat $current = 1.FatRat;
+
+  for 1 .. Inf
+  {
+    $current /= $_;
+    take $current;
+  }
+}
+
+sub MAIN (:$steps = 10, :$verbose, :$test)
+{
+  $verbose && say "{$_ + 1}: { $e-seq[$_].perl }" for ^$steps;
+
+  my $value = $e-seq[^$steps].sum;
+
+  if $test
+  {
+    my $long = get-euler-from-web($test);
+
+    print "Answer:  ";
+    for ^$value.chars -> $pos
+    {
+      $value.substr($pos, 1) eq $long.substr($pos, 1)
+      ?? print $value.substr($pos, 1)
+      !! print "\x1b[41m" ~ $value.substr($pos, 1) ~ "\x1b[0m";
+    }
+    print "\n";
+    say "Correct: " ~ $long.substr(0, $value.chars + 2) ~ "...";
+
+  }
+  else
+  {
+    say $e-seq[^$steps].sum;
+  }
+}
+
+sub get-euler-from-web ($test)
+{
+  use LWP::Simple;
+
+  my $e-string = "";
+
+  if $test eq "cached"
+  {
+    say "Loaded cached e.";
+    return $*TMPDIR.add('euler_10000.txt').slurp if $*TMPDIR.add('euler_10000.txt').e;
+  }
+
+  for LWP::Simple.get('http://www-history.mcs.st-and.ac.uk/HistTopics/e_10000.html').lines -> $line
+  {
+    $e-string ~= $line.trim unless $line ~~ /<[a .. z A .. Z]>/; # Skip lines with html tags
+  }
+  
+  if $test eq "cached"
+  {
+    $*TMPDIR.add('euler_10000.txt').spurt: $e-string;
+    say "Saved cached e.";
+  }
+
+  return $e-string;
+}
diff --git a/challenge-021/arne-sommer/perl6/finding-e-fixed b/challenge-021/arne-sommer/perl6/finding-e-fixed
new file mode 100755
index 0000000000..cdb8111819
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/finding-e-fixed
@@ -0,0 +1,20 @@
+#! /usr/bin/env perl6
+
+my $e-seq := gather
+{
+  take 1;
+
+  my FatRat $current = 1.FatRat;
+
+  for 1 .. Inf
+  {
+    $current /= $_;
+    take $current;
+  }
+}
+
+sub MAIN (:$steps = 10)
+{
+  say $e-seq[^$steps].sum;
+}
+
diff --git a/challenge-021/arne-sommer/perl6/finding-e-verbose b/challenge-021/arne-sommer/perl6/finding-e-verbose
new file mode 100755
index 0000000000..ae3a45b530
--- /dev/null
+++ b/challenge-021/arne-sommer/perl6/finding-e-verbose
@@ -0,0 +1,22 @@
+#! /usr/bin/env perl6
+
+my $e-seq := gather
+{
+  take 1;
+  
+  my $current = 1;
+
+  for 1 .. Inf
+  {
+    $current /= $_;
+    take $current;
+  }
+}
+
+sub MAIN (:$steps = 10, :$verbose)
+{
+  $verbose && say "{ $_ + 1 }: { $e-seq[$_].perl }" for ^$steps;
+
+  say $e-seq[^$steps].sum;
+}
+
diff --git a/challenge-021/athanasius/perl5/ch-1.pl b/challenge-021/athanasius/perl5/ch-1.pl
new file mode 100644
index 0000000000..42796cdb3f
--- /dev/null
+++ b/challenge-021/athanasius/perl5/ch-1.pl
@@ -0,0 +1,96 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 021
+=========================
+
+Task #1
+-------
+Write a script to calculate the value of *e*, also known as *Euler's number* and
+*Napier's constant*. Please checkout wiki [ https://en.wikipedia.org/wiki/
+E_(mathematical_constant) |page] for more information.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use bignum;
+use Const::Fast;
+use Getopt::Long;
+
+const my $PRECISION => 50;
+const my $USAGE     => "USAGE: perl $0 [--precision <UInt>]\n";
+
+BEGIN
+{
+    print "\n";
+}
+
+MAIN:
+{
+    my $precision = $PRECISION;
+
+    GetOptions
+    (
+        'precision=i' => \$precision,
+
+    ) or die $USAGE;
+
+    $precision >= 0
+        or die "Invalid precision \"$precision\"\n$USAGE";
+
+    my $accuracy = $precision + 3;
+
+    Math::BigFloat->accuracy($accuracy);
+
+    my $e_prev = Math::BigFloat->bone('-');;
+    my $e_next = Math::BigFloat->bzero;
+    my $n      = 0;
+
+    while ($e_prev->blt($e_next))
+    {
+        $e_prev = $e_next->copy;
+        my $d   = $n++ * 2;
+        $e_next->badd( ($d + 2) / factorial($d + 1) );
+    }
+
+     --$n;
+       $accuracy   -= 2;
+    my $e_truncated = $e_next->copy->bround($accuracy, 'trunc');
+    my $e_rounded   = $e_next->copy->bround($accuracy, 'even');
+
+    print "After $n steps of the H J Brothers convergence series,\n",
+          "   e = ", $e_truncated, " (truncated)\n",
+          "or e = ", $e_rounded,   " (rounded)\n",
+          "with a precision of $precision decimal place",
+          ($precision == 1 ? '' : 's'), ".\n";
+}
+
+sub factorial
+{
+    my ($n) = @_;
+    my  $f  = 1;
+        $f *= $_ for 2 .. $n;
+
+    return $f;
+}
+
+################################################################################
+
+__END__
+
+The H J Brothers convergence series:
+
+e = Sum[n = 0 .. Inf] ( (2n + 2) / (2n + 1)! )
+
+References:
+
+-- https://www.intmath.com/exponential-logarithmic-functions/calculating-e.php
+-- http://www.brotherstechnology.com/docs/icnsae_(cmj0104-300dpi).pdf
diff --git a/challenge-021/athanasius/perl6/ch-1.p6 b/challenge-021/athanasius/perl6/ch-1.p6
new file mode 100644
index 0000000000..12095892b1
--- /dev/null
+++ b/challenge-021/athanasius/perl6/ch-1.p6
@@ -0,0 +1,67 @@
+use v6;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 021
+=========================
+
+Task #1
+-------
+Write a script to calculate the value of *e*, also known as *Euler's number* and
+*Napier's constant*. Please checkout wiki [ https://en.wikipedia.org/wiki/
+E_(mathematical_constant) |page] for more information.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2019 PerlMonk Athanasius #
+#--------------------------------------#
+
+my UInt constant $PRECISION = 50;
+my UInt constant $MARGIN    =  5;      # Additional precision to ensure that the
+                                       #    convergence calculations are correct
+
+BEGIN say '';
+
+#-------------------------------------------------------------------------------
+# For the use of FatRat, see brian d foy, "As Many Digits as You Like,"
+# https://www.learningperl6.com/2017/04/24/as-many-digits-as-you-like/
+#-------------------------------------------------------------------------------
+
+sub MAIN(UInt:D :$precision = $PRECISION)
+{
+    my FatRat $e      = FatRat.new(0, 1);
+    my UInt   $target = $precision + 2 + $MARGIN;    # "+ 2" is for leading "2."
+    my UInt   $n      = 0;
+
+    while $e.Str.chars <= $target
+    {
+        my UInt $d = $n++ * 2;
+
+        $e += ($d + 2).FatRat / factorial($d + 1);
+    }
+
+            --$n;
+    my Str    $e-truncated = $e.substr(0 .. ($precision + 1));
+              $e-truncated = $e-truncated.chop if $e-truncated.chars == 2;
+    my FatRat $unit        = FatRat.new(1, 10 ** $precision);
+    my Str    $e-rounded   = $e.round($unit).Str;
+
+    say "After $n steps of the H J Brothers convergence series,\n",
+        "   e = ", $e-truncated, " (truncated)\n",
+        "or e = ", $e-rounded,   " (rounded)\n",
+        "with a precision of $precision decimal place",
+        ($precision == 1 ?? '.' !! 's.');
+}
+
+sub factorial(UInt:D $n --> UInt:D)
+{
+    my UInt $f  = 1;
+            $f *= $_ for 2 .. $n;
+
+    return $f;
+}
+
+################################################################################
diff --git a/challenge-021/daniel-mantovani/perl5/ch-1.pl b/challenge-021/daniel-mantovani/perl5/ch-1.pl
new file mode 100644
index 0000000000..b2fcef5b53
--- /dev/null
+++ b/challenge-021/daniel-mantovani/perl5/ch-1.pl
@@ -0,0 +1,33 @@
+# Write a script to calculate the value of e, also known as Euler’s number and Napier’s constant.
+# Please checkout wiki page for more information.
+
+use strict;
+use warnings;
+use v5.10;
+
+# As Perl already has a "exp" function (see https://perldoc.perl.org/5.30.0/functions/exp.html)
+# we could just use it like:
+#
+# say exp(1);
+#
+# but I'm pretty sure this was not the intent of the challenge :)
+#
+# So we will are going to calculate the series formula:
+#
+# e = 1 + 1/1 + 1/(1 *2) + 1/(1 * 2 * 3) + 1/(1 * 2 * 3 * 4) + ... +
+#
+# until our sum don't grow anymore, and that will be our approximation to the result
+#
+# Note that each term could be calculated dividing the former term by a growing integer
+#
+my $e = 1; # this will be our final value. We already have the first "1" on it
+my $n = 1; # this will be the term number, incrementing after we add a new term
+my $t = 1; # this is current term. It will be divided by $n to get following one
+
+# we will stop calculation when $t is so small it is considered as a 0 by Perl internal
+# math
+while ($t) {
+    $t /= $n++;    # calculate