diff options
| author | Adam Russell <ac.russell@live.com> | 2019-08-18 18:00:29 -0400 |
|---|---|---|
| committer | Adam Russell <ac.russell@live.com> | 2019-08-18 18:00:29 -0400 |
| commit | 64c3a44ea7c3ffcaeca25ddb4da45233b7608394 (patch) | |
| tree | 68ac57f5ddefec3c66d2c3741beabde66a15f0e0 | |
| parent | 5383452fd7c187d11d53a6982255cdfa5f36a51b (diff) | |
| download | perlweeklychallenge-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.txt | 2 | ||||
| -rw-r--r-- | challenge-021/adam-russell/perl5/UrlGrammar.yp | 57 | ||||
| -rw-r--r-- | challenge-021/adam-russell/perl5/UrlParser.pm | 272 | ||||
| -rw-r--r-- | challenge-021/adam-russell/perl5/ch-1.pl | 35 | ||||
| -rw-r--r-- | challenge-021/adam-russell/perl5/ch-2.pl | 14 | ||||
| -rw-r--r-- | challenge-021/adam-russell/perl6/ch-1.p6 | 44 |
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; +} |
