Pythagorean Tree with Raku

[141] Published 14. August 2021.

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

Challenge #125.1: Pythagorean Triples

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.

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

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² + 5²» is the same as «5² + 1²». 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.

File: pythagorean-triplets-slow

#! /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 (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²).

[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)

Challenge #125.2: Binary Tree Diameter

You are given binary tree as below:

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.

Links

About me
Keyword Index
Raku Courses
Beginning Raku (book)
RSS Feed
Code (zip)
Reddit Comments