laurent_r

These are some answers to the Week 113 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Represent Integer

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

I’m very late and have very little time this week, so I’ll implement this task only in Raku.

Represent Integer in Raku

This script first populates the @candidates array with numbers between 1 and the input positive integer where the target digit is present. It then uses the combinations built-in routine to generate all combinations of the numbers in @candidates and checks whether the sum of the number in the combination is equal to the input positive integer.

use v6;

sub sum-int (Int $num, Int $digit where 1 <= $digit <= 9) {
    my @candidates = grep { /$digit/ }, 1..$num;
    for @candidates.combinations -> $comb {
        if $num == [+] $comb {
            # say $comb;
            return 1;
        }
    }
    return 0;
}
for 1..30 -> $test {
    say "$test: ", sum-int $test, 7;
}

The script performs the test for all numbers between 1 and 30 with a targhet digit of 7:

$ raku sum-int.raku
1: 0
2: 0
3: 0
4: 0
5: 0
6: 0
7: 1
8: 0
9: 0
10: 0
11: 0
12: 0
13: 0
14: 0
15: 0
16: 0
17: 1
18: 0
19: 0
20: 0
21: 0
22: 0
23: 0
24: 1
25: 0
26: 0
27: 1
28: 0
29: 0
30: 0

Task 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

Binary trees can be stored in breadth-first order as an array with an implicit data structure. This is similar to what is commonly done for binary heaps (i.e. a binary tree that keeps a partial order). Here, we’re not interested with partial order, but the idea is to use an array with the following properties. The item with subscript 0 is the value of the root node. The index of an element is used to compute the index of its parent and the indices of its children. The basic idea is that, for any node, the index of its parent is about half the index of the current node, and, conversely, the indices of the children are about twice the index of the current node. More precisely, for a tree starting at index 0, the exact formulas for a node with index $n are commonly as follows:

• parent: int( ($n-1)/2 )
• left child: 2*$n + 1
• right child: 2*$n + 2

The root node is at index 0, and its children are at positions 1 and 2. The children of item with index 1 are at positions 3 and 4 and the children of 2 are at positions 5 and 6.

These rules may seem a bit complicated (and it is a bit tedious to compute these things manually), but they’re in fact quite easy to implement in a program. For example, in Perl:

sub children { my $i = shift; 2*$i + 1, 2*$i + 2 }
sub parent { my $i = shift; ($i-1) / 2; }

These children and parent subroutines are provided here for the purpose of completeness, they are not needed in our program.

Note that it is very easy to populate the binary-heap-like array from a graphical representation: you just need to perform a breadth-first traversal (and provide empty slots for missing nodes if any, but we will only be dealing with full binary trees for the sake of simplification). For example, this binary tree:

    1
   /  \
  2    3
 / \  / \
4   5 6  7

can be encoded as:

my $tree = [1 , 2, 3, 4, 5, 6, 7];

or even:

my $tree = [1 .. 7];

Now, the required task becomes very simple, as we can just manipulate the flat array.

We also provide a bft and a display subroutines for the purpose of displaying a graphical ASCII representation of the data in a tree format.

Recreate Binary Tree in Raku

We’re using a flat array to store the binary tree data structure, as described above:

use v6;

sub children (Int $i) { 2*$i+1, 2*$i+2 }  # not needed here
sub parent (Int $i) { ($i-1)/2; }         # not needed here

sub display ($tree) {
    my @bft_tree = bft($tree);
    my $start = (@bft_tree[*-1]).elems;
    my $sep_val = (2 * $start) - 1;
    for @bft_tree -> @line {
        my $sep = " " x $sep_val;
        say " " x $start, join $sep, @line;
        $start /= 2;
        $sep_val = ($sep_val - 1) / 2;
    }
}
sub bft ($tree) {               # Breadth First Traversal
    my ($index, $level) = (0, 0);
    my @bft_tree;
    while ($index <= $tree.end) {
        my $new_index = $index + 2 ** $level - 1;
        (@bft_tree[$level++]).append($tree[$index .. $new_index]);
        $index = $new_index + 1;
    }
    return @bft_tree;
}

my @tree = 1..7;
say "Tree before change:";
display @tree;
my $sum = [+] @tree;
my @new-tree = map { $sum - $_ }, @tree;
say "\nTree after change:";
display @new-tree;

Note that the performing the task requires only two lines of code:

my $sum = [+] @tree;
my @new-tree = map { $sum - $_ }, @tree;

It is the code to display the data in a tree format that takes most of the code.

This program displays the following output:

$ raku bin-tree.raku
Tree before change:
    1
  2   3
 4 5 6 7

Tree after change:
    27
  26   25
 24 23 22 21

Recreate Binary Tree in Perl

We’re again using a flat array to store the binary tree data structure, as described above:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

sub children { my $i = shift; 2*$i+1, 2*$i+2 }
sub parent { my $i = shift; ($i-1)/2; }  # not needed here

sub display {
    my $bft_tree = bft(shift);
    my $start = scalar @{$bft_tree->[-1]};
    my $sep_val = (2 * $start) - 1;
    for my $line (@$bft_tree) {
        my $sep = " " x $sep_val;
        say " " x $start, join $sep, @$line;
        $start /= 2;
        $sep_val = ($sep_val - 1) / 2;
    }
}
sub bft {               # Breadth First Traversal
    my $tree = shift;
    my ($index, $level) = (0, 0);
    my @bft_tree;
    while ($index < scalar @$tree) {
        my $new_index = $index + 2 ** $level - 1;
        push @{$bft_tree[$level++]}, @{$tree}[$index .. $new_index];
        $index = $new_index + 1;
    }
    return \@bft_tree;
}

my $tree = [ 1..7 ];
say "\nTree before change:";
display $tree;
my $sum = 0;
$sum += $_ for @$tree;
my $new_tree = [ map $sum - $_, @$tree ];
say "\nNew tree";
display $new_tree;

This program displays the following output:

$ perl bin-tree.pl

Tree before change:
    1
  2   3
 4 5 6 7

New tree
    27
  26   25
 24 23 22 21

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, May 30, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.