aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdam Russell <ac.russell@live.com>2019-08-18 18:00:29 -0400
committerAdam Russell <ac.russell@live.com>2019-08-18 18:00:29 -0400
commit64c3a44ea7c3ffcaeca25ddb4da45233b7608394 (patch)
tree68ac57f5ddefec3c66d2c3741beabde66a15f0e0
parent5383452fd7c187d11d53a6982255cdfa5f36a51b (diff)
downloadperlweeklychallenge-club-64c3a44ea7c3ffcaeca25ddb4da45233b7608394.tar.gz
perlweeklychallenge-club-64c3a44ea7c3ffcaeca25ddb4da45233b7608394.tar.bz2
perlweeklychallenge-club-64c3a44ea7c3ffcaeca25ddb4da45233b7608394.zip
solutions for challenge 021
-rw-r--r--challenge-021/adam-russell/blog.txt2
-rw-r--r--challenge-021/adam-russell/perl5/UrlGrammar.yp57
-rw-r--r--challenge-021/adam-russell/perl5/UrlParser.pm272
-rw-r--r--challenge-021/adam-russell/perl5/ch-1.pl35
-rw-r--r--challenge-021/adam-russell/perl5/ch-2.pl14
-rw-r--r--challenge-021/adam-russell/perl6/ch-1.p644
6 files changed, 424 insertions, 0 deletions
diff --git a/challenge-021/adam-russell/blog.txt b/challenge-021/adam-russell/blog.txt
new file mode 100644
index 0000000000..b685371fce
--- /dev/null
+++ b/challenge-021/adam-russell/blog.txt
@@ -0,0 +1,2 @@
+https://adamcrussell.livejournal.com/6924.html
+https://adamcrussell.livejournal.com/7347.html
diff --git a/challenge-021/adam-russell/perl5/UrlGrammar.yp b/challenge-021/adam-russell/perl5/UrlGrammar.yp
new file mode 100644
index 0000000000..18c259c897
--- /dev/null
+++ b/challenge-021/adam-russell/perl5/UrlGrammar.yp
@@ -0,0 +1,57 @@
+%token '://' SCHEME USERPASSWORD HOST PORT PATH QUERY FRAGMENT
+%%
+url: scheme colondoubleslash userpassword host port path query fragment
+ | scheme colondoubleslash host path query fragment
+ | scheme colondoubleslash host path fragment
+ | scheme colondoubleslash host path
+ | scheme colondoubleslash host
+;
+colondoubleslash: '://' { print $_[1] }
+;
+scheme: SCHEME { print lc($_[1]) }
+;
+userpassword: USERPASSWORD { print $_[1] }
+;
+host: HOST { print lc($_[1]) }
+;
+port: PORT { $_[1] =~ s/://; print "" }
+;
+path: PATH { print $_[1] }
+;
+query: QUERY { print $_[1] }
+;
+fragment: FRAGMENT { print "" }
+;
+%%
+sub lexer{
+ my($parser) = @_;
+ $parser->YYData->{INPUT} or return('', undef);
+ $parser->YYData->{INPUT} =~ s/^[ \t]//;
+ ##
+ # send tokens to parser
+ ##
+ for($parser->YYData->{INPUT}){
+ s/^(http|https|ftp|jdbc)//i and return ("SCHEME", $1);
+ s/^(:\/\/)// and return ("://", $1);
+ s/^(:[0-9]*)// and return ("PORT", $1);
+ s/^([a-zA-Z]*:[a-zA-Z]*)// and return ("USERPASSWORD", $1);
+ s/^(\/[\/a-zA-Z]*)// and return ("PATH", $1);
+ s/^(\?{1}[a-zA-z=a-zA-Z]*)// and return ("QUERY", $1);
+ s/^(#{1}[a-zA-Z]*[0-9]*)// and return ("FRAGMENT", $1);
+ s/^(@?\/{0}[a-zA-z]*)// and return ("HOST", $1);
+ }
+}
+sub error{
+ exists $_[0]->YYData->{ERRMSG}
+ and do{
+ print $_[0]->YYData->{ERRMSG};
+ return;
+ };
+ print "syntax error\n";
+}
+sub parse{
+ my($self, $input) = @_;
+ $self->YYData->{INPUT} = $input;
+ my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
+ return $result;
+}
diff --git a/challenge-021/adam-russell/perl5/UrlParser.pm b/challenge-021/adam-russell/perl5/UrlParser.pm
new file mode 100644
index 0000000000..17c4651744
--- /dev/null
+++ b/challenge-021/adam-russell/perl5/UrlParser.pm
@@ -0,0 +1,272 @@
+####################################################################
+#
+# This file was generated using Parse::Yapp version 1.21.
+#
+# Don't edit this file, use source file instead.
+#
+# ANY CHANGE MADE HERE WILL BE LOST !
+#
+####################################################################
+package UrlParser;
+use vars qw ( @ISA );
+use strict;
+
+@ISA= qw ( Parse::Yapp::Driver );
+use Parse::Yapp::Driver;
+
+
+
+sub new {
+ my($class)=shift;
+ ref($class)
+ and $class=ref($class);
+
+ my($self)=$class->SUPER::new( yyversion => '1.21',
+ yystates =>
+[
+ {#State 0
+ ACTIONS => {
+ 'SCHEME' => 3
+ },
+ GOTOS => {
+ 'scheme' => 2,
+ 'url' => 1
+ }
+ },
+ {#State 1
+ ACTIONS => {
+ '' => 4
+ }
+ },
+ {#State 2
+ ACTIONS => {
+ "://" => 5
+ },
+ GOTOS => {
+ 'colondoubleslash' => 6
+ }
+ },
+ {#State 3
+ DEFAULT => -7
+ },
+ {#State 4
+ DEFAULT => 0
+ },
+ {#State 5
+ DEFAULT => -6
+ },
+ {#State 6
+ ACTIONS => {
+ 'HOST' => 7,
+ 'USERPASSWORD' => 8
+ },
+ GOTOS => {
+ 'host' => 9,
+ 'userpassword' => 10
+ }
+ },
+ {#State 7
+ DEFAULT => -9
+ },
+ {#State 8
+ DEFAULT => -8
+ },
+ {#State 9
+ ACTIONS => {
+ 'PATH' => 12
+ },
+ DEFAULT => -5,
+ GOTOS => {
+ 'path' => 11
+ }
+ },
+ {#State 10
+ ACTIONS => {
+ 'HOST' => 7
+ },
+ GOTOS => {
+ 'host' => 13
+ }
+ },
+ {#State 11
+ ACTIONS => {
+ 'QUERY' => 14,
+ 'FRAGMENT' => 17
+ },
+ DEFAULT => -4,
+ GOTOS => {
+ 'fragment' => 16,
+ 'query' => 15
+ }
+ },
+ {#State 12
+ DEFAULT => -11
+ },
+ {#State 13
+ ACTIONS => {
+ 'PORT' => 19
+ },
+ GOTOS => {
+ 'port' => 18
+ }
+ },
+ {#State 14
+ DEFAULT => -12
+ },
+ {#State 15
+ ACTIONS => {
+ 'FRAGMENT' => 17
+ },
+ GOTOS => {
+ 'fragment' => 20
+ }
+ },
+ {#State 16
+ DEFAULT => -3
+ },
+ {#State 17
+ DEFAULT => -13
+ },
+ {#State 18
+ ACTIONS => {
+ 'PATH' => 12
+ },
+ GOTOS => {
+ 'path' => 21
+ }
+ },
+ {#State 19
+ DEFAULT => -10
+ },
+ {#State 20
+ DEFAULT => -2
+ },
+ {#State 21
+ ACTIONS => {
+ 'QUERY' => 14
+ },
+ GOTOS => {
+ 'query' => 22
+ }
+ },
+ {#State 22
+ ACTIONS => {
+ 'FRAGMENT' => 17
+ },
+ GOTOS => {
+ 'fragment' => 23
+ }
+ },
+ {#State 23
+ DEFAULT => -1
+ }
+],
+ yyrules =>
+[
+ [#Rule 0
+ '$start', 2, undef
+ ],
+ [#Rule 1
+ 'url', 8, undef
+ ],
+ [#Rule 2
+ 'url', 6, undef
+ ],
+ [#Rule 3
+ 'url', 5, undef
+ ],
+ [#Rule 4
+ 'url', 4, undef
+ ],
+ [#Rule 5
+ 'url', 3, undef
+ ],
+ [#Rule 6
+ 'colondoubleslash', 1,
+sub
+#line 9 "perl5/UrlGrammar.yp"
+{ print $_[1] }
+ ],
+ [#Rule 7
+ 'scheme', 1,
+sub
+#line 11 "perl5/UrlGrammar.yp"
+{ print lc($_[1]) }
+ ],
+ [#Rule 8
+ 'userpassword', 1,
+sub
+#line 13 "perl5/UrlGrammar.yp"
+{ print $_[1] }
+ ],
+ [#Rule 9
+ 'host', 1,
+sub
+#line 15 "perl5/UrlGrammar.yp"
+{ print lc($_[1]) }
+ ],
+ [#Rule 10
+ 'port', 1,
+sub
+#line 17 "perl5/UrlGrammar.yp"
+{ $_[1] =~ s/://; print "" }
+ ],
+ [#Rule 11
+ 'path', 1,
+sub
+#line 19 "perl5/UrlGrammar.yp"
+{ print $_[1] }
+ ],
+ [#Rule 12
+ 'query', 1,
+sub
+#line 21 "perl5/UrlGrammar.yp"
+{ print $_[1] }
+ ],
+ [#Rule 13
+ 'fragment', 1,
+sub
+#line 23 "perl5/UrlGrammar.yp"
+{ print "" }
+ ]
+],
+ @_);
+ bless($self,$class);
+}
+
+#line 25 "perl5/UrlGrammar.yp"
+
+sub lexer{
+ my($parser) = @_;
+ $parser->YYData->{INPUT} or return('', undef);
+ $parser->YYData->{INPUT} =~ s/^[ \t]//;
+ ##
+ # send tokens to parser
+ ##
+ for($parser->YYData->{INPUT}){
+ s/^(http|https|ftp|jdbc)//i and return ("SCHEME", $1);
+ s/^(:\/\/)// and return ("://", $1);
+ s/^(:[0-9]*)// and return ("PORT", $1);
+ s/^([a-zA-Z]*:[a-zA-Z]*)// and return ("USERPASSWORD", $1);
+ s/^(\/[\/a-zA-Z]*)// and return ("PATH", $1);
+ s/^(\?{1}[a-zA-z=a-zA-Z]*)// and return ("QUERY", $1);
+ s/^(#{1}[a-zA-Z]*[0-9]*)// and return ("FRAGMENT", $1);
+ s/^(@?\/{0}[a-zA-z]*)// and return ("HOST", $1);
+ }
+}
+sub error{
+ exists $_[0]->YYData->{ERRMSG}
+ and do{
+ print $_[0]->YYData->{ERRMSG};
+ return;
+ };
+ print "syntax error\n";
+}
+sub parse{
+ my($self, $input) = @_;
+ $self->YYData->{INPUT} = $input;
+ my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
+ return $result;
+}
+
+1;
diff --git a/challenge-021/adam-russell/perl5/ch-1.pl b/challenge-021/adam-russell/perl5/ch-1.pl
new file mode 100644
index 0000000000..96d0968873
--- /dev/null
+++ b/challenge-021/adam-russell/perl5/ch-1.pl
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+##
+# Write a script to calculate the value of e.
+##
+sub e_calculation{
+ my($n) = @_;
+ my @d;
+ my $m = 4;
+ my @coefficients;
+ my $test = ($n + 1) * (2.30258509);
+ do{
+ $m++;
+ }while($m * (log($m) - 1.0) + 0.5 * log(6.2831852 * $m) <= $test);
+ @coefficients = (1) x $m;
+ $d[0] = 2;
+ for my $i (1 .. $n){
+ my $carry = 0;
+ for(my $j = $m - 1; $j >= 2; $j--){
+ my $temp = $coefficients[$j] * 10 + $carry;
+ $carry = int($temp / $j);
+ $coefficients[$j] = $temp - $carry * $j;
+ }
+ $d[$i] = $carry;
+ }
+ return @d;
+}
+
+MAIN:{
+ my $number_digits = $ARGV[0];
+ my @digits = e_calculation($number_digits);
+ print shift @digits;
+ print ".";
+ print join("", @digits) . "\n";
+}
diff --git a/challenge-021/adam-russell/perl5/ch-2.pl b/challenge-021/adam-russell/perl5/ch-2.pl
new file mode 100644
index 0000000000..55e9f126f9
--- /dev/null
+++ b/challenge-021/adam-russell/perl5/ch-2.pl
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+##
+# Write a script for URL normalization based on rfc3986.
+##
+use UrlParser;
+use constant URL => q|JDBC://user:password@localhost:3306/pwc?profile=true#h1|;
+MAIN:{
+ my $parser = new UrlParser();
+ $parser->parse(URL);
+}
+
+__DATA__
+use constant URL => "HTTP://www.example.com:80/a%C2%B1b/%7Eusername";
diff --git a/challenge-021/adam-russell/perl6/ch-1.p6 b/challenge-021/adam-russell/perl6/ch-1.p6
new file mode 100644
index 0000000000..8d52d296f9
--- /dev/null
+++ b/challenge-021/adam-russell/perl6/ch-1.p6
@@ -0,0 +1,44 @@
+##
+# Write a script to calculate the value of e.
+##
+sub e {
+ my $quantity = 50;
+ my $digit_channel = Channel.new();
+ $digit_channel.send(2);
+ $digit_channel.send(".");
+ e_calculation($digit_channel, $quantity);
+ gather loop {
+ take $digit_channel.poll() // do {
+ $quantity += 50;
+ e_calculation($digit_channel, $quantity);
+ $digit_channel.receive();
+ }
+ }
+}
+
+sub e_calculation($channel, $quantity) {
+ my @d;
+ my $n = $quantity;
+ my $m = 4;
+ my @coefficients;
+ my $test = ($n + 1) * (2.30258509);
+ repeat {
+ $m++;
+ }while ($m * (log($m) - 1.0) + 0.5 * log(6.2831852 * $m) <= $test);
+ @coefficients = (1) xx $m;
+ for (1 .. $n) -> $i {
+ my $carry = 0;
+ loop (my $j = $m - 1; $j >= 2; $j--) {
+ my $temp = @coefficients[$j] * 10 + $carry;
+ $carry = floor($temp / $j);
+ @coefficients[$j] = $temp - $carry * $j;
+ }
+ if ($i > $quantity - 50) {
+ $channel.send($carry);
+ }
+ }
+}
+
+for e() -> $e {
+ print $e;
+}