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

Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on February 20, 2022 at 24:00). 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: Triangle Sum Path

You are given a triangle array.

Write a script to find the minimum sum path from top to bottom.

Example 1:

Input: $triangle = [ [1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8] ]

                1
               5 3
              2 3 4
             7 1 0 2
            6 4 5 2 8

Output: 8

    Minimum Sum Path = 1 + 3 + 2 + 0 + 2 => 8

Example 2:

Input: $triangle = [ [5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9] ]

                5
               2 3
              4 1 5
             0 1 2 3
            7 2 4 1 9

Output: 9

    Minimum Sum Path = 5 + 2 + 1 + 0 + 1 => 9

I originally misunderstood the task. The task clearly speaks about a triangle array, but I mistakenly looked at the representation as if it were a binary tree. I therefore thought that any path would have to go from one parent to one of the two children.

So my original Raku implementation was something like this:

# Wrong understanding of the requirement 
sub dft ($sum-so-far is copy, $row, $col) {
    $sum-so-far += @*tri[$row][$col];
    if @*tri[$row + 1]:exists {
        for 0, 1 -> $i {
            if @*tri[$row + 1][$i]:exists {
                dft($sum-so-far, $row + 1, $col + $i);
            } else {
                $*min-so-far = $sum-so-far if $sum-so-far < $*min-so-far;
            }
        }
    } else {
        $*min-so-far = $sum-so-far if $sum-so-far < $*min-so-far;
    }
}

my @*tri = [1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8];
my $*min-so-far = Inf;
dft(0, 0, 0);
say $*min-so-far;

But when I ran it with the example provided with the task, I did not get the expected results, although there did not seem to be a bug. Looking carefully at the solution of example 1, I found that between row 2 and 3, we jump from 3 to 2, although 2 cannot be a child of 3. So I read again the task specification and discovered that this task had nothing to do with binary trees. With more than 30 years of programming experience, I should obviously know better, and I feel somewhat ashamed about that mistake, but that teaches me a lesson: you’re never too old to learn about very basic tenets of computer science.

In fact, I found afterward that the problem that I had solved had already been proposed just about a year ago (on February 15, 2021) here and that I had solved it in this post.

So, back to the actual task of this week, we don’t care about what the path should look like, and this boils down to finding the summing minimum values for each row.

Triangle Sum Path in Raku

Summing the minimum values of each row is quite simple and straight forward, using the builtin min and sum routines, basically one code line:

for ([1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8]), 
    ([5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9]) -> @tri {
        say @tri, " -> ", sum map { $_.min }, @tri;
    }

This program displays the following output:

$ raku ./triangle-sum2.raku
([1] [5 3] [2 3 4] [7 1 0 2] [6 4 5 2 8]) -> 8
([5] [2 3] [4 1 5] [0 1 2 3] [7 2 4 1 9]) -> 9

Well, may be we want to display not only the path sum, but also the path. This is a simple change:

for ([1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8]), 
    ([5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9]) -> @tri {
  my @mins = map { $_.min }, @tri;
  say @tri, " -> ", @mins, " - ", @mins.sum;
}

This program displays the following output:

$ raku ./triangle-sum2.raku
([1] [5 3] [2 3 4] [7 1 0 2] [6 4 5 2 8]) -> [1 3 2 0 2] - 8
([5] [2 3] [4 1 5] [0 1 2 3] [7 2 4 1 9]) -> [5 2 1 0 1] - 9

Triangle Sum Path in Perl

Here, we need to define (or import) a min subroutine.

If we’re happy just finding the minimum sum, this can be done as follows:

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

sub min {
    my $min = shift;
    for (@_) {
        $min = $_ if $_ < $min;
    }
    return $min;
}

for my $triangle ([ [1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8] ], 
    [ [5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9] ]) {
        my $sum = 0;
        $sum += $_ for map { min(@$_) } @$triangle;
        say join " ", (map { "[@$_]"} @$triangle), " -> $sum";
    }

This program displays the following output:

$ perl  ./triangle-sum-2.pl
[1] [5 3] [2 3 4] [7 1 0 2] [6 4 5 2 8]  -> 8
[5] [2 3] [4 1 5] [0 1 2 3] [7 2 4 1 9]  -> 9

If we want to display the full path, we just need to store it in the @mins:

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

sub min {
    my $min = shift;
    for (@_) {
        $min = $_ if $_ < $min;
    }
    return $min;
}

for my $triangle ([ [1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8] ], 
    [ [5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9] ]) {
        my $sum = 0;
        my @mins = map { min(@$_) } @$triangle;
        $sum += $_ for @mins;
        say join " ", (map { "[@$_]"} @$triangle), " -> ", @mins, " - $sum"
}

Output:

$ perl  ./triangle-sum-2.pl
[1] [5 3] [2 3 4] [7 1 0 2] [6 4 5 2 8]  ->  1 3 2 0 2  - 8
[5] [2 3] [4 1 5] [0 1 2 3] [7 2 4 1 9]  ->  5 2 1 0 1  - 9

Task 2: Rectangle Area

You are given coordinates bottom-left and top-right corner of two rectangles in a 2D plane.

Write a script to find the total area covered by the two rectangles.

Example 1:

Input: Rectangle 1 => (-1,0), (2,2)
       Rectangle 2 => (0,-1), (4,4)

Output: 22

Example 2:

Input: Rectangle 1 => (-3,-1), (1,3)
       Rectangle 2 => (-1,-3), (2,2)

Output: 25

In my first implementation, my idea was to compute the area of the first rectangle, and then to add 1 for each position of rectangle 2 not in rectangle 1. This turned out to be very unpractical.

So I changed my mind and decided to add the areas of the rectangles and subtract the overlap area.

Rectangle Area in Raku

We write a compute_area subroutine to compute the area a rectangle (it will be used three times). Then we compute the overlap area and subtract it from the sum of the two rectangle areas.

My first attempt in Raku was to do it in a typical Perl way.

sub compute_area ( @rect) {
    my $area = (@rect[1][0] - @rect[0][0]) * (@rect[1][1] - @rect[0][1]);
}
for ( ( ( (-1,0) , (2,2)), ( ( 0,-1), (4,4) ) ),
      ( ( (-3,-1), (1,3)), ( (-1,-3), (2,2) ) )
    ) -> $test {
        my @overlap_rect =  
            ( max($test[0][0][0], $test[1][0][0]),   # x 1st point
              max($test[0][0][1], $test[1][0][1]) ), # y 1st point
            ( min($test[0][1][0], $test[1][1][0]),   # x 2nd point
              min($test[0][1][1], $test[1][1][1]) ); # y 2nd point
        my $overlap_area = compute_area @overlap_rect;
        my $area = compute_area($test[0]) + compute_area($test[1]) - $overlap_area;
        my $display = "[ ($test[0][0]) ($test[0][1]) ] " ~
            "[ ($test[1][0]) ($test[1][1]) ]";
        say "Area of $display is: $area";
}

I must admit that computing the overlap_rect is somewhat complicated. Difficult to write, and also difficult to read (more on this later).

This script displays the following output:

$ raku ./rectangle_area.raku
Area of [ (-1 0) (2 2) ] [ (0 -1) (4 4) ] is: 22
Area of [ (-3 -1) (1 3) ] [ (-1 -3) (2 2) ] is: 25

Rectangle Area in Perl

This is a port to Perl of the above Raku program. Here, we need to define additional subroutines min and max that are not built in Perl:

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

sub min {          # min of 2 values
    return $_[0] < $_[1] ? $_[0] : $_[1];
}
sub max {          # max of 2 values
    return $_[0] < $_[1] ? $_[1] : $_[0];
}
sub compute_area {
    my $rect = shift;
    my $area = ($rect->[1][0] - $rect->[0][0]) * ($rect->[1][1] - $rect->[0][1]);
}
for my $test ( [ [ [-1,0] , [2,2]], [ [ 0,-1], [4,4] ] ],
      [ [ [-3,-1], [1,3]], [ [-1,-3], [2,2] ] ] ) {
        my @overlap_rect =  
            ( [ max($test->[0][0][0], $test->[1][0][0]),   # x 1st point
                max($test->[0][0][1], $test->[1][0][1]) ], # y 1st point
              [ min($test->[0][1][0], $test->[1][1][0]),   # x 2nd point
                min($test->[0][1][1], $test->[1][1][1]) ]  # y 2nd point
            );
        my $overlap_area = compute_area([@overlap_rect]);
        my $area = compute_area($test->[0]) + compute_area($test->[1]) - $overlap_area;
        my $display = "[ (@{$test->[0][0]}) (@{$test->[0][1]}) ] " .
            "[ (@{$test->[1][0]}) (@{$test->[1][1]}) ]";
        say "Area of $display is: $area";
}

Rectangle Area in Object-Oriented Raku

It might be argued that such a problem really cries for an object-oriented solution.

In the following implementation, we define a Point class and a Rectangle class. Both are very simple. I originally intended these classes to be just data structures, but then found that it made sense to define the area subroutine to be a Rectangle method.

In the code below, we first define the bl and tr points to define the $rect1 rectangle, for pedagogical purpose. For the two other rectangles ($rect2 and $overlap), the bottom left and top right points are defined as anonymous data structures on the fly.

class Point {
    has Int $.x;        # abscissa
    has Int $.y;        # ordinate
}
class Rectangle {
    has Point $.bl;     # Bottom left point
    has Point $.tr;     # Top right point
    method area {
        return ($.tr.x - $.bl.x) * ($.tr.y - $.bl.y);
    }
}
my $bl = Point.new(x => -1, y => 0);
my $tr = Point.new(x => 2,  y => 2);
my $rect1 = Rectangle.new(bl => $bl, tr => $tr);
my $rect2 = Rectangle.new(
    bl => Point.new(x => 0, y => -1), 
    tr => Point.new(x => 4, y => 4));
my $overlap = Rectangle.new(
    bl => Point.new(
            x => max($rect1.bl.x, $rect2.bl.x),
            y => max($rect1.bl.y, $rect2.bl.y)
        ),
    tr => Point.new(
            x => min($rect1.tr.x, $rect2.tr.x),
            y => min($rect1.tr.y, $rect2.tr.y)
    )
);
say $overlap;       
say "Area: ", $rect1.area + $rect2.area - $overlap.area;

This program displays the following output:

$ raku ./rectangle_area_obj.raku
Area: 22

Two comments. First, the object-oriented version is 31 lines, whereas the non object-oriented version is about 16 lines. This is one of the reasons I am not a great fan of OO. Having said that, I must admit that the OO version is much clearer. The $overlap construction is much easier to write and to understand than the original version.

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