Perl Weekly Challenge 128.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 128

Task 1: Maximum Sub-Matrix

Submitted by: Mohammad S Anwar
You are given m x n binary matrix having 0 or 1.

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

Example 1:
Input : [ 1 0 0 0 1 0 ]
        [ 1 1 0 0 0 1 ]
        [ 1 0 0 0 0 0 ]

Output: [ 0 0 0 ]
        [ 0 0 0 ]
Example 2:
Input : [ 0 0 1 1 ]
        [ 0 0 0 1 ]
        [ 0 0 1 0 ]

Output: [ 0 0 ]
        [ 0 0 ]
        [ 0 0 ]

I guess that maximum sub-matrix means that with the largest area or number of elements. I can use the Perl Data Language PDL to conveniently store and manipulate the matrix, though this time I didn’t find a way to take advantage of its threading capabilities. I solve the problem in two steps, by first producing for each possible corner all submatrices that go upwards and leftwards and choosing the largest one, and then, I choose the corner that produced the largest submatrix.

# Perl weekly challenge 128
# Task 1:  Maximum submatrix
#
# See https://wlmb.github.io/2021/08/30/PWC128/#task-1-maximum-submatrix
use warnings;
use strict;
use v5.12;
use List::Util qw(reduce);
use PDL;

my $m=(rcols *STDIN,[],{EXCLUDE=>'/^\s*$/'})->transpose; #input as pdl matrix
my ($x_max,$y_max)=map {$_-1} $m->dims;
# For each corner $i, $j find the best submatrix
my @sm; #array of submatrices
# For each possible corner produce submatrices
for my $i(0..$x_max){
    for my $j(0..$y_max){
	push @sm, submatrix($i,$j) if $m->at($i,$j)==0;
    }
}
# Choose the largest one
my $b=reduce {area(@{$a})>area(@{$b})?$a:$b} @sm;
# Output the results
say "Input: $m\nOutput: ",
    defined $b?"matrix($b->[0]:$b->[1],$b->[2]:$b->[3])=".
                $m->slice("$b->[0]:$b->[1],$b->[2]:$b->[3]")
              :"None";

sub area { # Calculate the area of a rectangular region given the ranges (a:b,c:d)
    my ($a, $b, $c, $d)=@_;
    return (1+$b-$a)*(1+$d-$c);
}

# Find the best submatrix left-and up-wards of a given corner
sub submatrix {
    # bottom right corner and current best upper left.
    my ($best_l, $best_t)=my ($right, $bottom)=@_;
    my $leftmost=-1; # Leftmost position to try
    my $top=-1;
    for (my $t=$bottom; $t>$top; --$t){
	my $l;
	for($l=$right;$l>$leftmost;--$l){
	    last unless $m->at($l,$t)==0;
	    ($best_l, $best_t)=($l, $t)
		if area($l,$right,$t, $bottom)
		> area($best_l, $right, $best_t, $bottom);
	}
	$leftmost=$l; # constrain next search
    }
    return [$best_l, $right, $best_t, $bottom] # corner coordinates
}

First example:

./ch-1.pl << " END"
  1 0 0 0 1 0
  1 1 0 0 0 1
  1 0 0 0 0 0
 END

Results:

Input:
[
 [1 0 0 0 1 0]
 [1 1 0 0 0 1]
 [1 0 0 0 0 0]
]

Output: matrix(2:4,1:2)=
[
 [0 0 0]
 [0 0 0]
]

Second example

./ch-1.pl << " END"
 0 0 1 1
 0 0 0 1
 0 0 1 0
 END

Results:

Input:
[
 [0 0 1 1]
 [0 0 0 1]
 [0 0 1 0]
]

Output: matrix(0:1,0:2)=
[
 [0 0]
 [0 0]
 [0 0]
]

Case with no zeroes

./ch-1.pl << " END"
 1 1 1 1
 1 1 1 1
 1 1 1 1
 END

Results:

Input:
[
 [1 1 1 1]
 [1 1 1 1]
 [1 1 1 1]
]

Output: None

Case with only one zero

./ch-1.pl << " END"
 1 1 1 1
 1 1 0 1
 1 1 1 1
 END

Results:

Input:
[
 [1 1 1 1]
 [1 1 0 1]
 [1 1 1 1]
]

Output: matrix(2:2,1:1)=
[
 [0]
]

Case with one 1

./ch-1.pl << " END"
 0 0 0 0
 0 0 1 0
 0 0 0 0
 END

Results:

Input:
[
 [0 0 0 0]
 [0 0 1 0]
 [0 0 0 0]
]

Output: matrix(0:1,0:2)=
[
 [0 0]
 [0 0]
 [0 0]
]

Case with only zeroes

./ch-1.pl << " END"
 0 0 0 0
 0 0 0 0
 0 0 0 0
 END

Results:

Input:
[
 [0 0 0 0]
 [0 0 0 0]
 [0 0 0 0]
]

Output: matrix(0:3,0:2)=
[
 [0 0 0 0]
 [0 0 0 0]
 [0 0 0 0]
]

Large matrix:

time(perl -MPDL -E 'srand(0); $m=floor(random(100,100)*2); ($n="$m")=~tr/[]//d; say $n'|
./ch-1.pl) 2>&1

Task 2: Minimum Platforms

Submitted by: Mohammad S Anwar
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.

Time at the station is cyclic, with no beginning or end. Thus, a train that departs today might have arrived yesterday, with a departure time before its arrival time. Therefore, there are tree kinds of events. Arrivals, which increase the current and future number of trains at the station, departures after arrivals which decrease the future number of trains at the station, and departures before arrivals, i.e., after arrivals the previous day, which therefore increase the current and past number of trains. Arrivals change the current numbers of trains but departures not, as trains need some time to clear the station.

To solve the problem I read the arrival and departure schedules from @ARGV, classify the departures and build a vector of events ordered in time. I then use the Perl Data Language PDL to build a matrix of future or past effects of each event, sum them over to get a vector with the number of trains at the station at the time of each event and finally find the maximum, which is the desired result. I assume that no train spends zero time nor more than 24 hours at the station.

# Perl weekly challenge 128
# Task 2: Minimum platforms
#
# See https://wlmb.github.io/2021/08/30/PWC128/#task-2-minimum-platforms
use warnings;
use strict;
use v5.12;
use List::MoreUtils qw(pairwise);
use PDL;

my ($arrive, $depart)=@ARGV; # Assume format "hh:mm hh:mm..." for each arg.
my @arrive=map {to_minutes($_)}  split ' ', $arrive;
my @depart=map {to_minutes($_)}  split ' ', $depart;
die "Expected same number of arrivals and departures" unless @arrive==@depart;

# Classify departures: after or 'before' arrival
my @DaA=map {$depart[$_]} grep {$depart[$_] > $arrive[$_]} 0..$#depart; # after
my @DbA=map {$depart[$_]} grep {$depart[$_] <= $arrive[$_]} 0..$#depart; # before

# Put all event codes  in a single chronologically ordered array.
# If a departure and an arrival coincide, arrival goes first. Discard time after sorting.
my @events=map {$_->{type}} sort {$a->{time}<=>$b->{time}|| $a->{type} <=> $b->{type}}
	       map {my $t=$_; my $r=(\@arrive, \@DaA, \@DbA)[$_];
                    map { {time=>$_, type=>$t} } @$r } 0..2;
my $events=pdl(@events); # Ordered vector of event codes

my $effects=zeroes(scalar @events, scalar @events); # effects of each event
my @type=qw(Arrive Depart Depart(prev)); # Types of events, coded as 0,1,2
$effects=((($events==0) & ($effects->xvals <= $effects->yvals)) # arrivals +1
         -(($events==1) & ($effects->xvals <  $effects->yvals)) # departures -1
         +(($events==2) & ($effects->xvals >= $effects->yvals))); # previous arrival +1

my $trains=$effects->sumover; # trains at station at given events
my $platforms=$trains->max;   # required platforms

say "Arrivals: $arrive\nDepartures: $depart\nOutput: $platforms platforms";
say "Trains at station: $trains";
say "Events: ", map {"$type[$_] "} list($events);

sub to_minutes { # convert HH:MM to minutes. Allow fractional minutes HH:MM.FFF
    my $time=shift @_;
    die "Wrong time format: $time" unless $time=~m/(^\d+):(\d+(\.\d*)?)$/;
    my ($hour, $minute)=($1,$2);
    die "Falied 0<=hour<24: $time" unless 0<=$hour<24;
    die "Failed 0<=minute<60: $time" unless 0<=$minute<60;
    return $hour*60+$minute;
}

Example 1:

./ch-2.pl "11:20 14:30" "11:50 15:00"

Results:

Arrivals: 11:20 14:30
Departures: 11:50, 15:00
Output: 1 platforms
Trains at station: [1 1 1 1]
Events: Arrive Depart Arrive Depart

Example 2:

./ch-2.pl "10:20 11:00 11:10 12:20 16:20 19:00" \
          "10:30 13:20 12:40 12:50 20:20 21:20"

Results:

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 platforms
Trains at station: [1 1 1 2 3 3 2 1 1 2 2 1]
Events: Arrive Depart Arrive Arrive Arrive Depart Depart Depart Arrive Arrive Depart Depart

Example with departures that coincide with arrivals:

./ch-2.pl "10:00 11:00" \
          "11:00 12:20"

Results:

Arrivals: 10:00 11:00
Departures: 11:00 12:20
Output: 2 platforms
Trains at station: [1 2 2 1]
Events: Arrive Arrive Depart Depart

This case requires two platforms, as, for safety, the coincidental arrival and departure at 11:00 were taken as an arrival first followed immediately by a departure.

Example with departures before arrivals:

./ch-2.pl "20:00 21:00 22:00" \
          " 8:00  9:00 10:00"

Results:

Arrivals: 20:00 21:00 22:00
Departures:  8:00  9:00 10:00
Output: 3 platforms
Trains at station: [3 2 1 1 2 3]
Events: Depart(prev) Depart(prev) Depart(prev) Arrive Arrive Arrive

Requires three platforms as three trains arrive one night and don’t leave till the following morning.

Example with both kinds of departures:

./ch-2.pl "20:00 21:00 23:00" \
          "22:00  9:00 10:00"

Results:

Arrivals: 20:00 21:00 23:00
Departures: 22:00  9:00 10:00
Output: 2 platforms
Trains at station: [2 1 1 2 2 2]
Events: Depart(prev) Depart(prev) Arrive Arrive Depart Arrive

Only requries two platforms as the first train left before the last arrived.

Written on August 30, 2021