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.