# RogerBW's Blog

Perl Weekly Challenge 128: Maxima and Minima 03 September 2021

I’ve been doing the Weekly Challenges. The latest involved finding submatrices and counting trains. (Note that this is open until 5 September 2021.)

You are given m x n binary matrix having 0 or 1.

Write a script to find out maximum sub-matrix having only 0.

In other words, return the "maximum" rectangle that contains only 0 values. I chose to interpret "maximum" as the one with the largest area. Here's the Raku.

``````sub msm(@m) {
``````

Establish the dimensions of the matrix.

``````  my \$y=@m.elems;
my \$x=@m.elems;
``````

Maximum submatrix found so far: its area and dimensions. (Since it'll only contain 0 values, I will store just the dimensions, and recreate it at the end.)

``````  my \$mxa=0;
my @oc;
``````

Any spot in the matrix might be the top left corner of the largest block of zeroes.

``````  for (0..\$y-1) -> \$yi {
for (0..\$x-1) -> \$xi {
``````

…well, as long as it contains a zero itself.

``````      if (@m[\$yi][\$xi]==0) {
``````

Now I'm going to find the sizes of all the rectangles anchored on this this point. In each row, I iterate to the end, looking for a non-zero value. I stuff into `@rl` the minimum of (this row's count of zeroes) and (the lowest count of zeroes I've found so far). So the first entry in `@rl` will be the width of the N × 1 rectangle of zeroes anchored with `(xi,yi)` at top left, the second entry the width of the N × 2 rectangle, and so on.

``````        my @rl;
my \$mrl=\$x-\$xi;
for (\$yi..\$y-1) -> \$yj {
for (\$xi..min(\$xi+\$mrl,\$x)-1) -> \$xj {
if (@m[\$yj][\$xj] != 0) {
\$mrl=min(\$xj-\$xi,\$mrl);
last;
}
}
push @rl,\$mrl;
}
``````

So then I iterate through that list, derive the areas, and if there's a larger one than I already have, store that as the canonical largest area. (I'm using `>=` because one of the examples had both a 2×3 and a 3×2 as valid answers, but the 3×2, found later, is what's wanted.)

(And yes, I could have done this in the earlier loop, but that happened not to be the way I thought when I was writing it.)

``````        for (0..@rl.end) -> \$n {
if (@rl[\$n]>0) {
my \$a=@rl[\$n]*(\$n+1);
if (\$a >= \$mxa) {
\$mxa=\$a;
@oc=(@rl[\$n],\$n+1);
}
}
}
}
}
}
``````

Finally, build the actual array of zeroes that's asked for.

``````  my @o;
for (1..@oc) -> \$y {
push @o,[0 xx @oc];
}
return @o;
}
``````

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.

I've seen variants of this before, but usually with a series of tuples of (arrival time, departure time). Let's do this one in Perl.

``````sub mp {
``````

`aa` and `da` are my arrival and departure time arrays.

``````  my (\$aa,\$da)=@_;
``````

I'm going to build an event list in `e`.

``````  my %e;
``````

An arrival has an event value of `+1`, a departure of `-1` (i.e. change in number of occupied platforms). The code for processing them is otherwise the same.

``````  foreach my \$p ([\$aa,1],[\$da,-1]) {
``````

For each timestamp in the list,

``````    foreach my \$tm (@{\$p->}) {
``````

Parse it.

``````      if (\$tm =~ /([0-9]+):([0-9]+)/) {
``````

Store the event value, keyed with the numerical value of the timestamp. (This could be done with a string key instead, but then I'd have to validate for single-digit hours.)

``````        \$e{\$1*60+\$2}+=\$p->;
}
}
}
``````

So I now have a series of events, `+1` for a train arriving and `-1` for it departing. (If there's an arrival and a departure at the same moment, they'll cancel out; possibly not ideal, but the behaviour in this case is unspecified.)

I run through these in time order, adding one to `pt` (platforms in use) when a train arrives and subtracting one when it departs. The maximum value is the number of platforms needed.

``````  my \$pt=0;
my \$pm=0;
foreach my \$ts (sort {\$a <=> \$b} keys %e) {
\$pt+=\$e{\$ts};
if (\$pt > \$pm) {
\$pm=\$pt;
}
}
return \$pm;
}
``````

Full code on github.