laurent_r

These are some answers to the Week 128 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Note: very little time this week, so I only completed task 2.

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.

Example 1:

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

    The 1st arrival of train is at 11:20 and this is the only train at the station, so you need 1 platform.
    Before the second arrival at 14:30, the first train left the station at 11:50, so you still need only 1 platform.

Example 2:

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

    Between 12:20 and 12:40, there would be at least 3 trains at the station, so we need minimum 3 platforms.

UPDATED [2021-08-30 23:30 UK TIME]: Corrected the between time description of the example 2. Thanks Peter Campbell Smith.

We need to perform a number of comparisons between arrival and departure times. We could write a dedicated compare subroutine (which would be quite simple). I decided however that I prefer to convert all the times into time stamps, namely the number of seconds elapsed since 00:00 a.m. that day, for which we can simply perform a numerical comparison. Our program then reads both arrays in parallel, always picking the smallest value. A size counter keeps track of the number of trains in the station at any given time, and $max-size keeps track of the maximum value reached by $size.

Minimum Platforms in Raku

Our program reads both arrays in parallel, always picking the smallest value. A size counter keeps track of the number of trains in the station at any given time, and $max-size keeps track of the largest size reached. When reading to sets of values in parallel, there are usually two edge cases when we reach the end of any of the datasets. If we reach the end of the arrival times, we can just exit the loop, since we will not increase the $size value beyond the maximum value so far. If we reach the end of the departure time array, then we need to increment the $max-size by one for any value left in the arrival time array.

my @arrivals   = <10:20 11:00 11:10 12:20 16:20 19:00>;
my @departures = <10:30 13:20 12:40 12:50 20:20 21:20>;
my @ts-arr = map { my ($m, $s) = split /\:/, $_; $m * 60 + $s;}, @arrivals;
my @ts-dep = map { my ($m, $s) = split /\:/, $_; $m * 60 + $s;}, @departures;
my $size = 0;
my $max-size = 0;
while @ts-arr.end != 0 {
    if @ts-dep.end == 0 {
        $max-size++;
    } elsif @ts-arr[0] <= @ts-dep[0] {
        shift @ts-arr;
        $size++;
        $max-size = $size if $size > $max-size;
        # say "$size $max-size";
    } else {
        shift @ts-dep;
        $size--;
    }
}
say $max-size;

With the built-in sample input data, the program displays the following output:

$ raku ./min-platforms.raku
3

Minimum Platforms in Perl

We’re basically porting the Raku program to Perl. Please refer to the above if you need explanations.

use strict;
use warnings;
use feature qw/say/;

my @arrivals   = qw<10:20 11:00 11:10 12:20 16:20 19:00>;
my @departures = qw<10:30 13:20 12:40 12:50 20:20 21:20>;
my @ts_arr = map { my ($m, $s) = split /:/, $_; $m * 60 + $s;} @arrivals;
my @ts_dep = map { my ($m, $s) = split /:/, $_; $m * 60 + $s;} @departures;
my $size = 0;
my $max_size = 0;
while (@ts_arr) {
    if ($#ts_dep == 0) {
        $max_size++;
    } elsif ($ts_arr[0] <= $ts_dep[0]) {
        shift @ts_arr;
        $size++;
        $max_size = $size if $size > $max_size;
        # say "$size $max-size";
    } else {
        shift @ts_dep;
        $size--;
    }
}
say $max_size;

Output:

$ perl min-platforms.pl
3

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on September 12, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.