laurent_r

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

Task 1: Binary Tree Depth

You are given binary tree.

Write a script to find the minimum depth.

The minimum depth is the number of nodes from the root to the nearest leaf node (node without any children).

Example 1:

Input: '1 | 2 3 | 4 5'

                1
               / \
              2   3
             / \
            4   5

Output: 2

Example 2:

Input: '1 | 2 3 | 4 *  * 5 | * 6'

                1
               / \
              2   3
             /     \
            4       5
             \
              6
Output: 3

The first obvious way to solve this task is to build the tree from the input string and then to walk through it to find the minimum depth. I’ve decided to try another approach: scan the input string to try to find directly the minimum depth. I think this approach works fine, but I may have missed some edge case. I wish I could explain the idea with more details, but I’m running out of time.

Binary Tree Depth in Raku

use v6;

sub min-depth (Str $tree) {
    my @ranks = split /'|'/, $tree;
    return "depth: 1" if @ranks == 1;
    for 1..@ranks.end -> $i {
        my @nodes = @ranks[$i] ~~ m:g/'*' | \d+/;
        return "depth: {$i}" if @nodes.elems + 1 < 2 ** $i and $i == @ranks.end;
        return "depth: {$i+1}" if @nodes.elems + 1 <= 2 ** $i ;
        for (@ranks[$i]).comb(/\S+/) -> $a, $b {
            return "depth: $i" if $a eq $b eq '*';
        }
    return "depth: {$i+1}" if $i == @ranks.end;
    }
}

for '1 ',   '1 |',   '1 | 2 3', 
    '1 | 2 3 | 4 5', 
    '1 | 2 3 | 4 *  * 5 | * 6',
    '1 | 2 3 | * *  4 5 | * * 6',
    '1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 14 ',
    '1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 ',
    '1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 '
    -> $test {
    printf "%-45s -> %s\n", "'$test'", min-depth $test
}

This program displays the following output:

$ raku ./min_depth.raku
'1 '                                          -> depth: 1
'1 |'                                         -> depth: 1
'1 | 2 3'                                     -> depth: 2
'1 | 2 3 | 4 5'                               -> depth: 2
'1 | 2 3 | 4 *  * 5 | * 6'                    -> depth: 3
'1 | 2 3 | * *  4 5 | * * 6'                  -> depth: 2
'1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 14 '   -> depth: 4
'1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 '      -> depth: 4
'1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 '         -> depth: 3

Binary Tree Depth in Perl

use strict;
use warnings;
use feature "say";

sub min_depth {
    my $tree = shift;
    my @ranks = split /\|/, $tree;
    return "depth: 1" if @ranks == 1;
    for my $i (1..$#ranks) {
        # say $ranks[$i];
        my @nodes = ($ranks[$i] =~ /\*|\d+/g);
        # say "@nodes";
        return "depth: $i" if @nodes + 1 < 2 ** $i and $i == $#ranks;
        return "depth: " . ($i+1) if @nodes + 1 <= 2 ** $i ;
        my $j = 0;
        while ($j <= $#nodes) {
            return "depth: $i" if $nodes[$j] eq '*' and $nodes[$j+1] eq '*';
            $j += 2;
        }
        return "depth: ". ($i + 1) if $i + 1 == @ranks;
    }
}

for my $test ( '1 ',   '1 |',   '1 | 2 3', 
    '1 | 2 3 | 4 5', 
    '1 | 2 3 | 4 *  * 5 | * 6',
    '1 | 2 3 | * *  4 5 | * * 6',
    '1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 14 ',
    '1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 ',
    '1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 ' ) {
        printf "%-42s -> %s\n", "$test", min_depth($test);
}

This program displays the following output:

$ perl  ./min-depth.pl
1                                          -> depth: 1
1 |                                        -> depth: 1
1 | 2 3                                    -> depth: 2
1 | 2 3 | 4 5                              -> depth: 2
1 | 2 3 | 4 *  * 5 | * 6                   -> depth: 3
1 | 2 3 | * *  4 5 | * * 6                 -> depth: 2
1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13 14   -> depth: 4
1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12 13      -> depth: 4
1 | 2 3 | 4 4 5 6 | 7 8 9 10 11 12         -> depth: 3

Task 2: Rob the House

You are planning to rob a row of houses, always starting with the first and moving in the same direction. However, you can’t rob two adjacent houses.

Write a script to find the highest possible gain that can be achieved.

Example 1:

Input: @valuables = (2, 4, 5);
Output: 7

If we rob house (index=0) we get 2 and then the only house we can rob is house (index=2) where we have 5.
So the total valuables in this case is (2 + 5) = 7.

Example 2:

Input: @valuables = (4, 2, 3, 6, 5, 3);
Output: 13

The best choice would be to first rob house (index=0) then rob house (index=3) then finally house (index=5).
This would give us 4 + 6 + 3 =13.

Rob the House in Raku

We use a get_best recursive subroutine to explore all combinations of values, except that we don’t need to look ahead more than 2 values.

use v6;

sub get_best(@in, $sum-so-far is copy) {
    if @in.elems <= 2  {
        $sum-so-far += @in.max;
        $*best-so-far = $sum-so-far if $sum-so-far > $*best-so-far;
        return;
    }      
    for 0, 1 -> $i {
        get_best @in[$i + 2 .. @in.end], $sum-so-far + @in[$i];
    }
}
my @valuables = (2, 4, 5), (4, 2, 3, 6, 5, 3), (4, 2, 5, 10);
for @valuables -> $test {
    my $*best-so-far = 0;  # dynamic scope variable
    get_best $test, 0;
    say $test, " -> ", $*best-so-far;
}

This program displays the following output:

$ raku ./robber.raku
(2 4 5) -> 7
(4 2 3 6 5 3) -> 13
(4 2 5 10) -> 14

Rob the House in Perl

We also use a get_best recursive subroutine to explore all combinations of values.

use strict;
use warnings;
use feature "say";

my $best_so_far;

sub get_best {
    my $sum_so_far = $_[0];
    my @in = @{$_[1]};

    if (@in <= 2)  {
        $sum_so_far += $in[0] if @in == 1;
        $sum_so_far += $in[1] if @in == 2;    
        $best_so_far = $sum_so_far if $sum_so_far > $best_so_far;
        return;
    }
    for my $i (0, 1) {
        get_best($sum_so_far + $in[$i], [@in[$i + 2 .. $#in]]);
    }
}

my @valuables = ([2, 4, 5], [4, 2, 3, 6, 5, 3], [4, 2, 5, 10]);
for my $test (@valuables) {
    $best_so_far = 0; 
    get_best 0, $test;
    say "@$test -> ", $best_so_far;
}

This program displays the following output:

$ perl ./robber.pl
2 4 5 -> 7
4 2 3 6 5 3 -> 13
4 2 5 10 -> 14

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 February 20, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.