laurent_r

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

Spoiler Alert: This weekly challenge deadline is due in a few days (November 22, 2020). 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: Longest Consecutive Sequences

You are given an unsorted array of integers @N.

Write a script to find the longest consecutive sequence. Print 0 if none sequence found.

Example 1:

Input: @N = (100, 4, 50, 3, 2)
Output: (2, 3, 4)

Example 2:

Input: @N = (20, 30, 10, 40, 50)
Output: 0

Example 3:

Input: @N = (20, 19, 9, 11, 10)
Output: (9, 10, 11)

We’re given an unsorted array, but there is nothing preventing us from starting by sorting the array. Once the input is sorted, the solution is quite easy. Note that, if Raku or Perl did not have a built-in sort function, the first thing I would do is probably to implement a sort subroutine. I have shown elsewhere that a quick sort or merge sort subroutine can be written in about half a dozen code lines, both in Raku and in Perl, with a functional programming approach. For example, this is a quick sort implementation in Raku:

sub quicksort (@input) {
    return @input if @input.elems <= 1;
    my $pivot = @input[@input.elems div 2];
    return flat quicksort(grep {$_ < $pivot}, @input), 
        (grep {$_ == $pivot}, @input), 
        quicksort(grep {$_ > $pivot}, @input);
}

Longest Consecutive Sequences in Raku

We use three input arrays for our tests. For each test case, we simply sort the input array and scan the sorted results for consecutive sequences. Consecutive sequences are stored in the @sequences array of arrays and we finally display the longest sequence:

use v6;

my @tests = [ 100, 4, 50, 3, 2 ],
            [ 20, 30, 10, 40, 50 ],
            [ 20, 19, 9, 11, 10 ];

for @tests -> @t {
    my @in = sort @t;
    my $last = @in[0];
    my @sequences;
    my $index = 0;
    push @sequences[$index], $last;
    for 1..@in.end -> $i {
        my $current = @in[$i];
        $index++ if $current != $last + 1;
        push @sequences[$index], $current;
        $last = $current;
    }
    my @sorted_seq = sort { $^b.elems <=> $^a.elems }, @sequence;
    if @sorted_seq[0] > 1 {
        say @sorted_seq[0];
    } else {
        say 0;
    }
}

This displays the following output:

[2 3 4]
0
[9 10 11]

Longest Consecutive Sequences in Perl

In this Perl version, we also use three input arrays for our tests. For each test case, we simply sort the input array and scan the sorted results for consecutive sequences. Consecutive sequences are stored in the @sequences array of arrays and we simply output the longest sequence:

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @tests = ( [ 100, 4, 50, 3, 2 ],
              [ 20, 30, 10, 40, 50 ],
              [ 20, 19, 9, 11, 10 ]
            );

for my $t_ref (@tests) {
    my @in = sort { $a <=> $b } @$t_ref;
    my $last = $in[0];
    my @sequences;
    my $index = 0;
    push @{$sequences[$index]}, $last;
    for my $i (1..$#in) {
        my $current = $in[$i];
        $index++ if $current != $last + 1;
        push @{$sequences[$index]}, $current;
        $last = $current;
    }
    my @sorted_seq = sort { scalar @$b <=> scalar @$a } @sequences;
    if (scalar @{$sorted_seq[0]} > 1) {
        say "@{$sorted_seq[0]}";
    } else {
        say 0;
    }
}

This is the output displayed by this script:

$ perl longest-seq.pl
2 3 4
0
9 10 11

Longest Consecutive Sequences in Scala

This is my implementation in Scala (added on Jan., 15, 2021):

object longestSeq extends App {
  val in = Seq(100, 4, 50, 3, 2)
  val sorted = in.sorted
  var sequences = Array.empty[Array[Int]]
  var lastEl = sorted(0)
  var oneSeq = Array(lastEl)
  for (current <- sorted.tail) {
    if (current != lastEl + 1) {
      sequences :+= oneSeq
      oneSeq = Array(current)
    } else {
      oneSeq :+= current
    }
    lastEl = current
  }
  sequences = sequences :+ oneSeq
  val sortedSeq = sequences.sortWith(_.size > _.size)
  if (sortedSeq(0).size > 1) {
    println(sortedSeq(0).mkString(" "))
  } else {
    println(0)
  }
}

This program duly prints:

2 3 4

Task 2: Largest Rectangle

You are given matrix m x n with 0 and 1.

Write a script to find the largest rectangle containing only 1. Print 0 if none found.

Example 1:

Input:
    [ 0 0 0 1 0 0 ]
    [ 1 1 1 0 0 0 ]
    [ 0 0 1 0 0 1 ]
    [ 1 1 1 1 1 0 ]
    [ 1 1 1 1 1 0 ]

Output:
    [ 1 1 1 1 1 ]
    [ 1 1 1 1 1 ]

Example 2:

Input:
    [ 1 0 1 0 1 0 ]
    [ 0 1 0 1 0 1 ]
    [ 1 0 1 0 1 0 ]
    [ 0 1 0 1 0 1 ]

Output: 0

Example 3:

Input:
    [ 0 0 0 1 1 1 ]
    [ 1 1 1 1 1 1 ]
    [ 0 0 1 0 0 1 ]
    [ 0 0 1 1 1 1 ]
    [ 0 0 1 1 1 1 ]

Output:
    [ 1 1 1 1 ]
    [ 1 1 1 1 ]

At first glance, this seemed to be a fairly easy task. It turned out to be much more complicated than I expected.

My initial idea was to scan the matrix from top left to bottom right, and, for any 1 found, to try to expand this position into a region toward the right and toward the bottom. When starting to think about the implementation, I found that this approach was going to be complicated, painful, and probably quite clumsy.

So, I decided to proceed in a different way: generate all rectangles toward the right and the bottom of any position with a 1, then eliminate those containing at least one zero, and find the largest remaining rectangle. In both the Raku and the Perl programs below, a rectangle consists of at least two contiguous 1s, and is uniquely defined by its top left and bottom right corners.

As both the Raku and the Perl programs described below are a bit complicated, I will avoid abusing the expressive power of the programming language ans will describe separately the main steps of the algorithm before providing the full program.

Largest Rectangle in Raku

For this program, we’ll use six matrices as test cases:

my @matrices = 
    [ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ], 
    [ [ <1 1 0 1> ], [ <1 1 0 0> ], [ <0 1 1 1> ], [ <1 0 1 1> ] ],
    [ [ <0 1 0 1> ], [ <1 0 1 0> ], [ <0 1 0 0> ], [ <1 0 0 1> ] ],

    [ [ <1 1 0 1 1 1> ], [ <1 1 1 0 1 0> ], 
        [ <1 1 0 1 0 1> ], [ <1 1 1 0 0 1> ] 
    ],

    [ [ <0 0 0 1 0 0> ], [ <1 1 1 0 0 0> ], 
      [ <0 0 1 0 0 1> ], [ <1 1 1 1 1 0> ], [ <1 1 1 1 1 0>],
    ],

    [ [ <0 0 0 1 1 1> ], [ <1 1 1 1 1 1> ], 
      [ <0 0 1 0 0 1> ], [ <0 0 1 1 1 1> ], 
      [ <0 0 1 1 1 1> ],
    ];

The first step will be to iterate over the six test cases and for each test matrix, to call the print-matrix subroutine (which pretty-prints the input matrix) and the find-rect subroutine, which does most of the work and will be described in greater detail below.

for @matrices -> @m {
    print-matrix @m;
    find-rect @m;
}

The print-matrix reads the input matrix line by line and prints a formated version of all such lines:

sub print-matrix (@matrix) {
    say "[ $_ ]" for @matrix;
    say "";
}

For our first test matrix:

[ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ]

this subroutine prints this:

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

As said before, the find-rect does the bulk of the work.

First, we make a @positions array of all positions (defined by their coordinates) in the matrix that contain a value equal to 1. For this, we use the X infix cross operator to generate a Cartesian product of all positions and filter out positions whose value in the matrix is not equal to 1:

my $max-h = @m.end;
my $max-w = @m[0].end;
my @positions =  ((0..$max-h) X  (0..$max-w))
    .grep({@m[$_[0]][$_[1]] == 1});

For the first test matrix, the list of valid positions is this:

[(0 1) (0 3) (1 2) (2 0) (2 1) (2 3) (3 0) (3 1) (3 3)]

The next step is to create a @pairs list of pairs of positions (which will represent the top left and bottom right corners of each rectangle). For this, we use the combinations built-in routine of Raku:

    my @pairs = @positions.combinations: 2;

For our first test matrix, this generates a data structure like so (slightly reformatted for clarity):

[((0 1) (0 3))  ((0 1) (1 2))  ((0 1) (2 0))  ((0 1) (2 1)) 
 ((0 1) (2 3))  ((0 1) (3 0))  ((0 1) (3 1))  ((0 1) (3 3)) 
 [content omitted for brevity]
 ((2 1) (3 1))  ((2 1) (3 3))  ((2 3) (3 0))  ((2 3) (3 1)) 
 ((2 3) (3 3))  ((3 0) (3 1))  ((3 0) (3 3))  ((3 1) (3 3))]

Note that, at this point, the rectangles represented by those point pairs may contain some 0s (we only know that the point pairs themselves are 1s). For example, the first point pair above:

((0 1) (0 3))

corresponds to the following rectangle in the input matrix:

1 0 1

As it can be seen, the bounds are 1s, but the middle item if 0. This is not a valid rectangle candidate.

In addition, the ((0 1) (3 0)) pair in the second line doesn’t define a valid rectangle because the second coordinate of the first pair (1) is larger than its counterpart in second pair, and we said that the first pair must represent the top left and the second pair the bottom right points of the rectangle. Here, the second point is to the left of the first. We need to eliminate these malformed rectangles.

The next step is therefore to keep only valid rectangles rectangles and store them into the @eligible array:

my @eligible = gather {
    for @pairs -> $p {
        # Remove malformed rectangles
        next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
        # remove rectangles containing 0s.
        next if @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]].any == 0; 
        take $p;
    }
}

Note that the following expression (using a semi-colon to separate the coordinate ranges) : @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]]

flattens the input rectangle into a flat list, so that we can use a simple any junction to detect any 0 item.

If the @eligible array is empty, then we did not find any suitable rectangle. In such a case, we print 0 and exit the subroutine.

say "0\n" and return unless @eligible;

In the case of our first test matrix, there are six eligible rectangles:

[((2 0) (2 1))  ((2 0) (3 0))  ((2 0) (3 1))  
 ((2 1) (3 1))  ((2 3) (3 3))  ((3 0) (3 1))
]

We now need to pick the largest rectangle. For this, we simply sort in descending order according to their area size. In Raku, when the code object passed as the first parameter to the sort subroutine takes only one parameter, then it is not a comparison code block, but a code object implementing the transformation to be applied to all items before applying the default cmpcomparison subroutine. Here, we use this code block:

{($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1)}

in order to compute the area of the rectangle and use it for the comparison. So the sort block looks like this:

my $rect = (reverse sort { 
        ($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1) 
        }, @eligible)[0];

Now, we’re done, we have the largest rectangle, we only need to display the result.

This is the full code of the program:

use v6;

my @matrices = 
    [ [ <0 1 0 1> ], [ <0 0 1 0> ], [ <1 1 0 1> ], [ <1 1 0 1> ] ], 
    [ [ <1 1 0 1> ], [ <1 1 0 0> ], [ <0 1 1 1> ], [ <1 0 1 1> ] ],
    [ [ <0 1 0 1> ], [ <1 0 1 0> ], [ <0 1 0 0> ], [ <1 0 0 1> ] ],

    [ [ <1 1 0 1 1 1> ], [ <1 1 1 0 1 0> ], 
        [ <1 1 0 1 0 1> ], [ <1 1 1 0 0 1> ] 
    ],

    [ [ <0 0 0 1 0 0> ], [ <1 1 1 0 0 0> ], 
      [ <0 0 1 0 0 1> ], [ <1 1 1 1 1 0> ], [ <1 1 1 1 1 0>],
    ],

    [ [ <0 0 0 1 1 1> ], [ <1 1 1 1 1 1> ], 
      [ <0 0 1 0 0 1> ], [ <0 0 1 1 1 1> ], 
      [ <0 0 1 1 1 1> ],
    ];

for @matrices -> @m {
    print-matrix @m;
    find-rect @m;
}
sub print-matrix (@matrix) {
    say "[ $_ ]" for @matrix;
    say "";
}

sub find-rect (@m) {
    my $max-h = @m.end;
    my $max-w = @m[0].end;
    my @positions =  ((0..$max-h) X  (0..$max-w))
        .grep({@m[$_[0]][$_[1]] == 1});
    # say @positions;
    my @pairs = @positions.combinations: 2;
    # say @pairs;
    my @eligible = gather {
        for @pairs -> $p {
            next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
            next if @m[$p[0][0]..$p[1][0];$p[0][1]..$p[1][1]].any == 0; 
            take $p;
        }
    }
    say "0\n" and return unless @eligible;
    my $rect = (reverse sort { 
            ($_[1][0] - $_[0][0] + 1) * ($_[1][1] - $_[0][1] + 1) 
            }, @eligible)[0];
    say  "Rectangle corners: ", $rect;
    for $rect[0][0]..$rect[1][0] -> $row {
        say @m[$row][$rect[0][1]..$rect[1][1]];
    }
    say "";
}

This program displays the following output:

$ raku rectangular-matrix.raku
[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

Rectangle corners: ((2 0) (3 1))
(1 1)
(1 1)

[ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Rectangle corners: ((2 2) (3 3))
(1 1)
(1 1)

[ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]

0

[ 1 1 0 1 1 1 ]
[ 1 1 1 0 1 0 ]
[ 1 1 0 1 0 1 ]
[ 1 1 1 0 0 1 ]

Rectangle corners: ((0 0) (3 1))
(1 1)
(1 1)
(1 1)
(1 1)

[ 0 0 0 1 0 0 ]
[ 1 1 1 0 0 0 ]
[ 0 0 1 0 0 1 ]
[ 1 1 1 1 1 0 ]
[ 1 1 1 1 1 0 ]

Rectangle corners: ((3 0) (4 4))
(1 1 1 1 1)
(1 1 1 1 1)

[ 0 0 0 1 1 1 ]
[ 1 1 1 1 1 1 ]
[ 0 0 1 0 0 1 ]
[ 0 0 1 1 1 1 ]
[ 0 0 1 1 1 1 ]

Rectangle corners: ((3 2) (4 5))
(1 1 1 1)
(1 1 1 1)

Largest Rectangle in Perl

For this program, we’ll use seven matrices for our test cases:

my @matrices = 
    ( [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ], 
        [ qw <1 1 0 1> ], [ qw <1 1 0 1> ] 
      ], 

      [ [ qw <1 1 0 1> ], [ qw <1 1 0 0> ], 
        [ qw <0 1 1 1> ], [ qw <1 0 1 1> ] 
      ],

      [ [ qw <0 1 0 1> ], [ qw <1 0 1 0> ], 
        [ qw <0 1 0 0> ], [ qw <1 0 0 1> ] 
      ],

      [ [ qw <1 1 0 1 1 1> ], [ qw <1 1 1 0 1 0> ], 
          [ qw <1 1 0 1 0 1> ], [ qw <1 1 1 0 0 1> ] 
      ],

      [ [ qw <0 0 0 1 0 0> ], [ qw <1 1 1 0 0 0> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <1 1 1 1 1 0> ], 
          [ qw <1 1 1 1 1 0>],
      ],
      [ [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ], 
          [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ],
      ],
      [ [ qw <0 0 0 1 1 1> ], [ qw <1 1 1 1 1 1> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <0 0 1 1 1 1> ], 
          [ qw <0 0 1 1 1 1> ],
      ],
    );

The first step will be to iterate over the seven test cases and for each test matrix, to call the print_matrix subroutine (which pretty-prints the input matrix) and the find_rect subroutine, which does most of the work and will be described in detail below.

for my $m_ref (@matrices) {
    print_matrix($m_ref);
    find_rect($m_ref);
}

sub print_matrix {
    my @matrix = @{$_[0]};
    say "";
    say "[ @$_ ]" for @matrix;
    say "";
}

For our first sample matrix:

             [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ], 
               [ qw <1 1 0 1> ], [ qw <1 1 0 1> ] 
             ],

the print_matrix subroutine displays this:

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

As said before, the find-rect does the bulk of the work.

First, we make a @positions array of all positions (defined by their coordinates) in the matrix that contain a value equal to 1. For this, we use a nested for loop:

my @positions;
for my $i (0..$#m) {
    for my $j (0..$#{$m[0]}) {
        push @positions, [$i, $j] unless $m[$i][$j] == 0;
    }
}

For the first test matrix, we obtain the following non-zero positions:

(0 1) (0 3) (1 2) (2 0) (2 1) (2 3) (3 0) (3 1) (3 3)

Then we use another nested for loop to find all the point pairs:

my @pairs;
for my $k (0..$#positions) {
    for my $n ($k+1..$#positions) {
        push @pairs, [ [@{$positions[$k]}], [@{$positions[$n]}] ];
    }
}

Note that, at this point, the rectangles represented by those point pairs may contain some 0s (we only know that the point pairs themselves are 1s). For example, the first point pair generated:

((0 1) (0 3))

corresponds to the following rectangle in the matrix:

1 0 1

As it can be seen, the bounds are 1s, but the middle item is 0. This is not a valid rectangle candidate.

In addition, we obtain pairs such as ((0 1) (3 0)) , which doesn’t define a valid rectangle because the second coordinate of the first pair (1) is larger than its counterpart in second pair, and we said earlier that the first pair must represent the top left point and the second pair the bottom right point of the rectangle. Here, the second point is to the left of the first. We need to eliminate these malformed rectangles.

The code below eliminates invalid rectangles and stores the others in the @eligible array:

my @eligible;
for my $p_ref (@pairs) {
    my @p = @$p_ref;
    # Remove malformed rectangles
    next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
    # Remove rectangles containing 0s
    my $only_ones = 1;
    for my $i ($p[0][0].. $p[1][0]) {
        for my $j ($p[0][1]..$p[1][1]) {
            if ($m[$i][$j] == 0) {
                $only_ones = 0;
                next;
            }
        }
    }
     push @eligible, $p_ref if $only_ones;
}

If the @eligible array is empty, then we did not find any suitable rectangle. So, we print out 0 and exit the subroutine.

say "0\n" and return unless @eligible;

In the case of our first test matrix, there are six eligible rectangles left:

((2 0) (2 1))  ((2 0) (3 0))  ((2 0) (3 1))  ((2 1) (3 1))  ((2 3) (3 3))  ((3 0) (3 1))

We now need to find the largest rectangle. For this, we sort the eligible rectangles in descending order according to their area size and pick the first one in the sorted list. Since the comparison routine computing the rectangle area is somewhat complicated, we use a Schwartzian Transform for the sort:

my @sorted = map { $_->[0] } 
             sort { $b->[1] <=> $a->[1] }
             map { [$_, ($_->[1][0] - $_->[0][0] + 1) 
                   * ($_->[1][1] - $_->[0][1] + 1)] } 
                   @eligible;
my $rect = $sorted[0];

Now that we have found the largest rectangle, we only need to display the result.

This is the full code of the program:

use strict;
use warnings;
use feature "say";
use Data::Dumper;

my @matrices = 
    ( [ [ qw <0 1 0 1> ], [ qw <0 0 1 0> ], 
        [ qw <1 1 0 1> ], [ qw <1 1 0 1> ] 
      ], 

      [ [ qw <1 1 0 1> ], [ qw <1 1 0 0> ], 
        [ qw <0 1 1 1> ], [ qw <1 0 1 1> ] 
      ],

      [ [ qw <0 1 0 1> ], [ qw <1 0 1 0> ], 
        [ qw <0 1 0 0> ], [ qw <1 0 0 1> ] 
      ],

      [ [ qw <1 1 0 1 1 1> ], [ qw <1 1 1 0 1 0> ], 
          [ qw <1 1 0 1 0 1> ], [ qw <1 1 1 0 0 1> ] 
      ],

      [ [ qw <0 0 0 1 0 0> ], [ qw <1 1 1 0 0 0> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <1 1 1 1 1 0> ], 
          [ qw <1 1 1 1 1 0>],
      ],
      [ [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ], 
          [ qw <1 0 1 0 1 0> ], [ qw <0 1 0 1 0 1> ],
      ],
      [ [ qw <0 0 0 1 1 1> ], [ qw <1 1 1 1 1 1> ], 
          [ qw <0 0 1 0 0 1> ], [ qw <0 0 1 1 1 1> ], 
          [ qw <0 0 1 1 1 1> ],
      ],
    );

for my $m_ref (@matrices) {
    print_matrix($m_ref);
    find_rect($m_ref);
}

sub print_matrix {
    my @matrix = @{$_[0]};
    say "";
    say "[ @$_ ]" for @matrix;
    say "";
}

sub find_rect {
    my @m = @{$_[0]};
    my $max_h = scalar @m;
    my $max_w = scalar @{$m[0]};
    my @positions;
    for my $i (0..$#m) {
        for my $j (0..$#{$m[0]}) {
            push @positions, [$i, $j] unless $m[$i][$j] == 0;
        }
    }
    my @pairs;
    for my $k (0..$#positions) {
        for my $n ($k+1..$#positions) {
            push @pairs, [ [@{$positions[$k]}], [@{$positions[$n]}] ];
        }
    }

    my @eligible;
    for my $p_ref (@pairs) {
        my @p = @$p_ref;
        next if $p[0][0] > $p[1][0] or $p[0][1] > $p[1][1];
        my $only_ones = 1;
        for my $i ($p[0][0].. $p[1][0]) {
            for my $j ($p[0][1]..$p[1][1]) {
                if ($m[$i][$j] == 0) {
                    $only_ones = 0;
                    next;
                }
            }
        }
         push @eligible, $p_ref if $only_ones;
    } 

    say 0 and return unless @eligible;

my @sorted = map { $_->[0] } 
             sort { $b->[1] <=> $a->[1] }
             map { [$_, ($_->[1][0] - $_->[0][0] + 1) 
                   * ($_->[1][1] - $_->[0][1] + 1)] } 
                   @eligible;
    my $rect = $sorted[0];
    say "Rectangle corners: ";
    say "@$_" for @$rect; 
    say "\nRectangle:";

    for my $row ($rect->[0][0]..$rect->[1][0]) {
        say "@{$m[$row]}[$rect->[0][1]..$rect->[1][1]]";
    }
    say "";
}

This script displays the following output:

$ perl  rectangular-matrix.pl

[ 0 1 0 1 ]
[ 0 0 1 0 ]
[ 1 1 0 1 ]
[ 1 1 0 1 ]

Rectangle corners:
2 0
3 1

Rectangle:
1 1
1 1


[ 1 1 0 1 ]
[ 1 1 0 0 ]
[ 0 1 1 1 ]
[ 1 0 1 1 ]

Rectangle corners:
0 0
1 1

Rectangle:
1 1
1 1


[ 0 1 0 1 ]
[ 1 0 1 0 ]
[ 0 1 0 0 ]
[ 1 0 0 1 ]

0

[ 1 1 0 1 1 1 ]
[ 1 1 1 0 1 0 ]
[ 1 1 0 1 0 1 ]
[ 1 1 1 0 0 1 ]

Rectangle corners:
0 0
3 1

Rectangle:
1 1
1 1
1 1
1 1


[ 0 0 0 1 0 0 ]
[ 1 1 1 0 0 0 ]
[ 0 0 1 0 0 1 ]
[ 1 1 1 1 1 0 ]
[ 1 1 1 1 1 0 ]

Rectangle corners:
3 0
4 4

Rectangle:
1 1 1 1 1
1 1 1 1 1


[ 1 0 1 0 1 0 ]
[ 0 1 0 1 0 1 ]
[ 1 0 1 0 1 0 ]
[ 0 1 0 1 0 1 ]

0

[ 0 0 0 1 1 1 ]
[ 1 1 1 1 1 1 ]
[ 0 0 1 0 0 1 ]
[ 0 0 1 1 1 1 ]
[ 0 0 1 1 1 1 ]

Rectangle corners:
3 2
4 5

Rectangle:
1 1 1 1
1 1 1 1

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 Sunday, November, 29, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.