diff options
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 new term. Also we increment $n for next step + $e += $t; # and just keep adding new terms +} +say $e; diff --git a/challenge-021/daniel-mantovani/perl5/ch-2.pl b/challenge-021/daniel-mantovani/perl5/ch-2.pl new file mode 100644 index 0000000000..3d0e09cd87 --- /dev/null +++ b/challenge-021/daniel-mantovani/perl5/ch-2.pl @@ -0,0 +1,54 @@ +# Write a script for URL normalization based on rfc3986. +# This task was shared by Anonymous Contributor. +# +# 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; +use v5.10; + +# After reading over RFC 3968, I think is much better to use a good module from CPAN +# for this kind of job. There are just too many cases to consider, so reinventing +# the wheel doesn't seem to be a good option here. +# +# There are two modules that catch my attention for RFC 3986 normalization: +# URI::Normalize +# URL::Normalize +# +# last one is heavier on dependences than the former, but I see it allows +# much more flexibility to fine tune the desired normalization + +use URL::Normalize; + +my $in = shift; # get url from command line +die "Usage: perl $0 <url-to-be-normalized>" unless $in; + |