Perl Weekly Challenge: Week 125
Challenge 1:
Pythagorean Tripples
You are given a positive integer
$N.Write a script to print all
Pythagorean Triplescontaining$Nas a member. Print -1 if it can’t be a member of any.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²+b² = c².
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
I had never even heard of a Pythogorean Triple before but the Pythogorean theorem is something we all learned long ago in school so I remembered enough about its' properties to solve this problem.
We begin by creating an array, @triples, to store the found triples.
my @triples;
Then we iterate through all integers from 1 to $N. a will represent one side of
a right-angled triangle.
for 1 .. $N -> $a {
The first term of the pythagorean theorem is a².
my $aSquared = $a²;
Side b has to be a different length than side a. So a small optimization is to assume a is the short side and therefore b is greater than a. This also avoids duplicate or reversed a,b pairs.
my $b = $a + 1;
We search while side a is greater than or equal to $N or side b is less than or equal
to $N. This will ensure that at least one or the other will equal $N.
while $a >= $N || $b <= $N {
For the pythagorean theorem, we also need the value of b².
my $bSquared = $b²;
If we add a² and b² ...
my $sum = $aSquared + $bSquared;
...that will equal c²; therefore the square root of that amount is the length of side c.
Possibly this is not an integer amount so we use .Int to round it to the nearest integer.
my $c = $sum.sqrt.Int;
If c equals b then this is not a right-angled triangle and won't have a Pythagorean triple so we stop processing.
if $c == $b {
last;
}
The prospective triple is assigned to the variable @t.
my @t = ( $a, $b, $c );
$sum(i.e. a² + b²) should equal c². It might not if its' square root as calculated
above had not been an integer. Also atleasr one member of @t should be $N. If both
these conditions are met...
if $sum == $c² && @t.any == $N {
...we have a winner. It is added to @triples.
push @triples, @t;
}
We move on to the next value of b.
$b++;
}
}
One thing the spec requires is to remove any duplicate triples. Raku has a .unique()
method which should do the job but it only works on scalars. So in this line,
we convert each triple into a string by .join()ing it with hyphens, .sort() it
to keep duplicates together, remove the duplicates with .unique() and .split()
them back up into triples.
@triples = @triples
.map({ .sort({$^a <=> $^b}).join(q{-}) })
.unique
.map({ .split(q{-}) });
Now we can print out the list of triples (or -1 if it was empty.)
say @triples
?? @triples.map({ q{(} ~ $_.join(q{, }) ~ q{)} }).join("\n")
!! -1;
For Perl we need to provide our own unique() function but otherwise the code is mostly
the same as Raku.
my @triples;
foreach my $a (1 .. $N) {
my $aSquared = $a ** 2;
my $b = $a + 1;
while ($a >= $N || $b <= $N) {
my $bSquared = $b ** 2;
my $sum = $aSquared + $bSquared;
my $c = int(sqrt($sum));
if ($c == $b) {
last;
}
We also need to replay .any() but instead I just chose an or chain as
there are only three values to test.
if ($sum == $c ** 2 && ($a == $N || $b == $N || $c == $N)) {
push @triples, [ $a, $b, $c ];
}
$b++;
}
}
@triples =
I changed the order from Raku to sort() here and complicated the sorting function
because my version of unique() doesn't maintain array order.
sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] }
map { [split q{-}] }
unique(
map { join q{-}, @{$_} }
@triples
);
say @triples
? join "\n", map { q{(} . (join q{, }, @{$_}) . q{)} } @triples
: -1;
Challenge 2:
Binary Tree Diameter
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 (6) are:
3, 2, 1, 5, 7, 8, 9
or
4, 2, 1, 5, 7, 8, 9
I made the obsservation that the longest path (i.e diameter) has to pass through the root node of the tree. So if we can find the longest path from the left and right children of the root node, that should be our answer.
First we have to get the binary tree into the script. Once again, I reused the Node class and makeTree() function Icreated in PWC 93 to set it up. For the example, the input will look like this:
1 2 5 3 4 6 7 - - - - - - 8 10 - - - - - - - - - - - - 9 - - -
The MAIN() function is very simple:
say getMaxPath(makeTree(@nodes));
All the work is done in getMaxPath() which takes the binary tree Node starting at
$root and calculates the diameter by conducting a depth-first search of that tree.
sub getMaxPath(Node $root) {
Initially $diameter is set to 0.
my $diameter = 0;
The helper function dfs() will be called recursively to traverse the binary tree.
sub dfs($node) {
The base case for the recursion is if the $node is empty. If so, we return a length of 0.
if !$node {
return 0;
}
Otherwise, we calculate the height of the sub-trees beginning from the left and right children of this node.
my $leftHeight = dfs($node.left);
my $rightHeight = dfs($node.right);
The value of $diameter is updated if the sum of the two heights is
greater than the current value;
$diameter = max($diameter, $leftHeight + $rightHeight);
We return the height of the current sub-tree.
return 1 + max($leftHeight, $rightHeight);
}
That's dfs(). getMaxPath() goes on to call dfs() starting from
$root and when it is finished, returns the final value of $diameter.
dfs($root);
return $diameter;
}
For the Perl version, as well as Node and makeTree(), we need a replacement max().
Otherwise the code works the same way as in Raku.
my $diameter = 0;
sub getMaxPath($node) {
if (!$node) {
return 0;
}
my $leftHeight = getMaxPath($node->left);
my $rightHeight = getMaxPath($node->right);
$diameter = max($diameter, $leftHeight + $rightHeight);
return 1 + max($leftHeight, $rightHeight);
}
getMaxPath(makeTree(@ARGV));
say $diameter;