diff options
| -rwxr-xr-x | challenge-113/jo-37/perl/ch-1.pl | 92 | ||||
| -rwxr-xr-x | challenge-113/jo-37/perl/ch-2.pl | 133 |
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; +} |