# Perl Weekly Challenge 113.

``````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
``````

This may be considered a combinatorial problem that could be solved by examining all subsets of the set of numbers that has at least one digit `\$D` and testing if their sum gives \$N. The subsets may be numbered by a binary number where each bit corresponds to a given candidate number which is included if the bit is 1 or excluded if the bit is 0. I make an iterator that produces all the subsets of a given set. Simple but slow.

``````# Perl weekly challenge 113
# Task 1: Represent integer. Slow, exhaustive
#
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);
use POSIX qw(floor);

my (\$N, \$D)=@ARGV; #get arguments from command line.
die "Usage: ./ch-1a.pl positive-integer digit"
unless defined \$N and defined \$D and \$N>=0
and \$D=~m/^\d\$/ and \$N==floor \$N;
my \$next=subsets(grep {m/\$D/} (1..\$N));
while(my @subset=\$next->()){
say("Inputs: N=\$N D=\$D: Output: 1 as \$N=",
join "+", @subset), exit if sum0(@subset)==\$N;
}
say "Inputs: N=\$N D=\$D: Output: 0";

sub subsets {
my @set=@_;
my \$subset_counter=2**@set; # Total number of subsets
my \$done=0;
sub {
return () if \$done;
--\$subset_counter;
\$done=1, return () unless \$subset_counter;
my @subset=grep {defined \$_}
map {\$subset_counter&(1<<\$_)?\$set[\$_]:undef}
0..@set-1;
return @subset;
}
}
``````

Example:

``````./ch-1a.pl 25 7
./ch-1a.pl 24 7
``````

Results:

``````Inputs: N=25 D=7: Output: 0
Inputs: N=24 D=7: Output: 1 as 24=7+17
``````

Another example:

``````./ch-1a.pl 125 7
``````

Results:

``````Inputs: N=125 D=7: Output: 1 as 125=47+78
``````

The combinatorial method above works, but it is extremely slow.

``````time (./ch-1a.pl 125 7) 2>&1
``````

Results:

``````Inputs: N=125 D=7: Output: 1 as 125=47+78

real	0m11.182s
user	0m11.104s
sys	0m0.016s
``````

I guess it could be made much faster if I discard earlier those subsets that would fail anyway. Thus I try a recursive solution that discards elements that are too large.

``````# Perl weekly challenge 113
# Task 1: Represent integer. Faster, recursive
#
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);
use POSIX qw(floor);

my (\$N, \$D)=@ARGV; #get arguments from command line.
die "Usage: ./ch-1.pl positive-integer digit"
unless defined \$N and defined \$D and \$N>=0
and \$D=~m/^\d\$/ and \$N==floor \$N;
my @set=reverse grep {m/\$D/} (1..\$N); # ordered set from large to small.
say("Inputs: N=\$N D=\$D: Output: ",

sub find {
my (\$goal, @set)=@_;
while(defined (my \$current=shift @set)){
next if \$current > \$goal;
return (\$current) if \$current==\$goal;
}
return ();
}
``````

Example:

``````./ch-1.pl 25 7
./ch-1.pl 24 7
``````

Results:

``````Inputs: N=25 D=7: Output: 0
Inputs: N=24 D=7: Output: 1 as 24=17+7
``````

Another example:

``````time (./ch-1.pl 125 7) 2>&1
``````

Results:

``````Inputs: N=125 D=7: Output: 1 as 125=78+47

real	0m0.014s
user	0m0.014s
sys	0m0.000s
``````

Thus, I can try now much larger examples:

``````time (./ch-1.pl 12345689 7) 2>&1
``````

Results:

``````Inputs: N=12345689 D=7: Output: 1 as 12345689=12345672+17

real	0m19.920s
user	0m18.991s
sys	0m0.795s
``````

Playing with the program, I realized (it should have been obvious), that the output is 1 for all numbers larger or equal than 10*\$D. Thus, the process could be short-circuited.

``````# Perl weekly challenge 113
# Task 1: Represent integer. Even faster, recursive with cutoff.
#
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);
use POSIX qw(floor);

my (\$N, \$D)=@ARGV; #get arguments from command line.
die "Usage: ./ch-1b.pl positive-integer digit"
unless defined \$N and defined \$D and \$N>=0
and \$D=~m/^\d\$/ and \$N==floor \$N;
say("Inputs: N=\$N D=\$D: Output: 1 as \$N>=",\$D*10), exit if \$N>=\$D*10;
my @set=reverse grep {m/\$D/} (1..\$N); # ordered set from large to small.
say("Inputs: N=\$N D=\$D: Output: ",

sub find {
my (\$goal, @set)=@_;
while(defined (my \$current=shift @set)){
next if \$current > \$goal;
return (\$current) if \$current==\$goal;
}
return ();
}
``````

Examples:

``````./ch-1b.pl 25 7
./ch-1b.pl 24 7
./ch-1b.pl 125 7
./ch-1b.pl 12345689 7
``````

Results:

``````Inputs: N=25 D=7: Output: 0
Inputs: N=24 D=7: Output: 1 as 24=17+7
Inputs: N=125 D=7: Output: 1 as 125>=70
Inputs: N=12345689 D=7: Output: 1 as 12345689>=70
``````

# 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
``````

The sum of all the remaining nodes plus the given node is a constant, the sum of all nodes. Thus a solution is given by summing all nodes, recreating the original tree, and replacing each node by its value substracted from the sum. As the tree is binary, I may represent it as an array of the form `[value, left, right]` where `left` and `right` are subtrees or empty arrays. This is ugly but simple and unambiguous. For simplicity, I use recursion.

``````# Perl weekly challenge 113
# Task 2: Recreate binary tree.
#
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);

while(my \$tree_string=shift @ARGV){
say "Input:  \$tree_string";
die "Suspicious tree \$tree_string"
unless \$tree_string=~m{^[][,\-+\d\.\se]*\$};
my \$tree=eval \$tree_string;
die "Bad expression: @!" if @!;
say "Output: ",
stringify_tree(subtract_tree(\$tree, sum_tree(\$tree)));
}

sub sum_tree { #sum and do some rough validation
my \$node=shift;
die "Wrong format" unless ref(\$node) eq "ARRAY";
return 0 if @\$node==0;
return \$node->[0]
+sum0 map {sum_tree(\$node->[\$_])} (1,2) if @\$node==3;
die "Wrong format";
}

sub subtract_tree {
my (\$node, \$from)=@_;
return [] if @\$node==0;
return [\$from-\$node->[0],
map {subtract_tree(\$node->[\$_], \$from)} (1,2)];
}

sub stringify_tree {
my \$node=shift;
return "[]" if @\$node==0;
return sprintf("[%s,%s,%s]", \$node->[0],
map {stringify_tree(\$node->[\$_])} (1,2));
}
``````

Example:

``````./ch-2.pl [1,[2,[4,[],[7,[],[]]],[]],[3,[5,[],[]],[6,[],[]]]]
``````

Results:

``````Input:  [1,[2,[4,[],[7,[],[]]],[]],[3,[5,[],[]],[6,[],[]]]]
Output: [27,[26,[24,[],[21,[],[]]],[]],[25,[23,[],[]],[22,[],[]]]]
``````
Written on May 22, 2021