RabbitFarm

2020-11-22

Perl Weekly Challenge 087

Part 1

You are given an unsorted array of integers @N. Write a script to find the longest consecutive sequence. Print 0 if no sequence found.

Solution


use strict;
use warnings;
##
# You are given an unsorted array of integers @N.
# Write a script to find the longest consecutive sequence. 
# Print 0 if no sequence found.
##
sub min_max{
    my @a = @_;
    my($min, $max) = ($a[0], $a[0]);
    for my $x (@a){
        $min = $x if($x < $min);
        $max = $x if($x > $max);
    }
    return ($min, $max);
}

sub longest_sequence{
    my @sequences = @_;
    my @max = (0);
    for my $sequence (@sequences){
        @max = @{$sequence} if((@{$sequence} > @max) && (@{$sequence} > 1));
    }
    return @max;
}

sub continuous_sub_sequences{
    my @a = @_;
    my($min, $max) = min_max(@a);
    my @sub_sequences;
    my $sub_sequence = [];
    while($min <= $max){
        my $test = grep {$_ == $min} @a;
        if($test){
            push @{$sub_sequence}, $min;
        }
        else{
            push @sub_sequences, $sub_sequence if(@{$sub_sequence} > 0);
            $sub_sequence = [];
        }
        $min++;
    }
    return @sub_sequences;
}

MAIN:{
    my @N = (100, 4, 50, 3, 2);
    my @sequences = continuous_sub_sequences(@N);
    my @max = longest_sequence(@sequences);
    print join(",", @max) . "\n";
    @N = (20, 30, 10, 40, 50);
    @sequences = continuous_sub_sequences(@N);
    @max = longest_sequence(@sequences);
    print join(",", @max) . "\n";
    @N = (20, 19, 9, 11, 10);
    @sequences = continuous_sub_sequences(@N);
    @max = longest_sequence(@sequences);
    print join(",", @max) . "\n";
}

Sample Run


$ perl perl/ch-1.pl
2,3,4
0
9,10,11

Notes

I decided to force myself to work with an artificial constraint as a way fo forcing a little bit more creativity in my solution. When I first looked at this problem I immediately thought “ok, first thing should be to sort the list”. Based on that first impression my self-imposed constraint was to “solve this without using a sort”!

What I did can be summarized as follows: 1. Find the minimum and maximum numbers in the given list. 2. Starting with the minimum number generate test sequences by incrementing upwards towards the maximum list value. 3. As each new element of the test sequence is added test to see if it is in the original list. 4. If it is in the list, good, keep going. 5. If it is not in the list then save the test sequence generated up to that point and continue with a new test sequence. 6. Return all successful test sequences and determine the longest one.

The most blatant inefficiency to this approach is when lists are sparse. For example, suppose we are given (2, 100000000, 3, 4, 5) then we would be iterating from 2 to 100000000. An approach using a sorted list would basically need only loop over the elements of the list, checking to see if the next element was 1 larger than the previous.

Part 2

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.

Solution


use strict;
use warnings;
##
# 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.
##
use boolean;

sub print_solution{
    my($m, $n) = @_;
    if(!$m || !$n){
        print "0\n";
    }
    else{
        for (1 .. $n){
            print "[". join(" ", (1)x $m) . "]\n";
        }       
    }
}

sub evaluate{
    my($m, $n, $matrix) = @_;
    my $row_string = join(",", (1) x $m);
    my $columns = 0;
    for my $row (@{$matrix}){
        my $test = join(",", @{$row});
        if(index($test, $row_string) > -1){
            $columns++;
            return true if($columns == $n);
        }
        else{
            $columns = 0;
        }
    }
    return false;
}

sub largest_rectangle{
    my @matrix = @_;
    my $rows = @{$matrix[0]};
    my $columns = @matrix;
    my $max_area = 0;
    my @rectangle;
    for my $m (2 .. $columns){
        for my $n (1 .. $rows){
            if(evaluate($m, $n, \@matrix)){
                if(($m * $n) > $max_area){
                    $max_area = ($m * $n);
                    @rectangle = ($m, $n);
                }
            }
        }
    }
    return @rectangle;
}

MAIN:{
    my @MATRIX = (
        [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]
    );
    print_solution(largest_rectangle(@MATRIX));
    @MATRIX = (
        [1, 0, 1, 0, 1, 0],
        [0, 1, 0, 1, 0, 1],
        [1, 0, 1, 0, 1, 0],
        [0, 1, 0, 1, 0, 1]
    );
    print_solution(largest_rectangle(@MATRIX));
    @MATRIX = (
        [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]
    );
    print_solution(largest_rectangle(@MATRIX));  
}

Sample Run


$ perl perl/ch-2.pl
[1 1 1 1 1]
[1 1 1 1 1]
0
[1 1 1 1]
[1 1 1 1]

Notes

Unlike Part 1 I did not necessarily have a self-imposed constraint other than to try and be as creative as possible. I’ll only know when I look at other submitted solutions if I was really all that relatively clever or not!

Here I do the following: 1. Check the size of the given matrix 2. Test the matrix for all possible sub-matrix sizes. 3. For all found sub-matrices determine the largest one.

For checking the presence of sub-matrices I join the rows into strings and then use index to see if they appear in a given row or not. To determine if a sub-matrix is the largest I compare the areas of the “rectangles”.

posted at: 17:36 by: Adam Russell | path: /perl | permanent link to this entry