From 173239f6789e65a1a5c971f8a2e81cddd9c62f95 Mon Sep 17 00:00:00 2001
From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com>
Date: Mon, 17 May 2021 22:05:23 +0200
Subject: Solution to task 2

---
 challenge-113/jo-37/perl/ch-2.pl | 133 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 133 insertions(+)
 create mode 100755 challenge-113/jo-37/perl/ch-2.pl

diff --git a/challenge-113/jo-37/perl/ch-2.pl b/challenge-113/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..adf254f56f
--- /dev/null
+++ b/challenge-113/jo-37/perl/ch-2.pl
@@ -0,0 +1,133 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use Data::Dump;
+use experimental qw(signatures postderef);
+
+our $examples;
+
+run_tests() if $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [node ...]
+
+-examples
+    run the examples from the challenge
+ 
+node ...
+    build binary tree from given nodes.  Each node has the form:
+    id:value[:left[:right]]
+    where
+        id is a unique node identifier
+        value is the node's value
+        left is the id of the left child node (may be missing or empty)
+        right is the id of the right child node (may be missing)
+    The nodes may be specified in any order, but the root node must have
+    an id of 'ROOT'.  The given example could be written as
+
+    ROOT:1:n2:n3 n2:2:n4 n4:4::n7 n3:3:n5:n6 n5:5 n6:6 n7:7
+
+EOS
+
+### Input and Output
+
+# A price winning solution to this task will certainly provide a nice
+# print-out of the binary tree.  So this is out of the running.
+
+my $tree = BinaryTree->build(@ARGV);
+dd [@$tree];
+recreate_tree($tree);
+dd [@$tree];
+
+
+### Implementation
+
+sub recreate_tree ($tree) {
+
+    # Get the sum of all node values and collect references to them.
+    my $sum;
+    my @nodes;
+    $tree->traverse(sub {
+            $sum += $_->[0];
+            push @nodes, \$_->[0];
+        });
+
+    # Adjust the nodes' values as the sum minus the old value.
+    $$_ = $sum - $$_ for @nodes;
+}
+
+package BinaryTree;
+
+# Re-using the binary tree implementation from challenge 094 with
+# slight modifications: NRL only traversal and an additional
+# constructor.
+
+# Minimal object implementation of a binary tree providing just the
+# methods required for this task.
+#
+# Each node $n is represented by an array reference with:
+# $n->[0] holding the node data
+# $n->[1] pointing to the left sub tree
+# $n->[2] pointing to the right sub tree
+#
+# The tree root is the only blessed node in the tree.
+
+# Constructor for a binary tree with up to three arguments:
+# - the root node's data
+# - an optional left sub tree
+# - an optional right sub tree
+sub new ($class, $data, $left=undef, $right=undef) {
+    bless [$data, $left, $right], $class;
+}
+
+# Transformed the sub "build_tree" from challenge 094 into an
+# alternative constructor.  Each node has the form:
+# id:value[:left[:right]]
+# See help text.
+sub build ($class, @nodes) {
+    # Capture nodes.
+    my %nodes = map {
+        my ($id, %val);
+        ($id, @val{qw(val left right)}) = split /:/;
+        ($id => \%val)
+    } @nodes;
+
+    # Dynamically build the tree from the given nodes while traversing.
+    my $tree = $class->new('ROOT');
+    $tree->traverse(sub {
+        my %node = $nodes{$_->[0]}->%*;
+        $_->[0] = $node{val};
+        $_->[1] = [$node{left}] if $node{left};
+        $_->[2] = [$node{right}] if $node{right};
+    });
+
+    $tree;
+}
+
+# Depth-first NLR traversal of the binary tree starting from its root.
+# The code ref is called for every node with $_ set to the current node.
+sub traverse ($self, $code) {
+    # Recursively process the tree in NLR order.  Nodes are
+    # not blessed and thus have no methods.
+    do {local $_ = $self; $code->()};
+    traverse($_, $code) for grep $_, $self->@[1 .. $#$self];
+}
+
+
+### Examples and tests
+
+package main;
+
+sub run_tests {
+
+    my $tree = BinaryTree->new(
+        1, [2, [4, undef, [7]]], [3, [5], [6]]
+    );
+    recreate_tree($tree);
+    is $tree, [27, [26, [24, undef, [21]]], [25, [23], [22]]],
+        'example';
+
+    done_testing;
+    exit;
+}
-- 
cgit