1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#! /opt/local/bin/perl
#
# largest_rectangle.pl
#
# TASK #2 › Largest Rectangle
# Submitted by: Mohammad S Anwar
# 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 ]
#
# method:
# we need to clarify and make some assumptions about the task: what is the minimum dimension
# for a rectangle? Perhaps a string of 1s would make a rectangle, 11111, but were that
# to be the case then 1 would be a valid 1x1 rectangle and that is precluded by the
# second example. So it looks like the minimum dimension must be two, and we disallow
# a trivial row or column segment of 1s.
#
#
# 2020 colin crain
## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
# my $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 ] ] ;
# 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 ] ];
## create a random 10x10 matrix and display it
my $matrix = [ map { [ map { int rand 4 == 0 ? 0 : 1 } (1..10) ] } (1..10) ] ;
say "@$_" for $matrix->@*;
say '';
my $cols = $matrix->[0]->@*;
my $rows = $matrix->@*;
my @runs;
my @max = (0);
## parse matrix and construct data structure
## array index on matrix rows, with hashes as elements of unique keys
## pointing to index pair arrays
for my $r ( 0..$rows-1) {
for my $c1 ( 0..$cols-2 ) {
next unless $matrix->[$r][$c1] == 1;
my $c2 = $c1 + 1;
while ($matrix->[$r][$c2] == 1) {
$runs[$r]->{"${c1}_$c2"} = [$c1, $c2];
last if ++$c2 > $cols - 1;
}
}
}
for my $r ( 0..$#runs ) {
for my $run ( keys $runs[$r]->%* ) {
my $n = 1;
while (exists $runs[$r+$n]->{$run}) {
$n++;
}
if ($n > 1) {
my @arr = $runs[$r]->{$run}->@*;
my $size = ( $arr[1] - $arr[0] + 1 ) * $n;
$size > $max[0] and @max = ($size, @arr, $n);
}
}
}
# say "maximum rectangle @max";
## report
my ($size, $start, $end, $height) = @max;
$size == 0 and do { say 0; exit };
my $length = $end - $start + 1;
my @out = ('[', ('1') x $length, ']');
say "@out" for (1..$height);
## ## ## ## ## SUBS:
|
