diff options
| -rw-r--r-- | challenge-128/wlmb/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-128/wlmb/perl/ch-1.pl | 52 | ||||
| -rwxr-xr-x | challenge-128/wlmb/perl/ch-2.pl | 48 |
3 files changed, 101 insertions, 0 deletions
diff --git a/challenge-128/wlmb/blog.txt b/challenge-128/wlmb/blog.txt new file mode 100644 index 0000000000..8f3e6e43df --- /dev/null +++ b/challenge-128/wlmb/blog.txt @@ -0,0 +1 @@ +https://wlmb.github.io/2021/08/30/PWC128/ diff --git a/challenge-128/wlmb/perl/ch-1.pl b/challenge-128/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..0d07bc2aab --- /dev/null +++ b/challenge-128/wlmb/perl/ch-1.pl @@ -0,0 +1,52 @@ +#!/usr/bin/env perl +# 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 +} diff --git a/challenge-128/wlmb/perl/ch-2.pl b/challenge-128/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..75d7dc2739 --- /dev/null +++ b/challenge-128/wlmb/perl/ch-2.pl @@ -0,0 +1,48 @@ +#!/usr/bin/env perl +# 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; +} |