Perl Weekly Challenge 128: Minimum Platforms

Input: @arrivals   = (11:20, 14:30)
       @departures = (11:50, 15:00)
Output: 1

Input: @arrivals   = (10:20, 11:00, 11:10, 12:20, 16:20, 19:00)
       @departures = (10:30, 13:20, 12:40, 12:50, 20:20, 21:20)
Output: 3

One way of solving this is to take all the arrival and departure times, sort them, and process them one by one, keeping a running total of platforms needed. For each arrival, we add one, for each departure, we subtract one.

But that requires us to sort the arrival and departure times. Using a regular sort (as build in in many languages) would require \(\Omega (N \log N)\) time, where \(N\) is the number of arrival and departure times. Now, given that all the arrival and departure times are from a fixed sized universe, we can write a custom sorting routine which runs in linear time.

But we will skip the sorting all together. Instead, we'll create an array where for every minute of the day, we count the number of trains in the station. There are only \(24 \cdot 60 = 1440\) minutes in a day, so creating the array, and processing a single train can be done in constant time.

For each train, we take the its arrival and departure time, and translate it to minutes past midnight (hh:mm == 60 * hh + mm minutes after midnight). This gives us a range of minutes, and we'll add one for each of those minutes in the given array. When we have processed all trains, we just have find the maximum in the array when we're done.

It's unclear whether the input may contains departure times which are before the arrival time — this would be the case of trains which stay overnight at the station. We will handle this case, by basically processing it as two trains: one from midnight till the departure time, and one from the arrival time till midnight.

We start off by reading the input: we read a line of arrival times, and a line of departure times, and extract the times in hh:mm format from them:

my @arrivals   = map {[split /:/]} <> =~ /[0-9][0-9]:[0-9][0-9]/g;
my @departures = map {[split /:/]} <> =~ /[0-9][0-9]:[0-9][0-9]/g;

We need an array for each minute, initialized at all 0s:

my @trains = (0) x (24 * 60);

Now we process each train, translating the arrival and departure times to minutes after midnight. Given those minutes after midnight, we can find the range of minutes the trains is at the station (special casing trains which arrive before midnight, and leave after). For each minute in the range, we increment the counter for that minute:

foreach my $i (keys @arrivals) {
    my $arrival   = 60 * $arrivals   [$i] [0] + $arrivals   [$i] [1];
    my $departure = 60 * $departures [$i] [0] + $departures [$i] [1];
    my @minutes;
    if ($arrival <= $departure) {
        @minutes = $arrival .. $departure;
    }
    else {
        @minutes = (0 .. $departure, $arrival .. (24 * 60 - 1));
    }
    $trains [$_] ++ for @minutes;
}

Finally, we find the maximum number of trains in the station, and print this:

use List::Util qw [max];
say max @trains;

Find the full program on GitHub.