From 81f467ef7e5b2a10427aca2f5057d3d80979a17c Mon Sep 17 00:00:00 2001 From: Mohammad S Anwar Date: Sun, 15 Aug 2021 16:05:33 +0100 Subject: - Added solutions by Colin Crain. --- challenge-125/colin-crain/blog.txt | 1 + challenge-125/colin-crain/perl/ch-1.pl | 220 ++++++++++++++++++ challenge-125/colin-crain/perl/ch-2.pl | 380 +++++++++++++++++++++++++++++++ challenge-125/colin-crain/raku/ch-1.raku | 46 ++++ challenge-125/colin-crain/raku/ch-2.raku | 195 ++++++++++++++++ 5 files changed, 842 insertions(+) create mode 100644 challenge-125/colin-crain/blog.txt create mode 100644 challenge-125/colin-crain/perl/ch-1.pl create mode 100644 challenge-125/colin-crain/perl/ch-2.pl create mode 100644 challenge-125/colin-crain/raku/ch-1.raku create mode 100644 challenge-125/colin-crain/raku/ch-2.raku (limited to 'challenge-125') diff --git a/challenge-125/colin-crain/blog.txt b/challenge-125/colin-crain/blog.txt new file mode 100644 index 0000000000..fece3ed8be --- /dev/null +++ b/challenge-125/colin-crain/blog.txt @@ -0,0 +1 @@ +https://colincrain.com/2021/08/15/triple-tree-rings/ diff --git a/challenge-125/colin-crain/perl/ch-1.pl b/challenge-125/colin-crain/perl/ch-1.pl new file mode 100644 index 0000000000..c162baec46 --- /dev/null +++ b/challenge-125/colin-crain/perl/ch-1.pl @@ -0,0 +1,220 @@ +#!/Users/colincrain/perl5/perlbrew/perls/perl-5.32.0/bin/perl +# +# triple-play.pl +# +# 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 + +# background color commmentary: +# +# "It's triangles all the way down, man! Just look at my hands! +# Dude! They're like — a triangle! Far out!" -- attributed to +# Pythagorous, after visiting the Oracle at Dephi +# +# It is said that Pythagorous 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 shorter sides 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, integral numbers 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 3^2 + 4^2 = 5^2 — really clinched the deal that this +# reflected a cosmic purity of truth that reached out to us in our +# flawed human 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 adjacent squares covered all +# odd numbers in their values, starting odd and incrementing 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 +# Pythaogorian triple. +# +# Wait, what? +# +# Yes, really. All odd numbers, and all even squares, can be found +# in the first two differential columns, and the values on the +# columns represent the difference between two squares. +# Cross-referencing back to the 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. You didn't +# really think it would be so easy, did you? +# +# Yea, for a minute there, I 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: +# +# 5² + 12² = 13² as the lesser summand 25 + 144 = 169 +# 12² + 35² = 37² as the greater summand 144 + 1225 = 1369 +# 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 the triples will be located somewhere in +# our table already, and our table can even 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 in a summand, but those that sum to the +# target remain to be found. Fortunately this too yields to the +# almight power of maths. If we presume the target square is a sum, +# then that defines an index row, and because the row across is +# comprside of deltas from the target square and the square one row +# above, then two rows above, then three all the possible summands +# will be expressed somewhere on the row. +# +# Not only this, but the values can be derived mathematically as +# well without constructing the table this time either. A simple +# formula hinged off the iterator and the index determines every +# element, and if the value is determined to be a square it is kept +# to an array of summands. +# +# This summand array can have more than two elements, but there +# will always be a multiple of 2, and pairs from the outside +# working in will always sum to the square of the index. How +# convenient. So that makes short work of those soultions. +# +# Gathering all the triples together we can now report on the +# results. +# +# It wasn't very long to code in the end, but it was a long road +# getting there, and remarkably no conmbinatorics were involved at +# all. Now I *really* wonder what the right way to do this is. Still no +# internet so I'll just have to wait. I do like this freedom from +# distraction though. It's the best. Must do this more often. + + + + +# +# © 2021 colin crain +## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## + + + +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; + } +} +say "summands @summands"; +push @triples, [shift @summands, pop @summands, $n] while @summands; + +say sprintf "%4d² + %4d² = %d²", $_->@* for @triples; + + diff --git a/challenge-125/colin-crain/perl/ch-2.pl b/challenge-125/colin-crain/perl/ch-2.pl new file mode 100644 index 0000000000..cc3d1aad6c --- /dev/null +++ b/challenge-125/colin-crain/perl/ch-2.pl @@ -0,0 +1,380 @@ +#!/Users/colincrain/perl5/perlbrew/perls/perl-5.32.0/bin/perl +# +# tree-rings.pl +# +# 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 stops growing, but +# throughout the year it thrives in the summer, soaking up the +# warmth and light of the sun to power its processes, puttin +# gon weight for a barren winter to come, when it will berely +# expand at all. The cycles, then, give the continual tree +# growth its charateristic ring pattern, and serve as a commentary +# on the world, rather than 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, +# we'll add the tree print routine first crafted for PWC 057 to +# help us, refactored and tightened yet again into a nice +# self-contained package. Which, I suppose, is 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 module performing magic. +# +# The beauty of having a framework of course, is that extending +# it can be quite simple, and we can focus our attention on +# what we want done, and less so on how we go about doing that. +# +# I am again without internet, so, without any external +# knowledge I was left to my own devices. I normally avoid +# actully looking up the answers, preferring to let things bacg +# around in my head for a few days should the problem be +# present no obvious plan of attack, but in the senseless +# pursuit of knowledge I usually allow myself the endless +# rabbit hole that is WikiPedia, and here I don't even have +# that. +# +# But no matter. The first thing 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 split +# from the right child of the root, and the left child may have +# few if any. In that case it is possible to traverse upwards +# from the left child of the right side, up to the right root +# child node, and then back down the right side to make the +# longest traversal. +# +# On the other hand, it becomes apparent that although the top +# node need not be the root, the longest traversal will always +# have a fundimental vee-shape, up from a left leaf to an apex +# node and down again to some right leaf at the furthest +# extant. Doing 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 +# traversed 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. +# +# 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 vaalue +# 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 to the +# parent. The parent then inserts this return value into its +# child-disance-log-thingy in the left or right position as +# warranted. In this way if we do a depth-first LRN traversal +# recursively, when the recursions 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. +# +# 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. + + + + +# © 2021 colin crain +## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## + + + + + +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, $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 +# } + + sub get_diameter ($self) { + + 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; + diff --git a/challenge-125/colin-crain/raku/ch-1.raku b/challenge-125/colin-crain/raku/ch-1.raku new file mode 100644 index 0000000000..b3439cf4c7 --- /dev/null +++ b/challenge-125/colin-crain/raku/ch-1.raku @@ -0,0 +1,46 @@ +#!/usr/bin/env perl6 +# +# +# .raku +# +# +# +# © 2021 colin crain +## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## + + + +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; ## triangle equation + + if $test.sqrt ~~ /^\d+$/ { ## perfect square test + push @summands, $test.sqrt; + } +} + + +push @triples, (@summands.shift, @summands.pop, $n) while @summands.elems; + +say sprintf "%4d² + %4d² = %d²", |$_ for @triples; + diff --git a/challenge-125/colin-crain/raku/ch-2.raku b/challenge-125/colin-crain/raku/ch-2.raku new file mode 100644 index 0000000000..077e6d26f4 --- /dev/null +++ b/challenge-125/colin-crain/raku/ch-2.raku @@ -0,0 +1,195 @@ +#!/usr/bin/env perl6 +# +# +# .raku +# +# +# +# © 2021 colin crain +## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## + + + + + + + +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; + } +} -- cgit