Solvintg Perl Weekly Challenge 087

gugod

Kang-min Liu

Posted on November 20, 2020

Solvintg Perl Weekly Challenge 087

Here comes Perl Weekly Challenge 087.

TASK #1 › Longest Consecutive Sequence

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)
Enter fullscreen mode Exit fullscreen mode

It looks like the in put @N contains a bunch of unordered integers while the output should be a range of integers that is entriely contained in the input @N. If there are multiple ranges of such, pick the longest one.

If @N is already sorted by ascendeing order, we could derive the 'current range' by iterating over the array @N and check whether the current number are difference by one with previous number, as well as keep tracking if the current range is longer than the longest range we know.

Here's a Raku version, with time complexity being O(n log(n)), space complexit being O(1):

sub longest-consecutive-sequence(@N) {
    my @m = @N.sort({ $^a <=> $^b });

    my $seq_from = @m[0];
    my $seq_until = @m[0];
    my $longest_seq_from = @m[0];
    my $longest_seq_until = @m[0];
    my $longest_seq_length = 0;

    for 1..@m.end -> $i {
        my $n = @m[$i];
        if $n - @m[$i-1] == 0|1 {
            $seq_until = $n;
            my $len = $seq_until - $seq_from;
            if $longest_seq_length < $len {
                $longest_seq_from   = $seq_from;
                $longest_seq_until  = $seq_until;
                $longest_seq_length = $len;
            }
        } else {
            $seq_from  = $n;
            $seq_until = $n;
        }
    }

    return $longest_seq_length == 0 ?? Nil !! [$longest_seq_from...$longest_seq_until];
}
Enter fullscreen mode Exit fullscreen mode

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 ]
Enter fullscreen mode Exit fullscreen mode

This looks like we should be finding a largest rectangle of 1s from a 01-matrix. A naive solution would be to enumerating all sub-matrices, removing the ones not containing all 1s, and find the largest. What defines the largest matrix ? There are no such definition from the body of the task. Let's just use the area of the matrix, which is the width multiplied by height.

A sub-matrix could be defined by two coordinates, one at the top-left corner, the other at the bottom-right. It appears to me that sub-matrices with dimensions beinge 1x1 does not count, in other words, the coordinates of two corners cannot be identical. Therefore, to enumerate all sub-matrices would be the same as taking the combination of 2 coordinates, then removing the ones that violates the (top-left, bottom-right) relationship,

Conventionally, we contain a matrix in a two dimentional array @matrix with the first dimension being rows, and the second dimension beingg columns. Which means the hight $h would be the number of elements of the first dimension, and the width $w would be the number of elements of the second.

$h = @matrix.elems;
$w = @matrix[0].elems;
Enter fullscreen mode Exit fullscreen mode

To take all coordinates of a such matrix would be to derive the cross-product of two integer sets of [0 .. ^$h] and [0 .. ^$w]:

([^$h] X [^$w])
Enter fullscreen mode Exit fullscreen mode

... then we take the combination of 2, removing the ones that violate the (top-left, bottom-right) relationship>..

.combinations(2)
.grep(-> ($p, $q) { $p[0] <= $q[0] and $p[1] <= $q[1] })
Enter fullscreen mode Exit fullscreen mode

... now we have a set of bi-coordinates in the form of (top-left, bottom-right). We transform that to the actual sub-matrix:

.map(
    -> ($p, $q) {
        ($p[0] .. $q[0]).map(
            -> $y {
                @matrix[$y][ $p[1] .. $q[1] ]
            })
    })
Enter fullscreen mode Exit fullscreen mode

... removing the ones that do not contain only 1s ...

.grep(
    -> @m {
        ([^@m] X [^@m[0]]).map(-> ($y,$x) { @m[$y][$x] == 1 }).all
    }
)
Enter fullscreen mode Exit fullscreen mode

... and take the one with maximum value of width multiplied by height...

.max(-> @m { @m.elems * @m[0].elems });
Enter fullscreen mode Exit fullscreen mode

... and there we have a solution.

Here's the subroutine with all fragment combined.

sub largest-rectangle(@matrix) {

    ([^@matrix] X [^@matrix[0]])
    .combinations(2)
    .grep(
        -> ($p, $q) {
            $p[0] <= $q[0] and $p[1] <= $q[1]
        })

    .map(
        -> ($p, $q) {
            ($p[0] .. $q[0]).map(
                -> $y {
                    @matrix[$y][ $p[1] .. $q[1] ]
                })
        })

    .grep(
        -> @m {
            ([^@m] X [^@m[0]]).map(-> ($y,$x) { @m[$y][$x] == 1 }).all
        })

    .max(
        -> @m {
            @m * @m[0]
        })
}
Enter fullscreen mode Exit fullscreen mode

Regarding the part to build the sub-matrix, out of intuition I utilize the syntax of array slicing and wrote this:

    @matrix[ $p[0] .. $q[0] ][ $p[1] .. $q[1] ]
Enter fullscreen mode Exit fullscreen mode

It failed with tons of runtime errors. I wonder if there are syntax shortcuts for slicing a multi-dimensional array as a multi-dimensional array.


本文為〈解 Perl Weekly Challenge 087〉之英文版:

💖 💪 🙅 🚩
gugod
Kang-min Liu

Posted on November 20, 2020

Join Our Newsletter. No Spam, Only the good stuff.

Sign up to receive the latest update from our blog.

Related

Perl Weekly #696 - Perl 5 is Perl
perl Perl Weekly #696 - Perl 5 is Perl

November 25, 2024

The Break Game
perl The Break Game

November 17, 2024