laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a couple of hours. This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Tree Inversion

You are given a full binary tree of any height, similar to the one below:

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

Write a script to invert the tree, by mirroring the children of every node, from left to right. The expected output from the tree above would be:

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

The input can be any sensible machine-readable binary tree format of your choosing, and the output should be the same format.

Bonus: In addition to the above, you may wish to pretty-print your binary tree in a human readable text-based format as above.

I'll definitely take the bonus, because making auxiliary subroutines to represent graphically the trees is the best way to check that inversion subroutine works correctly (or to see the errors, if any). But I will not represent the tree edges (the / and \ connecting vertically the letters), because it becomes a bit difficult with 4 levels and more or less unmanageable (and quite ugly) when there are more that 4 levels. For example, I chose to represent a 5-level binary tree as follows:

                1
        2               3
    4       5       6       7
  8   9   a   b   c   d   e   f
 g h i j k l m n o p q r s t u v

I decided to implement two different subroutines for the display: one bft (breadth-first traversal) subroutine to construct an intermediate array of arrays in which each level of the tree is contained in one subarray:

[[1] [2 3] [4 5 6 7] [8 9 a b c d e f] [g h i j k l m n o p q r s t u v]]

and one display subroutine to produce the graphical ASCII representation. The reason for doing that is that the display subroutine can thus be reused, independently of the internal tree representation.

Tree Inversion In Perl

I have discussed in my blog post of last week 3 different ways to represent a binary tree: hash of hashes, array of arrays and a simple flat array, but presented only the array of arrays solution in Perl. This week, I'll use an array of arrays and a flat array.

Tree Inversion Using an Array of Arrays

For each node, the first array item is the current value, the second item the left child and the third item the right child. For example, the binary tree shown in the task description could be initialized as follows:

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

In this implementation, the bft and invert subroutines are both recursive to perform a depth-first traversal of the binary tree.

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

my $tree = [1, [2, [4, [8], [9]], [5, ['a'], ['b']]], 
    [3, [6, ['c'], ['d']], [7, ['e'], ['f']]]];

sub invert {
    my $node = shift;
    invert($node->[1]) if defined $node->[1];
    invert($node->[2]) if defined $node->[2];
    ($node->[1], $node->[2]) = ($node->[2], $node->[1])
        if defined $node->[1] and defined $node->[2]
}
my @bft_tree;
bft ($tree, 0);
say "Tree before inversion:";
display(\@bft_tree);
invert($tree);
@bft_tree = ();
bft ($tree, 0);
say "\nTree after inversion:";
display(\@bft_tree);

sub bft {          # Breadth First Traversal
    my ($node, $level) = @_;   
    push @{$bft_tree[$level]}, $node->[0];
    bft($node->[1], $level + 1) if defined $node->[1];
    bft($node->[2], $level + 1) if defined $node->[2];
}
sub display {
    my $bft_tree = 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;
    }
}

This is the output displayed by this program:

$ perl invert_tree.pl
Tree before inversion:
        1
    2       3
  4   5   6   7
 8 9 a b c d e f

Tree after inversion:
        1
    3       2
  7   6   5   4
 f e d c b a 9 8

Tree Inversion Using a Flat Array

Binary trees can also 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:

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

The parent subroutine is provided here for the purpose of completeness, it is 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, but that's not necessary here, since we are only dealing with full binary trees). 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 invert subroutine becomes very simple, since we can use the bft to get an array of arrays by level, reverse the components and flatten the overall structure:

sub invert {  
    my $bft_tree = bft(shift);
    return [ map {reverse @$_} @$bft_tree ];
}

or even with a single code line:

sub invert {  
    return [ map { reverse @$_ } @{bft(shift)} ];
}

The bft subroutine could be a recursive subroutine as before:

sub bft2 {
    my ($index, $level) = @_;   
    push @{$bft_tree[$level]}, $tree->[$index];
    my ($left, $right) = children $index;
    bft($left, $level + 1) if defined $tree->[$left];
    bft($right, $level + 1) if defined $tree->[$right];
}

but I find it simpler to use a while loop to traverse the tree:

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;
}

This is the final code for the whole program:

#!/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;
}
sub invert {  
    return [ map { reverse @$_ } @{bft(shift)} ];
}

my $tree = [ 1..9, 'a'..'v' ];
say "\nTree before inversion";
display $tree;
my $inverted_tree = invert($tree);
say "\nInverted tree";
display $inverted_tree;

This program produces the following output:

$ perl invert_tree2.pl
Tree before inversion
                1
        2               3
    4       5       6       7
  8   9   a   b   c   d   e   f
 g h i j k l m n o p q r s t u v

Inverted tree
                1
        3               2
    7       6       5       4
  f   e   d   c   b   a   9   8
 v u t s r q p o n m l k j i h g

Tree Inversion In Raku

Using a Flat Array

We'll start with a flat array. Please refer to the Tree Inversion Using a Flat Array section just above for explanations about the use of flat arrays to store binary trees. The Raku code below is essentially a port of the Perl code:

use v6;

sub children (Int $i) { 2*$i+1, 2*$i+2 }
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;
}
sub invert ($tree) {  
    return [ map { | reverse @$_ }, bft($tree) ];
}

my $tree = (1..9, 'a'..'v').flat;
say $tree;
say "\nTree before inversion";
display $tree;
my $inverted_tree = invert($tree);
say "\nInverted tree";
say "$inverted_tree\n";
display $inverted_tree;

Running the program displays more or less the same output as before:

$ perl6 invert_tree2.p6
(1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v)

Tree before inversion:
                1
        2               3
    4       5       6       7
  8   9   a   b   c   d   e   f
 g h i j k l m n o p q r s t u v

Inverted tree:
1 3 2 7 6 5 4 f e d c b a 9 8 v u t s r q p o n m l k j i h g

                1
        3               2
    7       6       5       4
  f   e   d   c   b   a   9   8
 v u t s r q p o n m l k j i h g

Using a Hash of Hashes

A hash of hashes is probably the most explicit and clearest implementation of a binary tree. But it tends to be quite verbose.

A node is a hash consisting in three elements: its value (an integer), its left child and its right child. The children may be undefined when we are at the lowest level of the tree (i.e. when the node is a "leaf"). So a node could be implemented as a hash with three keys, v (value), l (left child) and r (right child). The children, when they are defined, are themselves nodes, so the structure is nested and can be explored recursively. For example, the following binary tree:

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

can be encoded as:

my %tree =  v => 1, 
            l => { v => 2, l => {v => 4}, r => {v => 5} },
            r => { v => 3, l => {v => 6}, r => {v => 7} },
            ;

In this quick and simple implementation, we use global variables for the tree and for the breadth-first array, to avoid the pain of carrying them around back and forth in the successive recursive subroutine calls. In a real-life application, it would be more proper to pass them as arguments and return values of subroutines, or to use dynamic variables.

use v6;

my %tree =  v => 1, 
            l => { v => 2, l => {v => 4}, r => {v => 5} },
            r => { v => 3, l => {v => 6}, r => {v => 7} },
            ;
my @bft-tree;

sub display ($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 (%node, $level) {
    push @bft-tree[$level], %node<v>;
    bft(%node<l>, $level + 1) if defined %node<l>;
    bft(%node<r>, $level + 1) if defined %node<r>;
}
sub invert (%node) {
    invert(%node<l>) if defined %node<l>;
    invert(%node<r>) if defined %node<r>;
    (%node<l>, %node<r>) = %node<r>, %node<l>
        if defined %node<l> and defined %node<r>;
}
bft %tree, 0;
say "Tree before inversion:";
display(@bft-tree);
invert(%tree);
@bft-tree = ();
bft %tree, 0;
say "\nTree after inversion";
display(@bft-tree);

This program produces the following output:

$ ./perl6 invert_tree3.p6
Tree before inversion:
    1
  2   3
 4 5 6 7

Tree after inversion
    1
  3   2
 7 6 5 4

Task 2: Shortest Unique Prefix

Write a script to find the shortest unique prefix for each each word in the given list. The prefixes will not necessarily be of the same length.

Sample Input:

[ "alphabet", "book", "carpet", "cadmium", "cadeau", "alpine" ]

Expected Output:

[ "alph", "b", "car", "cadm", "cade", "alpi" ]

For solving this task, we'll need to examine every combination of two elements of the input list, which means essentially two nested loops. And checking the letters to obtain a unique prefix requires a third nested loop. To alleviate the combinational explosion, we'll start by storing each word in a hash of arrays in accordance with the word's initial letter, so that we can then compare only words with the same initial letter.

Shortest Unique Prefix in Perl

This is my Perl implementation:

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

my @words = qw /alphabet book carpet cadmium cadeau alpine/;
my @prefixes;
my %letters;
for my $word (@words) {
    push @{$letters{ substr $word, 0, 1 }}, $word;
}    
for my $letter (sort keys %letters) {
    push @prefixes, $letter and next if @{$letters{$letter}} == 1;
    my $candidate;
    for my $word1 ( @{$letters{$letter}} ) {
        my $prefix_length = 1;
        for my $word2 (@{$letters{$letter}} ) {
            next if $word1 eq $word2;
            my $i = 1;
            $i++ while substr($word1, $i, 1) eq substr($word2, $i, 1);
            if ($i > $prefix_length) {
                $candidate = substr($word1, 0, $i + 1);
                $prefix_length = $i
            }
        }
    push @prefixes, $candidate;
    }
}
say "@prefixes";

The output is correct:

$ perl prefix.pl
alph alpi b car cadm cade

Shortest Unique Prefix in Raku

Since I'm not entirely satisfied with my Perl implementation, which is a bit too complicated in my view (but was too lazy to change it), I won't port my Perl program to Raku this time, but will try a different approach. This is my Raku implementation:

use v6;

my @words = <alphabet foo book carpet cadmium cadeau alpine foxtrot>;
my @prefixes;
my %letters;
%letters.push(substr($_, 0, 1) =>  $_) for @words;
for %letters.keys.sort -> $let {
    push @prefixes, $let and next if %letters{$let}.elems == 1;
    my $candidate;
    for %letters{$let}.flat -> $word {
        for 2..$word.chars -> $i {
            my $cand = substr $word, 0, $i;
            my $count = %letters{$let}.grep({$cand eq substr($_, 0, $i)}).elems; 
            push @prefixes, $cand and last if $count == 1;
        }
    }
}
say @prefixes;

And this is the output:

$ ./perl6 prefix.p6
[alph alpi b car cadm cade foo fox]

Wrapping up

The next week Perl Weekly Challenge is due to 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 3, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.