Represent the Differences, Yo!

Wherein we break it down, switch it up, add the middle and cut the pickle.

THE WEEKLY CHALLENGE – PERL & RAKU #113


episode one:
“Dig It, Baby, Represent!”


Task 1

Represent Integer

Submitted by: Mohammad S Anwar

You are given a positive integer $N and a digit $D.

Write a script to check if $N can be represented as a sum of positive integers having $D at least once. If check passes print 1 otherwise 0.

Example
Input: $N = 25, $D = 7
Output: 0 as there are 2 numbers between 1 and 25 having the digit 7 i.e. 7 and 17. If we add up both we don't get 25.

Input: $N = 24, $D = 7
Output: 1

Method

I’m going to start off saying this challenge is a bit confusing. Ok, stronger: this challenge is just weird. I have to say I’m having a hard time wrapping my head around the idea. I’m looking at at least two completely different parts to this puzzle that tie together to create our answer. And as for “why?” I have no response. I’m not entirely sure this even qualifies as number theory — but, sure, why not? What do we have to lose?

Hold on — I’m afraid this might be coming across as too negative. Don’t mistake my confusion for complaining; on the other hand, I do love the nonsensical relationship: “All multiples of seven or thirteen that rhyme with the color blue”. It all has a very postmodern “mix-and-match” aura around it. You know, actually I may be on to something there — a treasure hunt of tenuously associated ideas that must be connected in the right order to succeed. Perhaps I should flush that idea out and give it to Mohammad. In any case further insights may clear some of this uncertainty up as we progress, but for now I think the plan is to jump right in. Whatever it is, it’s certainly not boring, that’s for sure.

The first part of the puzzle, specifying the valid options for our assembly, is rather cryptically laid out, but this is made clearer by the example: “…having $D [a digit] at least once” evidently means the number is represented, in base-10, by a digit-string containing the given value in at least one of its positions. These will be the only numbers available to combine to reach the target.

To evaluate all the various combinations in the second part of the task we will need a comprehensive list of available candidates. Constructing this list is the first little puzzle-within-a-puzzle.

Mathematically this subtask is a bit of a mess, which makes it lucky for us to have grep available. We can just look at the number: we examine each value less than our target with a regular expression and filter for only those that match the digit.

Once we have our number list, we need to start trying combinations.

First, lets address some questions that arise from special cases:

  • Q: Is a single value a sum?
    If so then every number that already contains the digit can be verified by itself. We’ll have to think about this. We could justify a “no” by reasoning that summing is a repeated associative binary operation and this would preclude single digit sums. That’s easy, if a bit arbitrary in the definition. On the other hand the identity is arguably the most fundamental of the fundamental axioms in mathematics. The sum is a total quantity of a group of items, so of course a group of one equals itself. If you systematically remove items from a group of many the group doesn’t mysteriously cease to exist when it only has one item remaining. I can see this both ways.
  • Q: What about the digit 0?
    For the digit 0 we should exclude leading 0s or every number is validated. Leading 0s are always there and never there, full of sound and fury signifying nothing. Only in these concrete forms of positional number theory do we need to even consider such ideas of whether or not they might count as part of a number.
  • Q: What about the digit 1?
    Every number can be constructed from a sequence of some number of 1s, so for the digit 1 we can immediately return 1, unless we’re excluding self-validation. We can extend this logic to state any number evenly divisible by the digit can be immediately validated by one or more instances of that digit.

Filtering for at least 1 specific digit does not seriously reduce the pool of candidates for large numbers, with the number of options converging upwards towards the entire set. For longer digit sequences it becomes increasingly likely that at least one of the digits will be the one searched for. Thus as the numbers get larger the number of possible solutions more closely resembles the set of integer compositions, which is 2n-1 arrangements. Even without converging to unity we can conclude that no matter what we do, this whole affair is going to blow up exponentially. The best way to proceed would be to try and be as efficient as possible and see how far we get before the algorithm bogs down enough to become unusable.

That certainly sounds right, except…

Where’s the kaboom? There was supposed to be an earth-shattering kaboom!

Or in other words, our exponential growth never materializes. We don’t seem to ever need to check all combinations before finding a valid sum group. What’s going on?

(Ok, now we’re getting into the number theory! I’m beginning to really like this puzzle!) Let’s think it through. There are, after all, only 10 digits to consider:

We’ve already looked at 1, which can be used to construct any number, and noted from this that numbers with the required digit as a divisor will all validate. Now let’s consider the digit 2.

One half the whole number set is even, and will validate immediately using only the number 2. Now let’s consider next the other numbers we have available. Working upwards from 1 we’ll look at all numbers constructed with the digit somehow involved:

{2,12,21,22,23,…}

It can be shown that any odd number minus an odd number will yield an even number. Now note that 21 is the first odd number in the ordered sequence. So we can conclude that any odd number greater than 21, minus 21, will yield an even number that in turn can be constructed by some quantity of 2s, and hence will validate.

Now we’re getting somewhere. Can we generalize this? Yes of course we can. Any digit n can be used to construct a range of numbers written “nx” with x from 0 to 9. As all digits in the 1s place are represented, this provides a sequence of numbers that we can select from to produce a difference with any last digit desired in a subtraction from a larger value.

So let’s look at multiples of the given digit. Every single digit is contained within the range

(0,1,2, … ,9)

and it follows that every digit will have at least one multiple within any arbitrary range

(k0,k1,k2, … ,k9) ∀ k

The number n is the first multiple of n. The number 10n is in the list of numbers with n in the tens place.

Thus we can conclude that for any number 10n + n or higher there exists some value within the range

[ nx | x ∈ {0,1,2,…,9} ]

that can be subtracted to produce some multiple of n within the arbitrary range described above.

Whatever last digit is required to produce a multiple fo the the digit, we can hit it.

The only remaining case is 0, which still follows the pattern, albeit slightly adapted, when considered as the value 10. This has the the range

(100,101,102, …,109)

for the values that when subtracted will produce a 0 in the last position.

The value represented as “nn“, mathematically constructed 10n + n, is a lower bound beyond which all numbers will validate for a given digit n. If we allow a number to validate itself, the entire range of 10n + k numbers is included, so the lower bound drops to 10n. In actuality these bounds are sometimes less, as we see from experiment:

DigitAllowing SelfExcluding Self
112
22022
32124
44044
55055
66066
76168
88088
98190
0100110
Actual lower bounds, by numeric analysis

In our solution presented, we could, and should, short-circuit when the target exceeds

(10 × digit + digit)

but presenting the numeric breakdowns are more interesting so we do that instead. If we needed to filter really large numbers with a 1 or 0 result this would certainly be the way to go, as for large targets the recursion can go quite deep. A prefilter() function implementing this is included, but not tied in.

The only effort made here is to determine whether any solution exists, not to qualify those solutions. The solutions found favor smaller numbers over large and will include quite lengthy repetitions of the examined digit rather than a single multiple that may also work, such as 36 for 6 or 40 for 4. Again matters of efficiency would be entirely side-stepped by short-circuiting out of any values above the relevent lower bound. If efficiency was at a premium, the results, being so closely bounded, could be reduced to one or more lookup tables. They wouldn’t even be very big. But again, this technique would be terribly boring so we won’t do that.

The decision on whether to exclude the number itself in potential summing, disallowing a one-digit valid sum, is configurable by appending any positive number to the input. A positive value excludes the number from consideration. The default is inclusive.

PERL 5 SOLUTION

The recursion is unnecessarily complicated by preserving the summed value lists as they are computed, but as stated this way is more fun. Once any one solution is found the recursion collapses and the result presented. We’ll switch it up and implement a proper solution in Raku for comparison.

Target: 55
Digit:  7
Output: 1
7 + 7 + 7 + 7 + 27 = 55

The code:

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

@ARGV = (55, 7, 0) if @ARGV == 0;

my ($target, $digit, $exclude_self) = @ARGV;

my @num = grep {/$digit/} (1..$target-($exclude_self > 0));

my $sol = sum_from_list( $target, \@num );
say "Target: $target";
say "Digit:  $digit";

if (defined $sol) {
    say "Output: 1";
    say ((join " + ", $sol->@*), " = $target"); 
}
else {
    say "Output: 0";
}

sub sum_from_list ($target, $numlist, $partsum = 0, $partial = []) {
    for my $nextval ( $numlist->@* ) {
        if ($partsum + $nextval == $target) {
            push $partial->@*, $nextval;
            return $partial;
        }
        my @newpart  = ( $partial->@*, $nextval );
        my $newpsum = $partsum + $nextval;
        my @newlist  = grep { $_ >= $nextval && $_ <= $target - $newpsum} $numlist->@*;
        next if scalar @newlist == 0;
        my $sol = sum_from_list ($target, \@newlist, $newpsum, \@newpart);
        return $sol if defined $sol;
    }
    return undef;
}


sub prefilter ($target, $digit) {
    return $target >= 10 * $digit + $digit;
}
raku solution

In Raku we return just the 1 or 0 value as requested, and by obviating the need to track the partial solutions you can see the core logic shrinks considerably. This version also incorporates the prefilter to immediately short-circuit for values above the larger lower bound threshold, outputting 1 immediately before exiting.

unit sub MAIN ($target = 55, $digit = 7, $exclude_self = 1) ;


prefilter($target, $digit) 
    ?? say 1
    !! do { my @num = (1..$target-($exclude_self > 0)).grep: /$digit/;
            say sum_from_list( $target, @num ) }

sub sum_from_list( $target, @numbers = (), $sum = 0 ) {
    for @numbers -> $value {
        return 1 if $sum + $value == $target;
        my @filtered = @numbers.grep: {$_ >= $value and $_ <= $target-$sum-$value},;
        next if @filtered.elems == 0;
        
        return 1 if sum_from_list( $target, @filtered, $sum + $value );
    }
    return 0;
}

sub prefilter ($target, $digit) {
    return $target >= 10 * $digit + $digit;
}

episode two:
“You Will Be the Yin to My Yang”


task 2

Recreate Binary Tree

Submitted by: Mohammad S Anwar

You are given a Binary Tree.

Write a script to replace each node of the tree with the sum of all the remaining nodes.

Example
Input Binary Tree
        1
       / \
      2   3
     /   / \
    4   5   6
     \
      7
Output Binary Tree
        27
       /  \
      26  25
     /   /  \
    24  23  22
     \
     21

Method

I have nothing against binary trees, or really any kinds of trees, arboreal or conceptual. I like trees. They give me pleasure to watch, shade to cool me, and provide the stuff I like to breathe: day in, day out, all of this for free without any complaint to be heard. I can’t say they never hurt anyone, but I do think it highly unlikely they ever did so on purpose. It might be more fair to blame gravity for that falling branch than the poor being that lost its appendage. Or the ground the hiker was standing on, for that matter, for providing the anvil for the sudden stop. The ground is a very dangerous place, I’ve been told, although I can’t say I spend a great deal of time on it. Every year, almost every accident that happens happens on the ground. Correlation is causation and don’t let anyone ever tell you otherwise. You really should believe me. After all, I have a blog.

But back to the point at hand, no matter my considerations towards trees in general, I am not nearly as fond of working with binary trees in these challenges. It’s not the data structures themselves; writing methods to do clever stuff is great and all; that’s not the problem. What bugs me is the I/O portion. There’s no really good satisfactory way to encode a tree for easy transport. They generally end up a jumble of brackets and commas that you can only pray hasn’t been corrupted. They aren’t hard to work with, it’s just that without a pencil and paper they’re hard for humans to read and write. Getting humans and computers to agree on a way to talk about them is the messy part.

In the past I’ve settled on encoding a serialized tree in an array, which is what we’ll do today as well. In this format each node of a theoretical full tree in a breadth-first traversal is assigned a sequential element in an array, whether it contains a node or not. Thus the root layer is a single element at index [0], the next layer two indices at [1] and [2], the next [3],[4],[5] and [6], etc. Empty nodes, as we said, are given element indices, leaving holes in the sequence filled with null data.

Inputting an arbitrary tree from the command line is problematic. We would need to create an encoding for the encoding to accurately express null nodes. This could be done by stringifying the array into a CSV-like line, or substituting a real character or string not present elsewhere into the mix, such as ∅ or NULL. Further, as the length of the array grows exponentially as the tree gains levels it becomes progressively easier to screw all of this up.

Basta! This aspect is a distraction. Because life is complicated enough the data will be directly written in to the script as an existing array. Let’s keep our focus instead on the important things.

One primary advantage of this format is that the parent and child nodes maintain a clearly defined relationship, with the children for a given node at index [n] always occupying indices [2n+1] and [2n+2]. This relationship makes the flat form a real tree in itself, and we could, as I’ve done previously, manipulate that data directly. To perform this particular task all we would need is a sum function followed by a map. Two lines and we’re out. Easy peasy.

my $max = List::Util::sum @input;
@input = map {$sum - $_} @input;

On the other hand, although this does technically satisfy the criteria, the result depends on qualities of the list-wise format we’ve decided for the data rather than anything having to do with a traditional binary tree structure. It seems like cheating, really. And when we cheat, we’re really just cheating ourselves. And whoever it was we cheated of course. Can’t forget about them.

So I decided to write up a proper set of classes to hold the data structure for this challenge. The data is read in and recursively fed to the structure through the parent-child relationship, but after that the nodes link to themselves through the standard “left” and “right” attributes.

Two routines are needed to descend the trees from the root node, one to add the value of each node to a sum attribute, the second to traverse again and replace the value of each node to the summed value minus the existing, producing the sum of all the other node values in the tree.

To print the tree I brought out the pretty print routine from PWC 057 and updated it. This operates on serialized data, so a serial dump routine was fashioned to mirror the load routine. I cleaned it up and worked it over some more, so among other things it now uses Unicode box-drawing characters, giving it a sleek new art deco look:

                ┏━━━━━━━━━━━━━━┫6┣━━━━━━━━━━━━━━┓               
                ┃                               ┃               
        ┏━━━━━━┫8┃                      ┏━━━━━━┫6┣━━━━━━┓       
        ┃                               ┃               ┃       
    ┏━━┫2┣━━┓                       ┏━━┫3┣━━┓       ┏━━┫9┣━━┓   
    ┃       ┃                       ┃       ┃       ┃       ┃   
  ┏┫9┣┓    ┃3┣┓                   ┏┫5┣┓    ┃1┃     ┃2┣┓   ┏┫1┣┓ 
  ┃   ┃       ┃                   ┃   ┃               ┃   ┃   ┃ 
 ┃6┃ ┃9┃     ┃6┃                 ┃3┃ ┃5┃             ┃1┃ ┃1┃ ┃1┃
PERL 5 SOLUTION

In Perl our Tree object has routines for serial I/O, wrappers with recursive helpers, and two more to traverse the tree and either gather or alter the nodes. The print_tree routine exists as a thicket of arcane tradeoffs sized so that the elements on the last line do not conflict with each other, calculated according to the longest element, character wise, in the tree. Cleaning up for the rework I was reminded just how complicated originally deciding those tradeoffs was. It’s not very configurable in the scaling, shall we say. The most minor alterations mess everything up. But it’s cool, and now it’s cooler, and it works. I continued the reworking for the Raku version.

Input:

        ┏━━━━━━┫6┣━━━━━━┓       
        ┃               ┃       
    ┏━━┫8┃          ┏━━┫6┣━━┓   
    ┃               ┃       ┃   
   ┃2┣┓           ┏┫3┣┓    ┃9┣┓ 
      ┃           ┃   ┃       ┃ 
     ┃3┃         ┃5┃ ┃1┃     ┃1┃
                                        

Output:

                 ┏━━━━━━━━━━━━━┫38┣━━━━━━━━━━━━━┓               
                 ┃                              ┃               
         ┏━━━━━┫36┃                      ┏━━━━━┫38┣━━━━━┓       
         ┃                               ┃              ┃       
       ┃42┣━┓                        ┏━┫41┣━┓          ┃35┣━┓   
            ┃                        ┃      ┃               ┃   
           ┃41┃                    ┃39┃    ┃43┃            ┃43┃ 
                                                                        

The beast itself:

package Node;
use Moo;

    has value => ( is => 'rw' );
    has left  => ( is => 'rw' );
    has right => ( is => 'rw' );

package BTree;
use Moo;
use feature qw(signatures);
no warnings 'experimental::signatures';

    has root => (
        is => 'rw',
        default => sub { Node->new() }
    );

    has sum => (
    ## the sum of all values in the tree
        is => 'rw',
        default => 0
    );
    
    sub load_serial ($self, $data) {
    ## build tree from serialized array from root
        $self->_add_children($self->root, $data, 0);
    }
    
    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);
        }   
    }
    
    sub dump_serial ($self) {
    ## write serialized array from root
        my $dump = [];
        $self->_dump_children($self->root, $dump, 0);
        return $dump;
    }
    
    sub _dump_children ($self, $node, $dump, $idx) {
    ## 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);
        }   
    }
   
    sub descend_and_sum ($self, $node = $self->root) {
    ## NLR preorder traversal and add node values to package sum attribute
        $self->sum( $self->sum + $node->value ); 
        if (defined $node->left) {
            $self->descend_and_sum($node->left);
        }
        if (defined $node->right) {
            $self->descend_and_sum($node->right);
        } 
    }       
    
    sub descend_insert_diff ($self, $node = $self->root) {
    ## NLR preorder traversal and replace node values with package sum - value
        $node->value($self->sum - $node->value);
        if (defined $node->left) {
            $self->descend_insert_diff($node->left);
        }
        if (defined $node->right) {
            $self->descend_insert_diff($node->right);
        }
    }
    
    


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

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


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

$tree->descend_and_sum;
$tree->descend_insert_diff;

my $dump = $tree->dump_serial;

say "Input:\n";
print_tree(@data);
say '';
say "Output:\n";
print_tree($dump->@*);



## predeclarations
sub vert;
sub rtee;
sub ltee;
sub downr;
sub downl;

sub print_tree (@tree) {
## originally created for PWC 057-1 "invert-sugar"
## updated for box drawing elements and cleaned up for PWC 113
    my $value_width = get_max_value_width(@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;
    }
}

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(┓) }

sub get_level ($n) {
## determines the 0-based level of a node from its index
    return $n > 0 ? int log($n+1)/log(2) 
                  : 0;
}

sub get_max_value_width (@tree) { 
## finds the widest string representation in the array and returns the width
    my $max = 0;
    $_ > $max and $max = $_ for map { scalar split // } grep defined, @tree;
    return $max;
}
Raku Solution

In Raku I continued to make changes to both the class methods and to the print_tree() routine. In the BTree class I noticed the preorder traversal steps to sum and then later alter the node values shared a lot of code. So I refactored out the recursion steps into their own NLR_apply() higher-order method taking a Node and a code block, applying the block to each node as it moves through the tree. In a similar yet functionally different refactoring I moved the helper routines into their respective wrappers, making them private as well.

In the pretty-printing routine we’ve removed all of the font character choices from the main logic, into a group of constants and private subroutines that are now all gathered within the sub. The print function is now completely self-contained with no external helper function dependancies; it’s its own stand-alone entity now — if you give it an array it will try and print it as a tree.

class Node {
    has Any  $.value  is rw;
    has Node $.left   is rw;
    has Node $.right  is rw;
}

class BTree {
    has Node $.root   is rw;
    has Int  $.sum    is rw;
    
    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 NLR_apply (Node $node, Code $f) {
    ## NLR preorder traversal and apply f to node

         $f($node);
        if $node.left {
            $.NLR_apply($node.left, $f);
        }
        if $node.right {
            $.NLR_apply($node.right, $f);
        }
    }
    
    method sum-up ($node = $!root ) {
    ## sum node values to .sum attribute
        $.NLR_apply( $node, -> $node { $!sum += $node.value } )
    }
    
    method replace-with-diff ($node = $!root ) { 
    ## traverse and replace each value with the sum minus the value
        $.sum-up; ## make sure sum is current
        $.NLR_apply( $node, -> $node { $node.value = $!sum - $node.value } )
    }
    
}

sub MAIN () {

    my @data =  6, 
                8, 6, 
                2, Nil, 3, 9, 
                9, 3, Nil, Nil, 5, 1, 2, 1, 
                6, 9, Nil, 6, Nil, Nil, Nil, Nil, 3, 5, Nil, Nil, Nil, 1, 1, 1;
    
    my $tree = BTree.new(serial => @data);

    $tree.replace-with-diff;

    my @dump = $tree.dump_serial;
    
    ## output
    say "Input:\n";
    print_tree(@data);
    say '';
    say "Output:\n";
    print_tree(@dump);


}

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