1st commit on 125_perl

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