RogerBW's Blog

Perl Weekly Challenge 125: Pythagorean Diameter 11 August 2021

I’ve been doing the Weekly Challenges. The latest involved Pythagorean triples and binary trees. (Note that this is open until 15 August 2021.)

TASK #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.

A Pythagorean triple refers to the triple of three integers whose lengths can compose a right-angled triangle.

I don't like polymorphic return types, so if there are no valid triangles containing the number I just return an empty list.

My first approach to this used an exhaustive search based on Dickson's method, but while s can be scanned from 1 to n, t might become arbitrarily large.

So instead I use Barning's matrices to generate all primitive triples where at least one value is not greater than n, and see if they fit. This could be done recursively but I used my standard BFS pattern. I'll show this in the Ruby version for maximum clarity.

def pt(n)

out is my output list. tri is the rolling buffer onto which candidate triangles will be pushed.

  while (tri.length>0) do

Pull the first candidate off the buffer. (If there's nothing left, return it.)


For each of its three sides, see if that one is an even divisor of n. (The matrices generate only the primitive, i.e. smallest integral, triplets.) If it is, scale it up appropriately, and put that on the output.

    0.upto(2) do |i|
      if dm[1]==0 then
        out.push({|i| i*dm[0]})

If any of the sides is not greater than n, use Barning's matrices to make three new candidate triangles and push them onto the buffer. (I think, but have not proved, that the minimum value in an output will always be no smaller than the minimum in the corresponding input.)

    if t.min <= n then
  return out

I didn't do this one in Raku (it's painfully hard to get a list of lists), or in PostScript (I'm working on helper functions to give me variable-length arrays with push, pop, etc.). But at least there is no floating-point arithmetic.

TASK #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.

(This was modified to make it clear that the path length is the number of edges, not the number of nodes.)

Well, if you're going to make it easy…

The example gives the actual path, but all that the question asks for is the length, and I find binary trees fairly uninteresting.

Again, this could be done recursively: the diameter of a node is the maximum of (the sum of the depths of both subnodes), (the diameter of the left subnode) and (the diameter of the right subnode), where the depth is the length of the path from this node to the bottommost (in turn that's the larger of the depths of the subnodes, + 1). But since each of those calculations only refers to subnodes of the current node, I took an iterative approach instead.

I'm using the same array notation for the tree that I've used before. Because the tree is sparse, I use value 0 to represent an empty node.

sub btd {
  my $tree=shift;
  my $st=scalar @{$tree};

Build depth and diameter arrays for each node, initialised to 0.

  my @depth=(0) x $st;
  my @diameter=(0) x $st;

Walk backwards through the array. (When one's used to the convenience of the simple for-form, having to remember this one can be a bit of a stretch, for all it's basically the same syntax as C.)

  for (my $i=$st-1;$i>=0;$i--) {

If there's a node here at all (if there isn't, depth and diameter remain at 0)…

    if ($tree->[$i] != 0) {

Subnode indices are cached to save repeated multiplications.

      my $a=$i*2+1;
      my $b=$a+1;

If we potentially have subnodes, i.e. we're not running off the end of the array…

      if ($b < $st) {

Then calculate depth and diameter based on those subnodes.


Otherwise this is a node with no subnodes, so its depth is 1.

      } else {

And that's all there is to it. So I get the straightforwardness of the individual calculation that might go in a recursive approach, and the speed of iterative coding.

  return $diameter[0];

It does rely on my having a simple iterator that addresses all nodes; if I had to start at a root node and search for each child in a normal pattern of descent, it might well make more sense to use a different approach.

This one did come together nicely in PostScript. Of course I do need to define a max function, since that isn't in the PostScript v3 standard (though it seems to exist in the GhostScript interpreter). (Yeah, when I get into roll-level stack manipulation I like to work it out in detail…)

/max2 {
    dup % a b b
    3 2 roll % b b a
    dup % b b a a
    3 1 roll % b a b a
    lt { exch} if
} def

Then it's pretty much the routine as before.

/btd {
    /tree exch def
    /st tree length def

Build two zero-filled arrays of length st.

    /depth st array def
    /diameter st array def
    0 1 st 1 sub {
        depth exch 0 put
        diameter exch 0 put
    } for

Downward loops are easy.

    st 1 sub 1 neg 0 {
        /i exch def
        tree i get 0 ne {
            /a i 2 mul 1 add def
            /b a 1 add def
            b st lt {
                depth i depth a get depth b get max2 1 add put

We get rhetorical here – this line links up with the put four lines down.

                diameter i
                depth a get depth b get add
                diameter a get
                diameter b get
                max2 max2 put
            } {
                depth i 1 put
            } ifelse
        } if
    } for
    diameter 0 get
} def

Full code on github.

  1. Posted by RogerBW at 02:35pm on 16 August 2021

    Part 1: mostly people used exhaustive searches, but I'm not convinced there's an upper bound on triple size that can be checked this way. If the n you're testing is the shortest side, while the other two sides are much longer and very nearly equal, how high a value do you try for the other sides before you give up? seems like a reasonable limit, but I can't be confident in it. What if (3,99,100) were valid? (It isn't.) That's why I gave up on Dickson, as above. It may well be possible to prove that is sufficient (I haven't found any exceptions in an exhaustive search up to 40,000) in which case optimisations could certainly be made. I still like the Barning approach though.

    Part 2: Pretty much everyone used the diameter-depth model; there were some bloggers who took the reversal approach as above (which I guess is functional programming?), but others went recursive. It's not that I dislike recursion, but if it doesn't work first time it's hard for me to debug, and the invisible overhead of a process stack is often surprisingly large compared with the explicit overhead of a FIFO or LIFO queue. So I tend to look for other approaches.

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.

Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action advent of code aeronautics aikakirja anecdote animation anime army astronomy audio audio tech aviation base commerce battletech beer boardgaming book of the week bookmonth chain of command children chris chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 crime crystal cthulhu eternal cycling dead of winter doctor who documentary drama driving drone ecchi economics en garde espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 essen 2022 essen 2023 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo genesys geocaching geodata gin gkp gurps gurps 101 gus harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo 2021 hugo 2022 hugo 2023 hugo 2024 hugo-nebula reread in brief avoid instrumented life javascript julian simpson julie enfield kickstarter kotlin learn to play leaving earth linux liquor lovecraftiana lua mecha men with beards mpd museum music mystery naval noir non-fiction one for the brow opera parody paul temple perl perl weekly challenge photography podcast politics postscript powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs ruby rust scala science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance the weekly challenge thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1