Perl Weekly Challenge 113.
My solutions (task 1a, task 1, task 1b, and task 2) to the The Weekly Challenge - 113.
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
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
#
# See https://wlmb.github.io/2021/05/22/PWC113/#task-1-represent-integer
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
#
# See https://wlmb.github.io/2021/05/22/PWC113/#task-1-represent-integer
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.
my @answer=find($N,@set);
say("Inputs: N=$N D=$D: Output: ",
@answer? "1 as $N=". join("+", @answer):"0");
sub find {
my ($goal, @set)=@_;
while(defined (my $current=shift @set)){
next if $current > $goal;
return ($current) if $current==$goal;
my @answer=find($goal-$current, @set);
return ($current,@answer) if @answer;
}
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.
#
# See https://wlmb.github.io/2021/05/22/PWC113/#task-1-represent-integer
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.
my @answer=find($N,@set);
say("Inputs: N=$N D=$D: Output: ",
@answer? "1 as $N=". join("+", @answer):"0");
sub find {
my ($goal, @set)=@_;
while(defined (my $current=shift @set)){
next if $current > $goal;
return ($current) if $current==$goal;
my @answer=find($goal-$current, @set);
return ($current,@answer) if @answer;
}
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.
#
# See https://wlmb.github.io/2021/05/22/PWC113/#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,[],[]]]]