diff options
| -rwxr-xr-x | challenge-125/stuart-little/perl/ch-1.pl | 25 | ||||
| -rwxr-xr-x | challenge-125/stuart-little/perl/ch-2.pl | 64 |
2 files changed, 89 insertions, 0 deletions
diff --git a/challenge-125/stuart-little/perl/ch-1.pl b/challenge-125/stuart-little/perl/ch-1.pl new file mode 100755 index 0000000000..d528990782 --- /dev/null +++ b/challenge-125/stuart-little/perl/ch-1.pl @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +use warnings; +use v5.12; + +# run <script> <number> + +use feature qw(signatures); +no warnings qw(experimental::signatures); + +sub trps($n) { + my @triples; + push @triples, (grep {$_->[0] && $_->[1] && $_->[1]**2 == $n**2-$_->[0]**2} map {[$_, int(sqrt($n**2-$_**2)), $n]} 1..int(($n+1)/2)); + push @triples, ( map { my $s = int($n**2/$_); my $a = int(($s-$_)/2); my $b = int(($s+$_)/2); [$a,$n,$b]} grep { ($n**2 % $_ == 0) && ($_%2 == int($n**2/$_)%2) } 1..$n-1 ); + return \@triples; +} + +my $sol=trps($ARGV[0]); +(scalar @{$sol}) && do { + for (@{$sol}) { + say "@{$_}"; + } + exit; +}; + +say -1; diff --git a/challenge-125/stuart-little/perl/ch-2.pl b/challenge-125/stuart-little/perl/ch-2.pl new file mode 100755 index 0000000000..8a55bdb680 --- /dev/null +++ b/challenge-125/stuart-little/perl/ch-2.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +use warnings; +use v5.12; + +use feature qw(signatures); +no warnings qw(experimental::signatures); + +use List::AllUtils qw(max_by); + +sub lr($tree) { + (scalar @{$tree} < 3 || $tree->[0] eq '.') && return [[],[]]; + (scalar @{$tree} == 3) && return [["."],["."]]; + my @left; + my ($sum,$ix)=(0,1); + while ($sum != -1) { + push @left, $tree->[$ix]; + $sum+=(($tree->[$ix] eq '.') ? (-1) : (1)); + $ix++; + } + my @right = $tree->@[(scalar @left)+1..(scalar @{$tree})-1]; + return [\@left,\@right]; +} + +sub lrLongPath($tree) { + $tree->[0] eq '.' && return [[],[]]; + scalar @{$tree} == 3 && return [[$tree->[0]],[$tree->[0]]]; + my ($left,$right) = @{lr($tree)}; + my $lLongPath = max_by {scalar @{$_}} @{lrLongPath($left)}; + my $rLongPath = max_by {scalar @{$_}} @{lrLongPath($right)}; + my @lLongPath = ($tree->[0],@{$lLongPath}); + my @rLongPath = ($tree->[0],@{$rLongPath}); + return [\@lLongPath,\@rLongPath]; + +} + +sub biLongPath($tree) { + (scalar @{$tree} < 3 || $tree->[0] eq '.') && return []; + (scalar @{$tree} == 3) && return [$tree->[0]]; + my ($lPath,$rPath) = @{lrLongPath($tree)}; + my @lPath = reverse $lPath->@[1..(scalar @{$lPath})-1]; + my @path = (@lPath,@{$rPath}); + my ($left,$right) = @{lr($tree)}; + return max_by {scalar @{$_}} (\@path, map {biLongPath($_)} ($left,$right)); +} + +my $sol = biLongPath(\@ARGV); +say "@{$sol}"; + +__END__ +run <script> <tree in preorder form with '.' for empty nodes, entered as space-separated values> + +ref: https://stackoverflow.com/a/2676849/11064961 + +e.g. 1 2 4 . 7 . . . 3 5 . . 6 . . represents the tree + + 1 + / \ + 2 3 + / / \ + 4 5 6 + \ + 7 + +given as an example in the problem formulation at https://perlweeklychallenge.org/blog/perl-weekly-challenge-113/#TASK2 |
