2 files changed, 78 insertions, 0 deletions
diff --git a/challenge-125/wlmb/perl/ch-1.pl b/challenge-125/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..24b829e36d
--- /dev/null
+++ b/challenge-125/wlmb/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 125
+# Task 1:  Pythagorean triplets
+#
+# See https://wlmb.github.io/2021/08/10/PWC125/#task-1-pythagorean-triples
+use warnings;
+use strict;
+use v5.12;
+use POSIX qw(floor);
+use List::Util qw(uniq);
+
+die "Usage: ./ch-1.pl N1 N2... to search for pythagorean triplets containing Ni"
+    unless @ARGV;
+foreach(@ARGV){
+    my $N=floor($_); # check non-negative integer arguments
+    warn("Expected natural"), next unless $N>=0 and $N==$_;
+    my @found=();
+    foreach my $a(1..$N-1){
+	foreach my $b (1..$a-1){
+	    push @found, [$a, $b, $_/($a**2-$b**2)] if $_%($a**2-$b**2)==0;
+	    push @found, [$a, $b, $_/(2*$a*$b)] if $_%(2*$a*$b)==0;
+	    push @found, [$a, $b, $_/($a**2+$b**2)] if $_%($a**2+$b**2)==0;
+	}
+    }
+    say "Input; $_\nOutput:";
+    say "\t$_" foreach uniq map { #remove duplicates
+	my($A,$B,$K)=@$_; # careful not to confuse with $a and $b from sort
+	my ($x, $y, $z)=sort {$a <=> $b} map {$K*$_} ($A**2-$B**2, 2*$A*$B, $A**2+$B**2);
+	"\t($x, $y, $z)";
+    } @found;
+    say("\t-1, no result found") unless @found;
+}
diff --git a/challenge-125/wlmb/perl/ch-2.pl b/challenge-125/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..bf1435526e
--- /dev/null
+++ b/challenge-125/wlmb/perl/ch-2.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 125
+# Task 1:  Binary tree diameter
+#
+# See https://wlmb.github.io/2021/08/10/PWC125/#task-2-binary-tree-diameter
+use warnings;
+use strict;
+use v5.12;
+use List::Util qw(max);
+
+foreach(@ARGV){
+    die("Only []0-9, and spaces allowed") unless m/^([][0-9,\s])*$/;
+    my $tree_as_array=eval $_;
+    warn("eval failed $@"), next if $@;
+    my $tree_as_hash=make_tree($tree_as_array);
+    my @path=(reverse(path($tree_as_hash->{head}{left})), $tree_as_hash->{head}{value},
+	      path($tree_as_hash->{head}{right}));
+    say "Input: $_\nDiameter: $tree_as_hash->{diameter}\nPath: ",
+        join "-", @path;
+}
+sub make_tree {
+    my $array=shift;
+    my %node;
+    die "Wrong format" unless ref($array) eq "ARRAY";
+    return undef if @$array==0;
+    my $value=$array->[0];
+    my ($left,$right)=map {make_tree($_)} map {$array->[$_]} (1,2);
+    my ($dl, $dr)=map {defined $_?$_->{depth}+1:0} ($left, $right);
+    my $depth=max ($dl, $dr);
+    my $deepest=$depth==$dl?$left:$right;
+    my ($Dl, $Dr)=map {defined $_?$_->{diameter}:0} ($left, $right);
+    my $D=(defined $left?$dl:0)+(defined $right?$dr:0)+1;
+    my $diameter=max($D, $Dl, $Dr);
+    my $head=$diameter==$D?\%node # self reference or
+             :$diameter==$dl?$left->{head} # reference to child
+             :$right->{head};
+    @node{qw(value left right depth deepest diameter head)} # Build the node
+    =($value,$left,$right,$depth,$deepest,$diameter,$head);
+    return \%node;
+}
+
+sub path {
+    my $tree=shift;
+    return () unless defined $tree;
+    return ($tree->{value},path($tree->{deepest}));
+}