Perl Weekly Challenge: Week 113
Challenge 1:
Represent Integer
You are given a positive integer
$Nand a digit$D.Write a script to check if $N can be represented as a sum of positive integers having
$Dat 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
In Raku this can be solved as a one-liner.
my ($N, $D) = @*ARGS; say ([+] (1 .. $N ).grep({ /$D/ })) == $N ?? 1 !! 0;
We .grep() through all the numbers from 1 to $N to find ones that contain $D. These are all added together using the [+] hyper operator and if the result is equal to $N, 1 is printed otherwise 0 is.
Perl requires a bit more code to get around the lack of [+].
my $total = 0;
for my $i (grep { /$D/ } (1 .. $N)) {
$total += $i;
}
say 0 + ($total == $N) ? '1' : '0';
0 + in the last line is to prevent a warning from say().
Challenge 2:
Recreate Binary Tree
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
I chose to hard code the example binary tree in my script.
In Raku I represented each node in the tree like this:
class Node {
has Node $.parent;
has Node $.left is rw;
has Node $.right is rw;
has Int $.value is rw;
}
The structure of the tree was built up like this:
my Node $root = Node.new(parent => Nil, value => 1);
$root.left = Node.new(parent => $root, value => 2);
$root.right = Node.new(parent => $root, value => 3);
$root.left.left = Node.new(parent => $root.left, value => 4);
$root.right.left = Node.new(parent => $root.right, value => 5);
$root.right.right = Node.new(parent => $root.right, value => 6);
$root.left.left.right = Node.new(parent => $root.left.left, value => 7);
The next step is to find the sum of the values of all the nodes in the tree. I did this by recursively
traversing the tree starting from $root with this function:
sub totalFrom(
Node $node
) {
my $sum = $node.value;
if $node.left {
$sum += totalFrom($node.left);
}
if $node.right {
$sum += totalFrom($node.right);
}
return $sum;
}
my $total = totalFrom($root);
For the example tree, $total = 28.
Then I traversed the tree yet again, this time setting .value to $total - the current .value in this function:
sub replaceFrom(
Node $node,
Int $total
) {
$node.value = $total - $node.value;
if $node.left {
replaceFrom($node.left, $total);
}
if $node.right {
replaceFrom($node.right, $total);
}
}
replaceFrom($root, $total);
All that remains is to print out the tree to demonstrate that it has been successfully recreated. This is acheived by once again doing a depth-first traversal of the tree. Unfortunately I didn't have time to make a pretty picture of a tree but this function does accurately display the results.
sub output(
Node $node,
Bool $left = False
) {
if $node.parent {
say (($left) ?? 'left' !! 'right'), " child of {$node.parent.value} = {$node.value}";
} else {
say "root = {$node.value}"
}
if $node.left {
output($node.left, True);
}
if $node.right {
output($node.right);
}
}
output($root);
For Perl I used the [Moo](https://metacpan.org/pod/Moo) module rather than Perls' builtin OOP facilities. So my Node class
looks like this:
package Node {
use Moo;
use namespace::autoclean;
has parent => (
is => 'ro',
isa => sub { return ref eq 'Node' || undef; },
);
has left => (
is => 'rw',
isa => sub { return ref eq 'Node'; },
);
has right => (
is => 'rw',
isa => sub { return ref eq 'Node'; },
);
has value => (
is => 'rw',
isa => sub { return ref eq 'Node'; },
);
}
The tree is built up like this:
my $root = Node->new(parent => undef, value => 1);
$root->left(Node->new(parent => $root, value => 2));
$root->right(Node->new(parent => $root, value => 3));
$root->left->left(Node->new(parent => $root->left, value => 4));
$root->right->left(Node->new(parent => $root->right, value => 5));
$root->right->right(Node->new(parent => $root->right, value => 6));
$root->left->left->right(Node->new(parent => $root->left->left, value => 7));
And the three traversal functions look like this:
sub totalFrom {
my ($node) = @_;
my $sum = $node->value;
if (defined $node->left) {
$sum += totalFrom($node->left);
}
if (defined $node->right) {
$sum += totalFrom($node->right);
}
return $sum;
}
sub replaceFrom {
my ($node, $total) = @_;
$node->value($total - $node->value);
if (defined $node->left) {
replaceFrom($node->left, $total);
}
if (defined $node->right) {
replaceFrom($node->right, $total);
}
}
sub output {
my ($node, $left) = @_;
if (defined $node->parent) {
say q{}, ((defined $left) ? 'left' : 'right'), ' child of ', $node->parent->value, ' = ', $node->value;
} else {
say 'root = ', $node->value;
}
if (defined $node->left) {
output($node->left, 1);
}
if (defined $node->right) {
output($node->right);
}
}