RogerBW's Blog

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

TASK #1 › Maximum Sub-Matrix

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[0].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[1]) -> $y {
    push @o,[0 xx @oc[0]];
  }
  return @o;
}

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.

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->[0]}) {

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->[1];
      }
    }
  }

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.