Triple Tree Rings

Wherein we look for third way across the circle, to find the secrets within…

THE WEEKLY CHALLENGE – PERL & RAKU #125


episode one:
“Triple Threat”


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 a2+b2 = c2.

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

“It’s triangles all the way down, man! Just look at my hands! Dude! They’re like — a triangle! Far out!”

— attributed to Pythagoras, after visiting the Oracle at Dephi

Background and Color COMMENTARY

It is said that Pythagoras was obsessed with triangles, to put it mildly. He spent his life searching for the music of the spheres inside the triangle, and to this day we name a basic relationship between squared numbers and the lengths of the sides of certain triangles in his honor.

And this is not a footnote in a mathematical journal honor, but rather the relationship works its way into the voice of the Tin Man in the Wizard of Oz of all places. Taught to every grade-school student, it’s everywhere.

This relationship, that the squares of the two legs of a right triangle when summed equal the square of the length of the third, fascinated him, and when a triangle could be composed such that all of the side lengths were whole numbers this was seen to be a window into a divine world of perfection.

More than a mathematical oddity, it was a transcendental experience. The fact that the first such triple is 3, 4 and 5 — that is 32 + 42 = 52 — really clinched the idea that this relationship reflected a cosmic purity of truth reaching out to us in our flawed Earthly existence

Method

I went at this one completely blind, disconnected from the internet and its presumably easy answers. No, I took a nod to the big man himself and decided to study it out instead.

A few brisk internet-free hours later (I really must do this more often), I had a little understanding of the ground-rules. I had, first with pencil and paper, then later on to a spreadsheet, created a list of numbers with their squares, then deltas betwen adjacent squares, then deltas between squares two numbers apart, then three, etc. I discovered the difference between adjacent squares covered all odd numbers in their values; these start odd and increment by 2 in a sequence. The next set, two apart, incremented by 4 and were all even numbers, and quite importantly covered all even squares.

A casual explanation for this is that all even squares are the product of even numbers, and even numbers can be produced by multiplying some whole number by 2, so the square will be a multiple of 4.

What this establishes is that aside from a few trivial edge-cases at the beginning, all numbers above 2 can be used to construct a Pythagoran triple. Now that’s interesting.

Wait, what?

Yes, really. All odd numbers, and all even squares, can be found in the first two differential columns, and the values in the columns represent the difference between two squares. Cross-referencing back to those values that composed the differential, we have the three values for a triple.

If all we wanted was an example, we’d be done here. But CY has asked us for all triples, so we must needs press on.

O-Ren:
You didn’t think it was gonna be that easy, did you?

The Bride:
You know, for a second there — yeah, I kinda did.

If we continue the table, though, another fact comes to light: the next column grows by 6, the following 8, every expansion scaling at 2 times the column index, with index 0 being the square value itself. With the scaling as it is, the occurrence in one of these first two columns will represent the largest square associated with it to compose a triple, and all other occurrences of the value on the table will associated with wider differentials and hence smaller squares. A number can come up either as the greater or lesser summand or the sum, and may also be a multiple of some other triple.

For example, the square 144, 12 squared, shows up a lot:

  • 12² + 35² = 37² as the lesser summand ⟹ 144 + 1225 = 1369
  • 5² + 12² = 13² as the greater summand ⟹ 25 + 144 = 169
  • 12² + 16² = 20² as the lesser in {3,4,5} × 4 ⟹ 144 + 256 = 400
  • 9² + 12² = 15² as the greater in {3,4,5} × 3 ⟹ 81 + 144 = 225

Coming up with all of these possiblilites sounds pretty intensive if we were to assemble combinations of squares to see which ones work. However, all of these triples will be located somewhere in our table already, and our table can be constructed using iteration rules. We only need to figure out how large to draw it and how to seek values.

And the thing is, we don’t even need to construct the table, but rather more construct the idea of a table: as all the columns are well defined sequences, we only need to construct the cells that match, if present. And once matched, we don’t actually need to put them in a table, but can then use the index directly as there will always be only one match per column.

With this done we’re almost home. We’ve found all the triples with the target square as a summand, but those that sum to the target remain to be found. Fortunately this too yields to the almighty power of maths. If we presume the target square is a sum, then that defines an index row, and because the row across is comprised of deltas from the target square and the square one row above, then two rows above, then three, etc, all the possible summands will be expressed somewhere on the row, and if a triple is present, the squares of both sides will be there.

Not only this, but should we wish to construct a single table row, as we do here, we can compute the values directly with a formula hinged on the column and the index. Again we don’t actually need to build our table, just create the values for a single row. As each value is created, if it is determined to be a perfect square it is kept to an array of summands.

This summand array can end up with more than two elements, but however many found there will always be a multiple of 2, and, here’s another break our way: pairs of these summands, taken from the outside working in, will always sum to the square of the row index. How convenient. So that makes short work of that set of solutions.

What’s more, both of these processes can be accomplished concurrently using the same “triangle number” iterator, being the column count, so we only need to go through the values 1 to $n once: first looking for the target as a summand in a given column, and then looking for squares that sum to the target, in the row defined by the target, at the indicated column. The squares found are saved to a list of summands, which is processed at the end into triples.

Once we’ve gathered all the triples together we can then report on the results.

It wasn’t a lot of lines in the end, but it was a long road getting there, and remarkably no combinatorics were involved at all, so the time complexity is linear; just one pass through a loop. Now I really wonder what the “right” way to do this is. I still have no internet so I’ll just have to wait.

I do like this freedom from distraction though. It really is the best. As I said before, I must do this more often.

PERL 5 SOLUTION

use warnings;
use strict;
use utf8;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';
use open ':std', ':encoding(UTF-8)';


my $n = shift @ARGV || 60;
my $sq = $n ** 2;
my @triples;
my @summands;

for my $t (1..$n) { 
    ## first we check table columns for summands 
    ## the column index is the "triangle length", $t, and the equations
    ## combine this with the index to produce the values
    my $idx = 0;
    my $start = ($t ** 2) + (2 * $t);           ## start index   
    ## triangle equation column-wise
    ## skipping by 2t from from start index
    ## if the target square is present get its index
    if ( ($sq - $start) % (2 * $t) == 0 ) {
        $idx = $t + 1 + (($sq - $start) / (2 * $t)); 
        my @triple = sort {$a<=>$b} ($idx, $n, $idx - $t);
        push @triples, \@triple if $idx > $t; 
    }
    ## then we check sum row for summands
    ## all the table fields follow an iterative pattern based off their
    ## index and the column position, the "triangle length" back to the
    ## 0-index and then up the same distance. 
    last if $t == $n;                           ## last column is at $n-1
    my $test = (2 * $t * $n) - ($t ** 2);       ## triangle equation
    if ( (int(sqrt($test)))**2 == $test ) {     ## perfect square test
        push @summands, sqrt $test;
    }
}
push @triples, [shift @summands, pop @summands, $n] while @summands;

say sprintf "%4d² + %4d² = %d²", $_->@* for @triples;

The output:

~/Code/PWC/125-1-triple-play.pl
-----------------------------------------------------------------------
  60² +  899² = 901²
  60² +  448² = 452²
  60² +  297² = 303²
  60² +  221² = 229²
  60² +  175² = 185²
  60² +  144² = 156²
  60² +   91² = 109²
  60² +   80² = 100²
  60² +   63² = 87²
  45² +   60² = 75²
  32² +   60² = 68²
  25² +   60² = 65²
  11² +   60² = 61²
  36² +   48² = 60²
raku solution

unit sub MAIN ( $n = 60 ) ;

my $sq = $n**2;
my @triples;
my @summands;

for (1..$n) -> $t { 
    ## first we check table columns for summands 
    my $idx = 0;
    my $start = $t ** 2 + 2 * $t;           
    if ($sq - $start) % (2 * $t) == 0  {
        $idx = $t + 1 + ($sq - $start) / (2 * $t) ; 
        my @triple = sort $idx, $n, $idx - $t;
        push @triples, @triple if $idx > $t; 
    }
    ## then we check sum row for summands
    last if $t == $n;                           ## last column is at $n-1
    my $test = 2 * $t * $n - $t ** 2;           
    if $test.sqrt ~~ /^\d+$/   {                
        push @summands, $test.sqrt;
    }
}
push @triples, (@summands.shift, @summands.pop, $n) while @summands.elems;

say sprintf "%4d² + %4d² = %d²", |$_ for @triples;

episode two:
“Every Tree RIng Tells a Story”


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 (6) are:

3, 2, 1, 5, 7, 8, 9

or

4, 2, 1, 5, 7, 8, 9

UPDATE (2021-08-10 17:00:00 BST): Jorg Sommrey corrected the example.

The length of a path is the number of its edges, not the number of the vertices it connects. So the diameter should be 6, not 7.

Method

You can tell the age of a tree from the number of rings it has encircling its core. The tree never actually stops growing, but rather throughout the year the growth rate varies: it thrives in the summer, soaking up the warmth and light of the Sun to power its processes, then later in winter it will go dormant, and barely expand at all. The cycles of the surrounding environment, then, give the continuous tree growth its characteristic ring pattern, and these serve as a commentary on the outside world, rather than being a pattern intrinsic to the workings of the tree itself.

For this challenge we will bring out the set of binary tree classes we built for PWC 113, and because crafting input can be so difficult when constructing trees to a certain spec (see my comments on the subject in PWC 113), we’ll add the tree print routine first crafted for PWC 057 to help us, refactored and tightened yet again, and now gathered with its compatriots in the BTree package. I suppose, then, that a proper module would be the next step for the binary tree hardware. For now, though, as these are demonstrations, I think it better to present everything upfront, instead of hidden away in a external file performing magic. The beauty of having a framework of course, is that extending it can be quite simple, and we can focus more of our attention on what we want done, and less on how we go about doing that.

So what, exactly, do we need to do?

I found myself again without internet, so, without the aid of external knowledge I was once again left to my own devices when crafting this solution. This in itself isn’t overtly too unusual, as I normally avoid actually looking up any task answers, preferring instead to let things bang around in my head for a few days should the problem not present any obvious plan of attack. But on the other hand normally, in the senseless pursuit of knowledge, I do allow myself the endless rabbit hole that is WikiPedia, and here I didn’t even have that.

But no matter. There’s precious little description given, leading to a few initial questions: what is a path and what is the expected output? For a path, it’s not stated but we will assume every edge must be unique; that is we can’t ascend and descend on the same edge. This only makes sense but we’ll explicitly state it for completeness. In the other case we are asked for the diameter, which is a scalar value, a quantity. The examples give several enumerated paths but it doesn’t actually say to produce these, only asking for a (singular) diameter. From this I will conclude we want a number, the number of edges requiring traversal to find the longest continuous route within the tree.

As we said there is only a short description, but one thing that was listed, that stood out, was the comment that the longest path need not go through the root node. Well, how would that present itself? In a highly asymmetrical tree, the right side, for instance, might have many levels descending from the right child of the root, with the left child may having few if any. In that case it may be possible to traverse upwards along some left-hand path on the right side, up to the right root child node or whatever top level, and then back down the right-hand side to the furthest leaf to make the longest traversal.

One apparent conclusion from this analysis is that although the top node need not be the root, the longest traversal will always have a fundamental v-shape, up from a left leaf to an apex node and down again to some right leaf at the furthest extant. Doing the descent, a depth-first traversal, is something we know how to do. The question, then, is which node is our apex?

We could try them all, which would be a bit wasteful, as we will traverse again and again over the same leaves computing the longest path each way for each node.

On the other hand, we could take a page from dynamic programming and start at the leaves, computing the longest partial path from each node to the bottom and work our way upwards through the tree to the root.

The dynamic part is that at each node we set up a place to put two values, say a little array, that holds the maximum traversal down the left child path, and the complement value for the right. Then, when iterating recursively through the tree, at the end of the recursive step we return the larger of the two values, plus 1 for the path connecting up to the parent. The parent then inserts this return value into its own child-distance-log-thingy in the left or right position as warranted. In this way if we do a depth-first LRN traversal recursively, and when the steps collapse upwards they will build out the child data for each node as the recursions return.

The diameter of the tree at each node is the sum of these two values, the left child distance plus the right. By adding a package variable to the tree object, at each step once the child values have been filled in we can compare the diameter at that node to the tree value, and update that if necessary to reflect the maximum diameter.

PERL 5 SOLUTION

Implementing this involved adding a child_counts attribute to the Node object, and diameter attribute to the BTree object. A method, get_diameter(), does the depth-first LRN traversal as described above.

For the framework, and the additional print_tree() routine, I’ve moved all of the helper routines into their wrappers, encapsulating everything each method needs to do its thing. I think this has a cleaner feel to it.

The print_tree() routine is included to facilitate manipulating the input data list. As the values don’t matter to this challenge, I’ve used the number of its level as the value for each node in the demonstration.

Output slightly edited to fit on the page:

~/Code/PWC/125-2-tree-rings.pl
------------------------------------------------------------------------

Diameter: 8
    
                                ┏━━━━━━━━━━━━━━━━━━━━━━━━┫1┣━━━━━━━━┓                               
                                ┃                                   ┃                               
                ┏━━━━━━━━━━━━━━┫2┣━━━━━━━━━━━━━━┓                  ┃2┃                              
                ┃                               ┃                                                                               
        ┏━━━━━━┫3┣━━━━━━┓               ┏━━━━━━┫3┣━━━━━━┓                                                                       
        ┃               ┃               ┃               ┃                                                                       
       ┃4┣━━┓          ┃4┃          ┏━━┫4┣━━┓          ┃4┣━━┓                                                                   
            ┃                       ┃       ┃               ┃                                                                   
          ┏┫5┃                     ┃5┃     ┃5┃             ┃5┣┓                                                                 
          ┃                                                   ┃                                                                 
         ┃6┃                                                 ┃6┃                                                                

Here’s the final code. Note that, as mentioned, pretty much only the get_diameter() routine is new.

package Node;
use Moo;

    has value        => ( is => 'rw' );
    has left         => ( is => 'rw' );
    has right        => ( is => 'rw' );
    has child_counts => ( is => 'rw',
                          default => sub { [0,0] } );
        
package BTree;
use Moo;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';

    has root => (
        is => 'rw',
        default => sub { Node->new() }
    );
    
    has diameter => (
    ## the diameter of the tree
        is => 'rw',
        default => 0
    );

    sub load_serial ($self, $data) {
    ## build tree from serialized array, from the root node
    
        sub _add_children ($self, $node, $data, $idx) {
        ## add value from data array at index and recursively walk tree to children
            $node->value( $data->[$idx] );
            if (defined $data->[ 2 * $idx + 1 ]) {
                $node->left( Node->new );
                $self->_add_children($node->left, $data, 2 * $idx + 1);
            }
            if (defined $data->[ 2 * $idx + 2 ]) {
                $node->right( Node->new );
                $self->_add_children($node->right, $data, 2 * $idx + 2);
            }   
        }
    
        $self->_add_children($self->root, $data, 0);
    }
    
    sub dump_serial ($self) {
    ## write serialized array from root
        my $dump = [];
        
        sub _dump_children ($self, $node, $dump, $idx = 0) {
        ## add value to dump array at index and 
        ## recursively walk tree to children
            $dump->[$idx] = $node->value;
            if (defined $node->left) {
                $self->_dump_children($node->left, $dump, 2 * $idx + 1);
            }
            if (defined $node->right) {
                $self->_dump_children($node->right, $dump, 2 * $idx + 2);
            }   
        }
        
        $self->_dump_children($self->root, $dump);
        return $dump;
    }
    
    sub get_diameter ($self) {
    ## find and return the diameter of the entire tree
        sub _get_diameter ( $self, $node = $self->root ) {
        ## LRN traversal to gather child counts and update diameter
            if (defined $node->left) {
                $node->child_counts->[0] = $self->_get_diameter($node->left);
            }
            if (defined $node->right) {
                $node->child_counts->[1] = $self->_get_diameter($node->right);
            }
            my $children = $node->child_counts->[0] + $node->child_counts->[1];
            if ($children > $self->diameter) {
                $self->diameter( $children );
            }
            return ( $node->child_counts->[0] > $node->child_counts->[1] 
                ? $node->child_counts->[0]
                : $node->child_counts->[1]
            ) + 1
        }

        $self->_get_diameter;
        return $self->diameter;
    }
    
    sub print_tree ($self) {
    ## originally created for PWC 057-1 "invert-sugar"
    ## updated for box drawing elements and cleaned up for PWC 113
    ## and again for PWC 125
            
        my @tree = $self->dump_serial->@*;
        
        ## predeclare some character representations
        sub space ($val) { return q( ) x $val }
        sub dash  ($val) { return q(━) x $val }
        sub vert         { return q(┃) }
        sub rtee         { return q(┣) }
        sub ltee         { return q(┫) }
        sub downr        { return q(┏) }
        sub downl        { return q(┓) }

        ## determines the 0-based level of a node from its index
        sub get_level ($n) {
            return $n > 0 ? int log($n+1)/log(2) 
                          : 0;
        }       
        
        ## finds the widest string representation in the array and returns
        ## the width
        my $value_width = 0;
        $_ > $value_width and $value_width = $_ for map { scalar split // } 
                                                    grep defined, @tree;
    
        ## magic trick here, as we get longer values we pretend we're at
        ## the top of a larger tree to keep from running out of space
        ## between adjacent values between two parent nodes on the lowest
        ## level
        my $num_levels  = get_level(scalar @tree - 1 ) + int($value_width/2);  
        my $index = 0;
    
        while ($index < scalar @tree) {
            my $level  = get_level($index);
        
            my $spacer = 2**($num_levels - $level + 1);     
            my $white  = ($spacer/2 + 1 + $value_width) > $spacer 
                                ? $spacer 
                                : $spacer/2 + 1 + $value_width;
            my $dashes = $spacer - $white;
            my $level_node_count = 2 ** $level;
            my $node_line;
            my $vert_line;
        
            ## draw the nodes of each level and any connecting lines to the next 
            for (1..$level_node_count) {
        
                ## if the node is defined draw it in
                if (defined $tree[$index]) {

                    ## centers value in a slot $value_width wide, leaning
                    ## right for odd fits 
                    my $this_width      = length($tree[$index]);
                    my $right_pad_count = int(($value_width-$this_width)/2);
                    my $right_pad       = space($right_pad_count);
                    my $left_pad        = space($value_width - $this_width - 
                                            $right_pad_count);
                    my $value_format    = 
                        "${left_pad}%${this_width}s${right_pad}";
                    my $node            = sprintf $value_format, $tree[$index];

                    ## draw connecting lines if children present, or
                    ## whitespace if not
                    my $left_branch  = defined @tree[2 * $index + 1] 
                                        ? space($white-2) . downr  .     
                                            dash($dashes) . ltee
                                        : space($spacer-1). vert;
                    my $right_branch = defined $tree[2 * $index + 2]
                                        ? rtee . dash($dashes) . downl . 
                                            space($white-$value_width-2)
                                        : vert . space($spacer-$value_width-1);
                    $node_line      .= $left_branch . $node . $right_branch;
                
                    ## construct the vert connector line
                    my $left_vert    = defined $tree[2 * $index + 1] 
                                        ? space($spacer/2+$value_width-1) .  
                                            vert . space($dashes+1)
                                        : space($spacer);
                    my $right_vert   = defined $tree[2 * $index + 2]
                                        ? space($dashes+$value_width+1) . vert . 
                                            space($spacer/2-1)
                                        : space($spacer);
                    $vert_line      .= $left_vert . $right_vert;
                }
                ## else insert equivalent whitespace
                else {
                    $node_line .= space(2 * $spacer);     
                    $vert_line .= space( $spacer + 2 + $dashes*2 + 
                                      $value_width*2 );
                }
                $index++;
            }
            say $node_line;
            say $vert_line;
        }
    }

    
package main;
use warnings;
use strict;
use feature ":5.26";
use feature qw(signatures);
no warnings 'experimental::signatures';

                        
my @data = (1, 
            2, 2, 
            3, 3, undef, undef,   
             4, 4, 4, 4, undef, undef, undef, undef,
            undef, 5, undef, undef, 5, 5, undef, 5,
            undef, undef, undef, undef, undef, undef, undef, undef,
            undef, undef, 6, undef, undef, undef, undef, undef,
            undef, undef, undef, undef, undef, undef, undef, 6,
            undef, undef, undef, undef, undef, undef, undef, undef,
            undef, undef, undef, undef, undef, undef, undef, undef,
            );


my $tree = new BTree;
$tree->load_serial(\@data);

say "Diameter: ", $tree->get_diameter;

say '';
$tree->print_tree;
Raku Solution

class Node {
    has Any   $.value   is rw;
    has Node  $.left    is rw;
    has Node  $.right   is rw;
    has       $.child_l is rw = 0;
    has       $.child_r is rw = 0;
}

class BTree {
    has Node $.root     is rw;
    has      $.diameter is rw = 0 ;
  
    submethod BUILD (:@serial?) {
        $!root = Node.new;
        self.load_serial(@serial) if @serial.elems > 0;
    }
    
    method load_serial($data) {
        self!add_children($.root, $data, 0);
        
        method !add_children($node, $data, $idx) {
        ## add value from data array at index and recursively walk tree to children
            $node.value = $data[$idx];
            if $data[ 2 * $idx + 1 ].defined {
                $node.left = Node.new;
                self!add_children($node.left, $data, 2 * $idx + 1);
            }
            if $data[ 2 * $idx + 2 ].defined {
                $node.right = Node.new;
                self!add_children($node.right, $data, 2 * $idx + 2);
            }   
        }
    }

    
    method dump_serial() {
    ## write serialized array from root
        my @dump = [];
        self!dump_children($.root, @dump, 0);
        return @dump;
        
        method !dump_children($node, @dump, $idx) {
        ## add value to dump array at index and recursively walk tree to children
            @dump[$idx] = $node.value;
            if $node.left {
                self!dump_children($node.left, @dump, 2 * $idx + 1);
            }
            if $node.right {
                self!dump_children($node.right, @dump, 2 * $idx + 2);
            }   
        }        
    }
    
    method get_diameter() {
    ## fetch diameters using LRN traversal, update $self.diameter when necessary
    ## return diameter
        self!fetch_diameters($.root);
        return $.diameter;
    
        method !fetch_diameters($node) {
            if $node.left {
                $node.child_l = self!fetch_diameters($node.left)
            }
            if $node.right {
                $node.child_r = self!fetch_diameters($node.right)
            }    
            $.diameter = ($.diameter, $node.child_l + $node.child_r).max;
            return ($node.child_l, $node.child_r).max + 1;
        }
    }
    
}

sub MAIN () {

    my @data =  1, 
                2, 2, 
                3, 3, Nil, Nil,   
                 4, 4, 4, 4, Nil, Nil, Nil, Nil,
                Nil, 5, Nil, Nil, 5, 5, Nil, 5,
                Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil,
                Nil, Nil, 6, Nil, Nil, Nil, Nil, Nil,
                Nil, Nil, Nil, Nil, Nil, Nil, Nil, 6,
                Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil,
                Nil, Nil, Nil, Nil, Nil, Nil, Nil, Nil ;
                
    my $tree = BTree.new(serial => @data);
    say "Diameter: ", $tree.get_diameter;
    
    ## pretty print the input data
    print_tree(@data);

}

sub print_tree (@tree) {
## originally created for PWC 057-1 "invert-sugar"
## updated for box drawing elements and cleaned up for PWC 113
    constant vert   = Q<┃> ;
    constant rtee   = Q<┣> ;
    constant ltee   = Q<┫> ;
    constant downr  = Q<┏> ;
    constant downl  = Q<┓> ;
    sub space ($val) {  Q< > x $val }
    sub dash  ($val) {  Q<━> x $val }
    
    sub get_level ($n) {
    ## determines the 0-based level of a node from its index
        $n > 0 
            ?? (($n+1).log/(2).log ).Int
            !! 0;
    }

    ## find the widest string representation in the array and return the width
    my $value_width = @tree.max({$_.chars}).chars;       
    
    ## magic trick here, as we get longer values we pretend we're at the top of
    ## a larger tree to keep from running out of space between adjacent values
    ## between two parent nodes on the lowest level
    my $num_levels  = get_level(@tree.elems - 1 ) + ($value_width/2).Int;  


    my $idx = 0;    
    while $idx < @tree.elems {
        my $level  = get_level($idx);
        
        my $spacer = 2**($num_levels - $level + 1);     
        my $white  = ($spacer/2 + 1 + $value_width) > $spacer 
                            ?? $spacer 
                            !! $spacer/2 + 1 + $value_width;
        my $dashes = $spacer - $white;
        my $level_node_count = 2 ** $level;
        my $node_line;
        my $vert_line;
        
        ## draw the nodes of each level and any connecting lines to the next 
        for 1..$level_node_count {
        
            ## if the node is defined draw it in
            if (defined @tree[$idx]) {

                ## centers value in a slot $value_width wide, leaning right for odd fits 
                my $this_width      = @tree[$idx].chars;
                my $right_pad_count = (($value_width-$this_width)/2).Int;
                my $right_pad       = space($right_pad_count);
                my $left_pad        = space($value_width - $this_width - $right_pad_count);
                my $value_format    = "{$left_pad}%{$this_width}s{$right_pad}";
                my $node            = sprintf $value_format, @tree[$idx];

                ## draw connecting lines if children present, or whitespace if not
                my $left_branch  = (defined @tree[2 * $idx + 1]) 
                                    ?? space($white-2) ~ downr  ~ dash($dashes) ~ ltee
                                    !! (space($spacer-1) ~ vert);
                my $right_branch = (defined @tree[2 * $idx + 2])
                                    ?? rtee ~ dash($dashes) ~ downl ~ space($white-$value_width-2)
                                    !! vert ~ space($spacer-$value_width-1);
                $node_line      ~= $left_branch ~ $node ~ $right_branch;
                
                ## construct the vert connector line
                my $left_vert    = (defined @tree[2 * $idx + 1]) 
                                    ?? space($spacer/2+$value_width-1) ~ vert ~ space($dashes+1)
                                    !! space($spacer);
                my $right_vert   = (defined @tree[2 * $idx + 2])
                                    ?? space($dashes+$value_width+1) ~ vert ~ space($spacer/2-1)
                                    !! space($spacer);
                $vert_line      ~= $left_vert ~ $right_vert;
            }
            ## else insert equivalent whitespace
            else {
                $node_line ~= space($spacer * 2);     
                $vert_line ~= space($spacer + 2 + $dashes*2 + $value_width*2);
            }
            $idx++;
        }
        say $node_line;
        say $vert_line;
    }
}


The Perl Weekly Challenge, that idyllic glade wherein we stumble upon the holes for these sweet descents, is now known as

The Weekly Challenge – Perl and Raku

It is the creation of the lovely Mohammad Sajid Anwar and a veritable swarm of contributors from all over the world, who gather, as might be expected, weekly online to solve puzzles. Everyone is encouraged to visit, learn and contribute at

https://perlweeklychallenge.org

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s