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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
# Perl Weekly Challenge #128
You can find more information about this weeks, and previous weeks challenges at:
https://perlweeklychallenge.org/
If you are not already doing the challenge - it is a good place to practise your
**perl** or **raku**. If it is not **perl** or **raku** you develop in - you can
submit solutions in whichever language you feel comfortable with.
You can find the solutions here on github at:
https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-128/james-smith/perl
# Task 1 - Maximum Sub-Matrix
***You are given m x n binary matrix having 0 or 1 in each cell. Write a script to find out maximum sub-matrix having only 0***
## Ambiguity
There may be multiple solutions (e.g. in Example 1 depending on how you write the algorithm) so rather than returning the matrix - my tests will be on the area of the matrix
## The solution
Initialy this looks like an `O(n^4)` problem - you would need to scan the area to the right and below `O(n^2)` for a given cell `O(n^2)`. But with a bit of preprocessing - we can remove at least one of these loops - so the challenge becomes `O(n^3)`.
### Preprocessing the matrix.
To remove the inner loop - we can pre-compute this - the number of 0s in a continuouse line starting at the point and going right. For the first matrix we get
```
[ 1 0 0 0 1 0 ] [ 0 3 2 1 0 1 ]
[ 1 1 0 0 0 1 ] -> [ 0 0 3 2 1 0 ]
[ 1 0 0 0 0 0 ] [ 0 5 4 3 2 1 ]
```
The code that does that is this....
```perl
## Last column 1s become 0s, 0s become 1s
my @runs = map { [1 - $_->[-1]] } @rows;
## Remaining columns we are working backwards along the rows
## Column is 0 if the matrix contains a 1 - o/w it is 1 more
## than the cell to the right (which is the first cell in the row)
## we use unshift to extend each row left...
foreach my $i (reverse 0..$w-1) {
unshift @{$runs[$_]}, $rows[$_][$i] ? 0 : $runs[$_][0]+1 foreach 0..$h;
}
```
We then have the `O(n^3)` to find the maximum area.
For each cell we work out the maximum area of any rectangle.
For the first row it is just `$run[$y][$x]`. For subsequent rows it is the minimum of all `$run[$y][$x]` we have seen times height
```perl
my $max_w = 1e9;
foreach my $j ( $y .. $h ) {
last unless $runs[$j][$x]; ## We have a 1 in the rectangle quit
$max_w = $runs[$j][$x] if $runs[$j][$x] < $max_w;
my $area = $max_w * ( $j - $y + 1 );
$max_area = [ $area, $max_w, $j - $y + 1 ] if $area > $max_area->[0];
}
```
The variable `$max_area` contains three values `$max_area`, `$max_w`, `$max_h` - the latter two if you wish to draw the empty matrix.....
Put it all together we have...
```perl
sub find_empty {
my @runs = map { [ 1 - $_->[-1] ] } my @rows = @{$_[0]};
my ( $h, $w ) = ( @rows - 1, @{$rows[0]} - 1 );
foreach my $i ( reverse 0 .. $w - 1 ) {
unshift @{$runs[$_]}, $rows[$_][$i] ? 0 : $runs[$_][0] + 1 foreach 0 .. $h;
}
my $max_area = [ 0, 0 , 0 ];
foreach my $x ( 0 .. $w ) {
foreach my $y ( 0 .. $h ) {
next unless $runs[$y][$x];
my $max_w = 1e9;
foreach my $j ( $y .. $h ) {
last unless $runs[$j][$x];
$max_w = $runs[$j][$x] if $runs[$j][$x] < $max_w;
my $area = $max_w * ( $j - $y + 1 );
$max_area = [ $area, $max_w, $j - $y + 1 ] if $area > $max_area->[0];
}
}
}
return $max_area;
}
```
# Task 2 - Minimum Platforms
***You are given two arrays of arrival and departure times of trains at a railway station. Write a script to find out the minimum number of platforms needed so that no train needs to wait.***
## Background
As mentioned this is effectively my day job again. To display information about genomic features and whether or not they overlapped a particular region (to know whether to display them or not) or to bump them for display (to make sure features didn't merge/overlap) which is exactly this problem. This one is in someways easier as we have the trains already sorted into date order. If we didn't sorting them would make life a lot easier! - not so easy on a genome browser where there may be 10s of thousands of features in a region.
This is actually more my brother's line of work - he works for what was BR computing - and one of his jobs is just this. For a while BR had 66 minutes in an hour to allow them to get trains in and out of one of the large busy stations.
## Solution
As we are assuming that starts are in time order we don't have to do a 2-sided test for overlaps.
So foreach train we loop through all platforms - seeing if there is a platform with a slot in it (i.e. the last train has already left the platform). If there isn't we make a new platform and add the train to it, and repeat. All we do is store the last departure time for each platform, and because 24-hr date strings alphabetic/time order are the same - we only need to use the string comparison operator (in this case `gt`) to compare times.
Here we use a little used concept in perl the label "`OUTER`" - this allows our inner loop to break out of it's own `foreach` loop and also jump to the next interation of it's parent loop.
```perl
sub bump_platform {
my @arr = @{shift @_};
my @dep = @{shift @_};
my @platforms = ();
OUTER: foreach my $st (@arr) {
foreach(0..$#platforms) {
($platforms[$_] = shift @dep) && (next OUTER)
if $st gt $platforms[$_];
}
push @platforms,shift @dep;
}
return scalar @platforms;
}
```
**Notes:**
We can also keep information about which trains are on by re-writing what is stored in `@plat` rather than storing the last departure time - we can store the arrival/departure time of trains on each platform...
```perl
sub bump_platform_keep_trains {
my @arr = @{shift @_};
my @dep = @{shift @_};
my($train_no, @platforms) = (0);
OUTER: foreach my $st (@arr) {
foreach(@platforms) {
(push @{$_}, [ $st, (shift @dep), ++$train_no ]) &&
(next OUTER) if $st gt $_->[-1][1];
}
push @platforms, [ [ $st, (shift @dep), ++$train_no ] ];
}
say ' ', join ' ', map { "Train $_->[2]: $_->[0]-$_->[1]" } @{$_}
foreach @platforms;
return scalar @platforms;
}
```
|
