Solutions to challenge 113

2 files changed, 225 insertions, 0 deletions

diff --git a/challenge-113/jo-37/perl/ch-1.pl b/challenge-113/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..2b9be921d4
--- /dev/null
+++ b/challenge-113/jo-37/perl/ch-1.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use experimental qw(signatures postderef);
+
+our $examples;
+
+run_tests() if $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [N D]
+
+-examples
+    run the examples from the challenge
+ 
+N
+    number to be broken down into summands
+
+D
+    digit to appear in summands
+
+EOS
+
+
+### Input and Output
+
+my ($n, $d) = @ARGV;
+say rep_int($n, $d);
+
+
+### Implementation
+
+# Some considerations:
+# - The task neither requires the summands to be distinct nor a solution
+#   to have more than one summand.
+# - Every integer n that is a multiple of the digit d can be represented
+#   as a multiple sum of the given digit.
+# - Every integer having d in its decimal representation is a solution
+#   with itself as the sole summand.
+# - For all d > 0 and 10 * d <= n < 10 * (d + 1) the number starts
+#   with the digit d and thus is a solution itself.
+# - For all d > 0 and 10 * (d + 1) <= n there is a number m with
+#   10 * d <= m < 10 * (d + 1) starting with d and n - m is a multiple
+#   of d.  Thus n is representable as a sum of numbers that have the
+#   digit d in their decimal representation.
+# - For d = 0 and 100 <= n an analogous consideration is applicable when
+#   taking d=10 instead.  As leading zeros do not count, with the taken
+#   modification the second digit becomes zero.
+# - The remaining cases are n < 10 * d with the modified d.  Further
+#   analysis can be applied to these, e.g checking the special cases
+#   where d is one, even or five or is already occurring in n.  However,
+#   skipping any refinements and performing a brute force approach on
+#   this small solution space instead.
+
+sub rep_int ($n, $d) {
+    $d ||= 10;
+    return 1 if $n >= $d * 10;
+
+    # keys are strings, using the numeric values.
+    my %sum = (0 => 0);
+
+    # All numbers containing the digit $d.
+    for (my $num = $d; $num <= $n; $num += 10) {
+        # All sums found so far.
+        for my $sum (values %sum) {
+            # New sums arise from the current sum plus multiples of the
+            # current number.
+            for (my $new = $sum + $num; $new <= $n; $new += $num) {
+                return 1 if $new == $n;
+                $sum{$new} = $new;
+            }
+        }
+    }
+
+    # Not found.
+    0;
+}
+
+
+
+
+### Examples and tests
+
+sub run_tests {
+
+    is rep_int(25, 7), F(), 'example 1';
+    is rep_int(24, 7), T(), 'example 2';
+
+    done_testing;
+    exit;
+}
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;
+}