with Raku

This is my response to the Perl Weekly Challenge #125.

You are given a positive integer

Write a script to print all

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}.

Example:

`$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.
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

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

It follows from the third example that all the numbers
have to be integers, as `(1, 1, 2.sqrt)`

is an acceptable non-integer solution.

The next oberservation is that
«1^{2} + 5^{2}» is the same as «5^{2} + 1^{2}». So we do
not have to check both (e.g. `a=1, b=5`

and `a=5, b=1`

). I avoid
this by ensuring that `b`

is higher or equal to `a`

. This makes
the program run faster (than if we started with 1), and has the nice benefit of avoiding
duplicates; as `(3, 4, 5)`

and `(4, 3, 5)`

are the same triangle.
The challenge actually requir that we avoid duplicates, so here it is for free.

#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0); # [1]
my $match = False; # [2]
my $N2 = $N * $N; # [3]
for 1 .. $N2 -> $a # [4]
{
for $a .. $N2 -> $b # [5]
{
for 1 .. $N2 -> $c # [6]
{
next unless any($a, $b, $c) == $N; # [7]
if $a * $a + $b * $b == $c * $c # [8]
{
say "($a, $b, $c)"; # [8a]
$match = True; # [8b]
}
}
}
}
say "-1" unless $match; # [9]

[1] Ensure a positive integer.

[2] We are requested to print all matches, and «-1» otherwise. This variable keeps track.

[3] We have to apply brute force. We have to stop somewhere, so I have used
`N`

as the upper limit for the three variables. The
downside is that we are not guaranteed to get all the triangles. If
^{2}`(1, 99, 100)`

should happen to be legal, which it isn't, this
program will not find it.

[4] Iterate for `a`

, all the possible values (to N^{2}).

[5] Iterate for `b`

, but start at the same value as `a`

,
so that we avoid duplicates (as described in the second
above).

[6] Iterate for `c`

.

[7] One of the values must be equal to N. If not, skip this iteration.

[8] Does the three values satisfy the Pythagorean theorem? If so, print the values [8a] and note that we have found (at least) one match [8b].

[9] Print «-1» if we did not find any matches.

Running it:

$ ./pythagorean-triplets-slow 5
(3, 4, 5)
(5, 12, 13)
$ ./pythagorean-triplets-slow 13
(5, 12, 13)
(13, 84, 85)
$ ./pythagorean-triplets-slow 1
-1

Note that the program runs slower and slower as we increase the input number.

The loops are the cause of the problems. We can optimize the innermost loop, both the starting and ending values:

File: pythagorean-triplets#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
my $match = False;
my $N2 = $N * $N;
for 1 .. $N2 -> $a
{
for $a .. $N2 -> $b
{
for $b + 1 .. $N2 -> $c # [1]
{
next unless any($a, $b, $c) == $N;
my $left = $a * $a + $b * $b; # [2]
my $right = $c * $c; # [2]
last if $right > $left; # [3]
if $left == $right # [4]
{
say "($a, $b, $c)";
$match = True;
}
}
}
}
say "-1" unless $match;

[1] Start at `$b + 1`

instead of `1`

, as the right hand side
cannot be smaller than the left hand side (of the equation).

[2] Compute the left hand side and right hand side, as we need them twice.

[3] Stop trying larger values for c, if the right hand side is already too large (larger than the left hand side).

[4] This is the old one.

This version is significantly faster (as in «not so slow») than the first one.

Running it:

$ ./pythagorean-triplets 1
-1
$ ./pythagorean-triplets 2
-1
$ ./pythagorean-triplets 3
(3, 4, 5)
$ ./pythagorean-triplets 4
(3, 4, 5)
$ ./pythagorean-triplets 5
(3, 4, 5)
(5, 12, 13)
$ ./pythagorean-triplets 6
(6, 8, 10)
$ ./pythagorean-triplets 7
(7, 24, 25)
$ ./pythagorean-triplets 8
(6, 8, 10)
(8, 15, 17)
$ ./pythagorean-triplets 9
(9, 12, 15)
(9, 40, 41)
$ ./pythagorean-triplets 10
(6, 8, 10)
(10, 24, 26)
$ ./pythagorean-triplets 11
(11, 60, 61)
$ ./pythagorean-triplets 12
(5, 12, 13)
(9, 12, 15)
(12, 16, 20)
(12, 35, 37)
$ ./pythagorean-triplets 13
(5, 12, 13)
(13, 84, 85)
$ ./pythagorean-triplets 14
(14, 48, 50)

You are given binary tree as below:

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:

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 have assumed that the node values are distint. Duplicate values will screw up the program.

We need a way of specifying a tree as a string. The tree given in the challenge can be written like this:

"1 | 2 5 | 3 4 6 7 | * * * * * * 8 10 | 9"

The bar (`|`

) marks a new line (start of a new row) in the tree. The
nodes are specified space separated. A star (`*`

) indicates a missing
value, and is used when we have values after (to the right of) it - on the same
row.

It looks like this, as a tree, with the red circles representing the `*`

s:

The «It doesn't have to pass through the root» statement tells us how to cope with trees like this:

The longest path is (5, 4, 3, 2, 6, 7, 8).

The first part of the program below is a slightly modifed version of my «sum-path» program from Pointy Path with Raku, my response to Challenge #093.

File: binary-tree-diameter (partial)#! /usr/bin/env raku
unit sub MAIN (Str $tree = "1 | 2 5 | 3 4 6 7 | * * * * * * 8 10 | 9",
:v(:$verbose)); # [1]
class BinaryNode # [2]
{
has Int $.value;
has BinaryNode $.left;
has BinaryNode $.right;
}
my @btree = $tree.split("|")>>.words; # [3]
my @old-nodes;
my @new-nodes;
for @btree.reverse -> $row
{
my @current = @$row;
@old-nodes = @new-nodes;
@new-nodes = ();
for @current -> $value
{
if $value eq "*"
{
@new-nodes.push("*");
next;
}
my $left = @old-nodes.shift // "*"; $left = Nil if $left eq "*";
my $right = @old-nodes.shift // "*"; $right = Nil if $right eq "*";
@new-nodes.push(BinaryNode.new(value => $value.Int,
left => $left // Nil,
right => $right // Nil));
}
}
my $btree = @new-nodes[0];
# say ": { $btree.raku }" if $verbose;

[1] The default tree, as given in the challenge.

[2] The class, copied without change from «sum-path».

[3] This one gives a two diementional array; the first level is the rows, and they contain a list of values.

The rest of the code build up the tree, from the bottom up. I did it this
way, so that the we can avoid changing the values of the nodes (adding children),
after we have created them. (It is in fact impossible to do so, as they are read
only. Specify e.g. `BinaryNode $.left is rw`

if you want to change it
later on.)

Getting the path from a leaf node (a node without children) to the top requires two way pointers, but I decided against that. That would require parsing of the tree, and we could use the old parsing algprithm (from «sum-path», slightly modified) to build up a list of paths instead.

File: binary-tree-diameter (partial)
my %paths; # [4]
traverse2($btree, ()); # [5]
sub traverse2 ($current, @path is copy) # [5]
{
@path.push: $current.value; # [6]
if ($current.left or $current.right) # [7]
{
traverse2($current.left, @path) if $current.left; # [7a]
traverse2($current.right, @path) if $current.right; # [7b]
}
else # [8]
{
say ": Node: { $current.value } with path: { @path.join(", ") }"
if $verbose;
%paths{ $current.value } = @path; # [8a]
return; # [8b]
}
}

[4] We are going to store the paths here. The leaf nodes are the keys, and the value is a list of nodes from the top to the leaf node, both included.

[5] Off we go, recursively. The first argument is the current node, and the second is the path so far.

[6] Add the current node to the path.

[7] Does this node have children?. If so, traverse the left, if any [7a], and right, if any [7b].

[8] No children? Then we have a leaf node. Save the path [8a] and
finish [8b]. The explicit `return`

is not really needed, but may make
it clearer what is going on.

This part, where we compare the paths, is completely new:

File: binary-tree-diameter (partial)
my $best = 0; # [9]
for %paths.keys.sort -> $from # [10]
{
for %paths.keys.sort -> $to # [10a]
{
next if $from == $to; # [10b]
my @up = @(%paths{$from}); # [11]
my @down = @(%paths{$to}); # [11a]
say ": Path: ", @up.reverse.join(", "), ", ", @down.join(", "),
" (via top)"
if $verbose; # [11b]
my $top; # [12]
while (@up[0] == @down[0]) # [13]
{
$top = @up[0]; # [13a]
@up.shift; # [13b]
@down.shift; # [13b]
}
my @path2 = (@up.reverse, $top, @down ).flat; # [14]
my $length = @path2.elems -1; # [15]
if $length > $best # [16]
{
$best = $length; # [16a]
say ": ", @path2.join(", "), " (shortest) length: $length [BEST]"
if $verbose;
}
else
{
say ": ", @path2.join(", "), " (shortest) length: $length"
if $verbose;
}
}
}
say $best; # [17]

[9] The best (longest) path so far.

[10] Iterate over al the leaf nodes, twice [10a]. Skip the situations where they are the same.

[11] Get the paths for the first part (called up; but note that the path is from the top). And the second part (down) [11a]. (The first part is reversed to form a continous path in [11b].)

[12] The top node will end up here.

[13] As long as both paths have the same top node, use that one as the top [13a], and get rid of the top nodes of both paths [13b].

[14] The full path is the first path (reversed), the top node (whatever that may be), and the second path.

[15] Get the diameter; which is the number of steps (i.e. the array size minus 1).

[16] Do we have a better candidate (higher diamater)? If so, take note of the size [16a]

[17] Print the diameter.

Running it:

$ ./binary-tree-diameter
6

With verbsoe mode:

$ ./binary-tree-diameter -v
: Node: 3 with path: 1, 2, 3
: Node: 4 with path: 1, 2, 4
: Node: 6 with path: 1, 5, 6
: Node: 9 with path: 1, 5, 7, 8, 9
: Node: 10 with path: 1, 5, 7, 10
: Path: 10, 7, 5, 1, 1, 2, 3 (via top)
: 10, 7, 5, 1, 2, 3 (shortest) length: 5 [BEST]
: Path: 10, 7, 5, 1, 1, 2, 4 (via top)
: 10, 7, 5, 1, 2, 4 (shortest) length: 5
: Path: 10, 7, 5, 1, 1, 5, 6 (via top)
: 10, 7, 5, 6 (shortest) length: 3
: Path: 10, 7, 5, 1, 1, 5, 7, 8, 9 (via top)
: 10, 7, 8, 9 (shortest) length: 3
: Path: 3, 2, 1, 1, 5, 7, 10 (via top)
: 3, 2, 1, 5, 7, 10 (shortest) length: 5
: Path: 3, 2, 1, 1, 2, 4 (via top)
: 3, 2, 4 (shortest) length: 2
: Path: 3, 2, 1, 1, 5, 6 (via top)
: 3, 2, 1, 5, 6 (shortest) length: 4
: Path: 3, 2, 1, 1, 5, 7, 8, 9 (via top)
: 3, 2, 1, 5, 7, 8, 9 (shortest) length: 6 [BEST]
: Path: 4, 2, 1, 1, 5, 7, 10 (via top)
: 4, 2, 1, 5, 7, 10 (shortest) length: 5
: Path: 4, 2, 1, 1, 2, 3 (via top)
: 4, 2, 3 (shortest) length: 2
: Path: 4, 2, 1, 1, 5, 6 (via top)
: 4, 2, 1, 5, 6 (shortest) length: 4
: Path: 4, 2, 1, 1, 5, 7, 8, 9 (via top)
: 4, 2, 1, 5, 7, 8, 9 (shortest) length: 6
: Path: 6, 5, 1, 1, 5, 7, 10 (via top)
: 6, 5, 7, 10 (shortest) length: 3
: Path: 6, 5, 1, 1, 2, 3 (via top)
: 6, 5, 1, 2, 3 (shortest) length: 4
: Path: 6, 5, 1, 1, 2, 4 (via top)
: 6, 5, 1, 2, 4 (shortest) length: 4
: Path: 6, 5, 1, 1, 5, 7, 8, 9 (via top)
: 6, 5, 7, 8, 9 (shortest) length: 4
: Path: 9, 8, 7, 5, 1, 1, 5, 7, 10 (via top)
: 9, 8, 7, 10 (shortest) length: 3
: Path: 9, 8, 7, 5, 1, 1, 2, 3 (via top)
: 9, 8, 7, 5, 1, 2, 3 (shortest) length: 6
: Path: 9, 8, 7, 5, 1, 1, 2, 4 (via top)
: 9, 8, 7, 5, 1, 2, 4 (shortest) length: 6
: Path: 9, 8, 7, 5, 1, 1, 5, 6 (via top)
: 9, 8, 7, 5, 6 (shortest) length: 4
6

We got the same result as the challenge, as shown by the verbose mode output. Note that I got the paths in the opposite direction as well.

It is easy to get rid of the opposite direction duplicates:

File: binary-tree-diameter2 (changes only) next if $from >= $to;

Running it:

$ ./binary-tree-diameter2 -v
: Node: 3 with path: 1, 2, 3
: Node: 4 with path: 1, 2, 4
: Node: 6 with path: 1, 5, 6
: Node: 9 with path: 1, 5, 7, 8, 9
: Node: 10 with path: 1, 5, 7, 10
: Path: 3, 2, 1, 1, 5, 7, 10 (via top)
: 3, 2, 1, 5, 7, 10 (shortest) length: 5 [BEST]
: Path: 3, 2, 1, 1, 2, 4 (via top)
: 3, 2, 4 (shortest) length: 2
: Path: 3, 2, 1, 1, 5, 6 (via top)
: 3, 2, 1, 5, 6 (shortest) length: 4
: Path: 3, 2, 1, 1, 5, 7, 8, 9 (via top)
: 3, 2, 1, 5, 7, 8, 9 (shortest) length: 6 [BEST]
: Path: 4, 2, 1, 1, 5, 7, 10 (via top)
: 4, 2, 1, 5, 7, 10 (shortest) length: 5
: Path: 4, 2, 1, 1, 5, 6 (via top)
: 4, 2, 1, 5, 6 (shortest) length: 4
: Path: 4, 2, 1, 1, 5, 7, 8, 9 (via top)
: 4, 2, 1, 5, 7, 8, 9 (shortest) length: 6
: Path: 6, 5, 1, 1, 5, 7, 10 (via top)
: 6, 5, 7, 10 (shortest) length: 3
: Path: 6, 5, 1, 1, 5, 7, 8, 9 (via top)
: 6, 5, 7, 8, 9 (shortest) length: 4
: Path: 9, 8, 7, 5, 1, 1, 5, 7, 10 (via top)
: 9, 8, 7, 10 (shortest) length: 3

Let us have a go at a graph where the root is not included. This is the one from the illustration I made earlier:

$ ./binary-tree-diameter2 "1 | 2 9 | 3 6 | 4 * 7 | 5 * 8"
6
$ ./binary-tree-diameter2 -v "1 | 2 9 | 3 6 | 4 * 7 | 5 * 8"
: Node: 5 with path: 1, 2, 3, 4, 5
: Node: 8 with path: 1, 2, 6, 7, 8
: Node: 9 with path: 1, 9
: Path: 5, 4, 3, 2, 1, 1, 2, 6, 7, 8 (via top)
: 5, 4, 3, 2, 6, 7, 8 (shortest) length: 6 [BEST]
: Path: 5, 4, 3, 2, 1, 1, 9 (via top)
: 5, 4, 3, 2, 1, 9 (shortest) length: 5
: Path: 8, 7, 6, 2, 1, 1, 9 (via top)
: 8, 7, 6, 2, 1, 9 (shortest) length: 5
6

A more extreme example, just to show off that it works:

$ ./binary-tree-diameter2 "1 | 2 | 3 | 4 | 5 | 6 7 | 8"
3
$ ./binary-tree-diameter2 -v "1 | 2 | 3 | 4 | 5 | 6 7 | 8"
: Node: 8 with path: 1, 2, 3, 4, 5, 6, 8
: Node: 7 with path: 1, 2, 3, 4, 5, 7
: Path: 7, 5, 4, 3, 2, 1, 1, 2, 3, 4, 5, 6, 8 (via top)
: 7, 5, 6, 8 (shortest) length: 3 [BEST]
3

It has two leaf nodes only, so the shortest path is actually also the only path.

And that's it.