# Perl Weekly Challenge 151.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 151.

# Task 1: Binary Tree Depth

``````Submitted by: Mohammad S Anwar
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
``````

One could solve this task by building the tree and then running through it breath-first until a leaf is found, or depth-first noting the minimum depth among subtrees. However, given the input format as a sequence of rows, the task is much easier, as it is already half solved. If a row has a pair of missing siblings, that row is beyond the tree’s minimum depth. Thus, I can solve the task with the following one liner.1

``````perl -E 'for(@ARGV){@l=split /\s*\|\s*/; \$d=0; foreach(@l){s/((\S)+)/\$2/g; s/\s+//g;
\$_.=("*" x(2**\$d-length)); last if m/^(..)*(\*\*)/; ++\$d;} say "In: \$_\nOut: \$d";}
' '1 | 2 3 | 4 5' '1 | 2 3 | 4 * * 5 | * 6'
``````

Results:

``````In: 1 | 2 3 | 4 5
Out: 2
In: 1 | 2 3 | 4 * * 5 | * 6
Out: 3
``````

I can better explain the program with its full version.

`````` 1  # Perl weekly challenge 151
2  # Task 1: Binary tree depth
3  #
4  # See https://wlmb.github.io/2022/02/07/PWC151/#task-1-binary-tree-depth
5  use v5.12;
6  use warnings;
7  use Try::Tiny;
8  die "Usage: ./ch-1.pl T1 [T2]...\n"
9      . "where Ti are trees of the form 'R1 | R2...'\n"
10      . "and each row consists of nodes (strings) or an asterisk * (empty node)\n"
11      unless @ARGV;
12  for my \$tree (@ARGV){
13      my @rows=split /\s*\|\s*/, \$tree; # separate into rows.
14      my \$depth=0;   # Depth of first row is 1. This is above the first row
15      try {
16          foreach(@rows){
17              s/((\S)+)/\$2/g; # replace contiguous characters by first
18              s/\s+//g; # remove spaces
19              die "\n" if length > 2**\$depth; # row can't be larger than 2**depth
20              \$_.=("*" x(2**\$depth-length)); # Fill row with asterisks if necessary
21              # Two consecutive asterisks at even-odd position mean we are below a leave
22              # so we have finished our search;
23              last if m/^(..)*(\*\*)/;
24              ++\$depth;  # increase and iterate
25          }
26          say "Input: \$tree\nOutput: \$depth";
27      }
28      catch { say "A row is too long in \$tree";}
29  }
``````

The idea is to change each row into a string with single letters for each node and asterisks for empty nodes. I examine the nodes with a regular expression, two at a time. If both are asterisks, then the node immediately above is a leaf and we are beyond the minimum height of the tree. I iterate over all provided trees and use `Try::Tiny` to catch errors and skip to next tree.

Examples:

``````./ch-1.pl  '1 | 2 3 | 4 5' '1 | 2 3 | 4 * * 5 | * 6'
``````

Results:

``````Input: 1 | 2 3 | 4 5
Output: 2
Input: 1 | 2 3 | 4 * * 5 | * 6
Output: 3
``````

Examples with limit cases and errors (empty tree, just the root, balanced tree, extra separator and long rows):

``````./ch-1.pl  '' '1' '1|2 3| 3 4 5 6' '1|2 3| 3 4 5 6|' '1 2' '1| 2 3 4'
``````

Results:

``````Input:
Output: 0
Input: 1
Output: 1
Input: 1|2 3| 3 4 5 6
Output: 3
Input: 1|2 3| 3 4 5 6|
Output: 3
A row is too long in 1 2
A row is too long in 1| 2 3 4
``````

Another example:

``````./ch-1.pl   '1 | 2 3 | 4 *  * 5 | * 6 * * * * 7 8'
``````

Results:

``````Input: 1 | 2 3 | 4 *  * 5 | * 6 * * * * 7 8
Output: 3
``````

This is wrong! The correct result should have been 4. The problem is that there are missing nodes in level 3 which therefore have empty descendants. I should have also checked that descendants have a parent. Unfortunately, I didn’t realize the error until I read Colin’s review. In the new version, I check that when I find two asterisks that the corresponding char in the previous line was not an asterisk. Below is a four-liner solution.

``````perl -d -E 'for(@ARGV){@l=split /\s*\|\s*/;\$d=0; \$o="";ROW:foreach(@l){
s/((\S)+)/\$2/g; s/\s+//g; \$_.=("*" x(2**\$d-length));\$n=\$_;
while(s/^((..)*)\*\*/\$1../){last ROW unless substr(\$o,length(\$1)/2,1) eq "*";
} \$o=\$n; ++\$d;} say "In: \$_\nOut: \$d";}
' '1 | 2 3 | 4 5' '1 | 2 3 | 4 * * 5 | * 6' '1 | 2 3 | 4 *  * 5 | * 6 * * * * 7 8'
``````

Results:

``````In: 1 | 2 3 | 4 5
Out: 2
In: 1 | 2 3 | 4 * * 5 | * 6
Out: 3
In: 1 | 2 3 | 4 *  * 5 | * 6 * * * * 7 8
Out: 4
``````

So the problem seems to have been corrected.

A full version is

`````` 1  # Perl weekly challenge 151
2  # Task 1: Binary tree depth
3  #
4  # See https://wlmb.github.io/2022/02/07/PWC151/#task-1-binary-tree-depth
5  use v5.12;
6  use warnings;
7  use Try::Tiny;
8  die "Usage: ./ch-1a.pl T1 [T2]...\n"
9      . "where Ti are trees of the form 'R1 | R2...'\n"
10      . "and each row consists of nodes (strings) or an asterisk * (empty node)\n"
11      unless @ARGV;
12  for my \$tree (@ARGV){
13      my @rows=split /\s*\|\s*/, \$tree; # separate into rows.
14      my \$depth=0;   # Depth of first row is 1. This is above the first row
15      try {
16          my \$old='';
17        ROW:
18          foreach(@rows){
19              s/((\S)+)/\$2/g; # replace contiguous characters by first
20              s/\s+//g; # remove spaces
21              die "A row is too long in \$tree\n"
22                  if length > 2**\$depth; # row can't be larger than 2**depth
23              \$_.=("*" x(2**\$depth-length)); # Fill row with asterisks if necessary
24              my \$new=\$_;
25              # A non-empty node below an empty one is an error.
26              while(s/^((\*\*)*)([^\*].|.[^\*])/\$1\*\*/){
27                  die "An empty node may not have descendants in \$tree\n"
28                     if substr(\$old,length(\$1)/2,1) eq "*";
29              }
30              # Two empty nodes below a non-empty node mean the search is over.
31              \$_=\$new;
32              while(s/^((..)*)\*\*/\$1../){
33                  last ROW unless substr(\$old,length(\$1)/2,1) eq "*";
34              }
35              \$old=\$new;
36              ++\$depth;
37        }
38          say "Input: \$tree\nOutput: \$depth";
39      }
40      catch { say \$_;}
41  }
``````

Examples:

``````./ch-1a.pl  '1 | 2 3 | 4 5' '1 | 2 3 | 4 * * 5 | * 6'
``````

Results:

``````Input: 1 | 2 3 | 4 5
Output: 2
Input: 1 | 2 3 | 4 * * 5 | * 6
Output: 3
``````

Examples with limit cases and errors (empty tree, just the root, balanced tree, extra separator and long rows):

``````./ch-1a.pl  '' '1' '1|2 3| 3 4 5 6' '1|2 3| 3 4 5 6|' '1 2' '1| 2 3 4'
``````

Results:

``````Input:
Output: 0
Input: 1
Output: 1
Input: 1|2 3| 3 4 5 6
Output: 3
Input: 1|2 3| 3 4 5 6|
Output: 3
A row is too long in 1 2
A row is too long in 1| 2 3 4
``````

An example with empty nodes with non-empty descendants:

``````./ch-1a.pl   '1 | 2 3 | 4 *  * 5 | * 6 7 * * 8 * 9 '
``````

Results:

``````An empty node may not have descendants in 1 | 2 3 | 4 *  * 5 | * 6 7 * * 8 * 9
``````

An example with empty nodes with empty descendants:

``````./ch-1a.pl   '1 | 2 3 | 4 *  * 5 | * 6 * * * * 7 8'
``````

Results:

``````Input: 1 | 2 3 | 4 *  * 5 | * 6 * * * * 7 8
Output: 4
``````

# Task 2: Rob The House

``````Submitted by: Mohammad S Anwar
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.
``````

The problem can be solved recursively: To find the best way to rob a list L0 of N houses 0..N-1 I first calculate the best way to rob the houses L1=1..N-1 and L2=2..N-1. I compare the bounty from list L1 to that of L2 plus the valuables of house 0 and then decide if I should skip or not house 0. This yields a simple oneliner:

``````perl -E 'sub r {my \$x=shift; return 0 unless defined \$x; return \$x unless @_;
my (\$y,\$z)=(r(@_),\$x+r(@_[1..@_-1])); \$z>\$y?\$z:\$y;} say "Input: ", join " ", @ARGV,
"\nOutput: ", r(@ARGV);' 2 4 5
perl -E 'sub r {my \$x=shift; return 0 unless defined \$x; return \$x unless @_;
my (\$y,\$z)=(r(@_),\$x+r(@_[1..@_-1])); \$z>\$y?\$z:\$y;} say "Input: ", join " ", @ARGV,
"\nOutput: ", r(@ARGV);' 4 2 3 6 5 3
``````

Results:

``````Input: 2 4 5
Output:  7
Input: 4 2 3 6 5 3
Output:  13
``````

Here the subroutine `r` receives as argument a list of houses and recursively determines the largest value that can be obtained.

With a small additional effort I can also print the sequence of houses to visit.

``````perl -E '@v=@ARGV; (\$v,@c)=r(0); say "Input: ", join(" ", @v) ,"\nOutput: \$v Houses: "
, join ", ", @c;sub r{my \$c0=shift; my \$v0=\$v[\$c0]; return (0) if \$c0>=@v;
return (\$v[\$c0], \$c0) if \$c0==@v-1; my (\$v1, @c1)=r(\$c0+1); my (\$v2, @c2)=r(\$c0+2);
my \$v3=\$v0+\$v2;  \$v3>\$v1?(\$v3, \$c0, @c2):(\$v1, @c1);} ' 2 4 5
perl -E '@v=@ARGV; (\$v,@c)=r(0); say "Input: ", join(" ", @v) ,"\nOutput: \$v Houses: "
, join ", ", @c;sub r{my \$c0=shift; my \$v0=\$v[\$c0]; return (0) if \$c0>=@v;
return (\$v[\$c0], \$c0) if \$c0==@v-1; my (\$v1, @c1)=r(\$c0+1); my (\$v2, @c2)=r(\$c0+2);
my \$v3=\$v0+\$v2;  \$v3>\$v1?(\$v3, \$c0, @c2):(\$v1, @c1);} ' 4 2 3 6 5 3
``````

Results:

``````Input: 2 4 5
Output: 7 Houses: 0, 2
Input: 4 2 3 6 5 3
Output: 13 Houses: 0, 3, 5
``````

In this case I pass as argument to the routine `r` the index of the first remaining house to consider, instead of a list of remaining houses. The return value is the sum of the robbed valuables and the list of visited houses.

The full version of the last program would be

`````` 1  # Perl weekly challenge 151
2  # Task 2: Rob the house
3  #
4  # See https://wlmb.github.io/2022/02/07/PWC151/#task-2-rob-the-house
5  use v5.12;
6  use warnings;
7  use Memoize;
8  memoize("optimize");
9  die "Usage: ./ch-1.pl V0 [V1]...\n"
10      . "to optimize the robery of houses 0, 1,... with valuables V0, V1..."
11      unless @ARGV;
12  my @values=@ARGV;
13  my (\$value,@houses)=optimize(0);
14  say "Input: ", join ", ", @values;
15  say "Output: \$value";
16  say "Houses: ", join ", ", @houses;
17  sub optimize {
18      my \$first=shift;
19      my \$value=\$values[\$first];
20      return (0) if \$first >= @values; # No more houses
21      return (\$value, \$first) if \$first==@values-1; # Only one house left
22      my (\$v1, @h1)=optimize(\$first+1); # what if I skip first house?
23      my (\$v2, @h2)=optimize(\$first+2,); # what if I rob first and skip next?
24      my \$v3=\$value+\$v2;
25      \$v3>\$v1 # which option is best?
26          ?(\$v3, \$first, @h2) # First one and skip next
27          :(\$v1, @h1); # or skip first one
28  }
``````

Examples:

``````./ch-2.pl 2 4 5
./ch-2.pl 4 2 3 6 5 3
``````

Results:

``````Input: 2, 4, 5
Output: 7
Houses: 0, 2
Input: 4, 2, 3, 6, 5, 3
Output: 13
Houses: 0, 3, 5
``````

In the case of a large list of houses, there are many repeated calls to `optimize` with the same argument. To avoid duplicate calculations I `use` the `Memoize` module. For just 30 houses it yields a speed increase of about a hundred-fold, and for 36 houses it is more than a thousand-fold.

Large example:

``````perl -E 'say sprintf "%.0f", 100*rand for(0..99)'|xargs ./ch-2.pl
``````

Results (formatted):

``````Input: 76, 19, 48, 24, 28, 41, 13, 49, 59, 53, 87, 69, 93, 13, 74,
58, 14, 83, 52, 29, 71, 95, 91, 67, 73, 32, 38, 63,
3, 75, 71, 3, 34, 38, 65, 4, 90, 35, 44, 44, 93, 68,
28, 36, 73, 58, 80, 71, 40, 86, 67, 46, 75, 69, 48,
49, 18, 82, 33, 35, 37, 68, 0, 25, 65, 33, 4, 52, 72,
78, 84, 52, 90, 52, 7, 52, 77, 84, 32, 8, 13, 51, 36,
28, 27, 66, 71, 76, 42, 55, 85, 39, 54, 59, 39, 60,
99, 26, 68, 84
Output: 2917
Houses: 0, 2, 5, 8, 10, 12, 14, 17, 20, 22, 24, 27, 29, 32, 34,
36, 38, 40, 42, 44, 46, 49, 51, 53, 55, 57, 59, 61, 64, 66,
68, 70, 72, 75, 77, 79, 81, 83, 85, 87, 90, 92, 94, 96, 99
``````

After reading Colin’s review I realized that an alternative meaning of starting with the first is to always rob the house with index 0 (and then, to never rob that with index 1). I did interpret that phrase as start to consider which houses to rob starting with index 0.

# Footnotes

1 There is a mistake. See below

Written on February 7, 2022