Perl Weekly Challenge 125.
My solutions (task 1, and task 2 ) to the The Weekly Challenge - 125.
Task 1: Pythagorean Triples
Submitted by: Cheok-Yin Fung
You are given a positive integer $N.
Write a script to print all Pythagorean Triples containing $N
as a member. Print -1 if it can’t be a member of any. i
Triples with the same set of elements are considered the same,
i.e. if your script has already printed (3, 4, 5), (4, 3, 5)
should not be printed.
The famous Pythagorean theorem states that in a right angle
triangle, the length of the two shorter sides and the length
of the longest side are related by a^2 + b^2 = c^2.
A Pythagorean triple refers to the triple of three integers
whose lengths can compose a right-angled triangle.
Example
Input: $N = 5
Output:
(3, 4, 5)
(5, 12, 13)
Input: $N = 13
Output:
(5, 12, 13)
(13, 84, 85)
Input: $N = 1
Output:
-1
Consider a complex number a+i b with integer real and imaginary parts a and b. Its square (a + i b)2=x+iy has real and imaginary parts x=a2-b2 and y=2ab. Notice that its squared modulus is |x+iy|2=x2+y2=(a2-b2)2+4a2b2=(a2+b2)2, so that (x, y, z) with z=|a+ib|2=a2+b2 form a Pythagorean triplet, x2+y2=z2. It turns out that all Pythagorean triplets are integer multiples of triplets of this form. Thus, given N we can check if it is a multiple of some a2-b2, 2ab or a2+b2 for any pair of integers a,b and some multiplier k. If we succeed, a Pythagorean triplet would be k(a2-b2), k(2ab) and k(a2+b2). If we only consider positive numbers, then we can assume b<a. As a2-b2=(a-b)(a+b) is a positive multiple of a+b, a may not be larger than N, bounding our search. Thus, we can test all pairs such that 0<a<N and 0<b<a to get all the Pythagorean triplets that contain N, if there is any.
# 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;
}
Example:
./ch-1.pl `seq 15`
Results:
Input; 1
Output:
-1, no result found
Input; 2
Output:
-1, no result found
Input; 3
Output:
(3, 4, 5)
Input; 4
Output:
(3, 4, 5)
Input; 5
Output:
(3, 4, 5)
(5, 12, 13)
Input; 6
Output:
(6, 8, 10)
Input; 7
Output:
(7, 24, 25)
Input; 8
Output:
(6, 8, 10)
(8, 15, 17)
Input; 9
Output:
(9, 12, 15)
(9, 40, 41)
Input; 10
Output:
(6, 8, 10)
(10, 24, 26)
Input; 11
Output:
(11, 60, 61)
Input; 12
Output:
(12, 16, 20)
(9, 12, 15)
(5, 12, 13)
(12, 35, 37)
Input; 13
Output:
(5, 12, 13)
(13, 84, 85)
Input; 14
Output:
(14, 48, 50)
Input; 15
Output:
(15, 20, 25)
(9, 12, 15)
(15, 36, 39)
(8, 15, 17)
(15, 112, 113)
To my surprise, it seems that most numbers are part of a Pythagorean triplet, if not all numbers beyond 2. I tested up to 1000 and found no non-Phytagorean number N>2. Then I found a reason for that (thanks to Elías Mochán): Any even number N>2 is clearly of the form 2ab (take a=N/2, b=1). Any odd number is of the form a2-b2 (take a=(N+1)/2 and b=(N-1)/2). Thus, either ((N/2)2-1, N, (N/2)2+1/ or (N, (N2-1)/2,(N2+1)/2) form a Pythagorean triplet that contains N for any N>2.
Task 2: Binary Tree Diameter
Submitted by: Mohammad S Anwar
You are given binary tree as below:
1
/ \
2 5
/ \ / \
3 4 6 7
/ \
8 10
/
9
Write a script to find the diameter of the given binary tree.
The diameter of a binary tree is the length of the longest
path between any two nodes in a tree. It doesn’t have to pass
through the root.
For the above given binary tree, possible diameters (7) are:
3, 2, 1, 5, 7, 8, 9
or
4, 2, 1, 5, 7, 8, 9
I will assume the input is a string that may be evaluated to
yield an anonymous array of the form [value, left, right]
which represents the given tree, where left and right are
subtrees or empty arrays. This is an ugly but simple representation.
I translate this representation into
an anonymous hash for each node of the form
{value=>...,left=>..., right=>..., depth=>...,
diameter=>...,deepest=>...,head=>...}
I construct the tree and calculate its depth recursively from the largest
depth of its branches, and its diameter is obtained from the
diameters of its children or from the sum of their depths,
whichever yields the largest value. I also mantain a reference
to the subtree with the deepest path and that with the largest
diameter (it may be a self-reference). From it I get the
longest path from one leave to another.
# 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}));
}
Given example:
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
./ch-2.pl "[1,[2,[3,[],[]],[4,[],[]]],[5,[6,[],[]],[7,[8,[9,[],[]],[]],[10,[],[]]]]]"
Results:
Input: [1,[2,[3,[],[]],[4,[],[]]],[5,[6,[],[]],[7,[8,[9,[],[]],[]],[10,[],[]]]]]
Diameter: 7
Path: 3-2-1-5-7-8-9
Another example:
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
./ch-2.pl "[1,[],[2,[3,[4,[],[]],[5,[],[]]],[6,[7,[],[]],[8,[],[]]]],[9,[],[]]]"
Results:
Input: [1,[],[2,[3,[4,[],[]],[5,[],[]]],[6,[7,[],[]],[8,[],[]]]],[9,[],[]]]
Diameter: 5
Path: 4-3-2-6-7
This case illustrates a tree where the diameter doesn’t include the root.