# 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 *L _{0}* of

*N*houses

*0..N-1*I first calculate the best way to rob the houses

*L*and

_{1}=1..N-1*L*. I compare the bounty from list

_{2}=2..N-1*L*to that of

_{1}*L*plus the valuables of house 0 and then decide if I should skip or not house 0. This yields a simple oneliner:

_{2}```
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