diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2021-05-11 11:02:52 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-05-11 11:02:52 +0100 |
| commit | 20571bd7b48622f5c41a6618073b7562b5420b72 (patch) | |
| tree | 0e85e144162e270dd2bffffdb90335fcc62b6136 | |
| parent | aa7bcf9cee3b87c6aa9d6d69121bde1ad890503d (diff) | |
| parent | 1176e786ae2816bd9c99106b77a6cc030fbcb9a1 (diff) | |
| download | perlweeklychallenge-club-20571bd7b48622f5c41a6618073b7562b5420b72.tar.gz perlweeklychallenge-club-20571bd7b48622f5c41a6618073b7562b5420b72.tar.bz2 perlweeklychallenge-club-20571bd7b48622f5c41a6618073b7562b5420b72.zip | |
Merge pull request #4063 from polettix/polettix/pwc112
Add polettix's solution to challenge-112
| -rw-r--r-- | challenge-112/polettix/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-112/polettix/blog1.txt | 1 | ||||
| -rw-r--r-- | challenge-112/polettix/perl/ch-1.pl | 28 | ||||
| -rw-r--r-- | challenge-112/polettix/perl/ch-2.pl | 38 |
4 files changed, 68 insertions, 0 deletions
diff --git a/challenge-112/polettix/blog.txt b/challenge-112/polettix/blog.txt new file mode 100644 index 0000000000..79765dc4ef --- /dev/null +++ b/challenge-112/polettix/blog.txt @@ -0,0 +1 @@ +https://github.polettix.it/ETOOBUSY/2021/05/12/pwc112-canonical-path/ diff --git a/challenge-112/polettix/blog1.txt b/challenge-112/polettix/blog1.txt new file mode 100644 index 0000000000..4b6b6b49dd --- /dev/null +++ b/challenge-112/polettix/blog1.txt @@ -0,0 +1 @@ +https://github.polettix.it/ETOOBUSY/2021/05/13/pwc112-climb-stairs/ diff --git a/challenge-112/polettix/perl/ch-1.pl b/challenge-112/polettix/perl/ch-1.pl new file mode 100644 index 0000000000..a38693a166 --- /dev/null +++ b/challenge-112/polettix/perl/ch-1.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl +use 5.024; +use warnings; +use experimental qw< postderef signatures >; +no warnings qw< experimental::postderef experimental::signatures >; +use Test::More; + +sub canonical_path ($p) { + $p =~ s{/\K(?:\.?/)+}{}gmxs; + $p =~ s{\A/.*\K/\z}{}mxs; + 1 while $p =~ s{/[^/]+/\.\.(/|\z)}{$1}mxs; + return $p; +} + +for my $test( + [qw< /a/ /a >], + [qw< /a//b/c/ /a/b/c >], + [qw< /a/b/c/../.. /a >], + [qw< /a/b/c/../../ /a >], + [qw< /a/./b/.//./c/../../ /a >], + [qw< /a/../../../b/ /b >], +) { + my ($input, $expected) = $test->@*; + my $got = canonical_path($input); + is $got, $expected, "'$input' -> '$expected'"; +} + +done_testing; diff --git a/challenge-112/polettix/perl/ch-2.pl b/challenge-112/polettix/perl/ch-2.pl new file mode 100644 index 0000000000..f35da5528e --- /dev/null +++ b/challenge-112/polettix/perl/ch-2.pl @@ -0,0 +1,38 @@ +#!/usr/bin/env perl +use 5.024; +use warnings; +use experimental qw< postderef signatures >; +no warnings qw< experimental::postderef experimental::signatures >; +use Math::BigInt; + +my $n = shift // 4; +say climb_stairs($n); + +sub climb_stairs ($n) { return fibonacci_nth(Math::BigInt->new($n) + 1) } + +sub fibonacci_multiply { + my ($x, $y) = @_; + @$x = ( + $x->[0] * $y->[0] + $x->[1] * $y->[2], + $x->[0] * $y->[1] + $x->[1] * $y->[3], + $x->[2] * $y->[0] + $x->[3] * $y->[2], + $x->[2] * $y->[1] + $x->[3] * $y->[3], + ); +} ## end sub _multiply + +sub fibonacci_power { + my ($q, $n, $q0) = (@_[0, 1], $_[2] || [@{$_[0]}]); + return $q if $n < 2; + fibonacci_power($q, int($n / 2), $q0); + fibonacci_multiply($q, $q); + fibonacci_multiply($q, $q0) if $n % 2; + return $q; +} ## end sub _power + +sub fibonacci_nth ($n) { + my ($zero, $one) = map { Math::BigInt->new($_) } 0 .. 1; + return + $n < 1 ? $zero + : $n < 3 ? $one + : fibonacci_power([$one, $one, $one, $zero], $n - 1)->[0]; +} ## end sub nth |
