Merge pull request #4828 from polettix/polettix/pwc128

Add polettix's solution to challenge-128

6 files changed, 236 insertions, 0 deletions

diff --git a/challenge-128/polettix/blog.txt b/challenge-128/polettix/blog.txt
new file mode 100644
index 0000000000..d5a0f26be7
--- /dev/null
+++ b/challenge-128/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/09/01/pwc128-maximum-sub-matrix/
diff --git a/challenge-128/polettix/blog1.txt b/challenge-128/polettix/blog1.txt
new file mode 100644
index 0000000000..fd1c6e5c89
--- /dev/null
+++ b/challenge-128/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/09/02/pwc128-minimum-platforms/
diff --git a/challenge-128/polettix/perl/ch-1.pl b/challenge-128/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..7e5680c786
--- /dev/null
+++ b/challenge-128/polettix/perl/ch-1.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+sub maximum_submatrix_at ($M, $y, $x) {
+   my $target = $M->[$y][$x];
+   my ($max_size, @best) = (0) x 3;
+   my $max_x = $M->[$y]->$#*;
+   for my $Y ($y .. $M->$#*) {
+      last if $M->[$Y][$x] ne $target;
+      my $y_size = $Y - $y + 1;
+      my $size = 0;
+      for my $X ($x .. $max_x) {
+         if ($M->[$Y][$X] ne $target) {
+            $max_x = $X - 1;
+            last;
+         }
+         $size += $y_size;
+         if ($size > $max_size) {
+            $max_size = $size;
+            @best = ($y_size, $X - $x + 1);
+         }
+      }
+   }
+   return ($max_size, @best);
+}
+
+sub maximum_submatrix ($M, $target = '0') {
+   my ($max, @best) = (0);
+   for my $y (0 .. $M->$#*) {
+      for my $x (0 .. $M->[$y]->$#*) {
+         next unless $M->[$y][$x] eq $target;
+         my ($size, @round) = maximum_submatrix_at($M, $y, $x);
+         ($max, @best) = ($size, @round) if $size > $max;
+      }
+   }
+   return [map {[(0) x $best[1]]} 1 .. $best[0]];
+}
+
+sub print_matrix ($M) {
+   for my $row ($M->@*) {
+      say '[ ', join(' ', $row->@*), ' ]';
+   }
+}
+
+my @Ms = (
+   [
+      [ 1, 0, 0, 0, 1, 0, ],
+      [ 1, 1, 0, 0, 0, 1, ],
+      [ 1, 0, 0, 0, 0, 0, ],
+   ],
+   [
+      [ 0, 0, 1, 1, ],
+      [ 0, 0, 0, 1, ],
+      [ 0, 0, 1, 0, ],
+   ],
+   [
+      [ 0, 1, 0, 1, ],
+      [ 1, 0, 1, 0, ],
+      [ 0, 1, 0, 1, ],
+      [ 1, 0, 1, 0, ],
+   ],
+   [
+      [ 1, 0, 0, 0, 1, 0, ],
+      [ 1, 0, 1, 0, 0, 1, ],
+      [ 1, 0, 0, 0, 0, 0, ],
+   ],
+);
+
+for my $M (@Ms) {
+   say '';
+   print_matrix($M);
+   say '---';
+   print_matrix(maximum_submatrix($M));
+   say "\n--------\n";
+}
diff --git a/challenge-128/polettix/perl/ch-2.pl b/challenge-128/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..132758b263
--- /dev/null
+++ b/challenge-128/polettix/perl/ch-2.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+use constant freeup_window => $ENV{FREEUP_WINDOW} // 10;
+
+sub minimum_platforms ($arrivals, $departures) {
+   my $pre_massage = sub (@input) {
+      sort { $a <=> $b } map {
+         my ($h, $m) = split m{:}mxs;
+         $h * 60 + $m;
+      } @input;
+   };
+   my @sorted_arrivals = $pre_massage->($arrivals->@*);
+   my @sorted_departures = $pre_massage->($departures->@*);
+   my $beyond_last = 30 * 60 + freeup_window;
+   my ($present, $min, $max) = (0, 0, 0);
+   while (@sorted_arrivals || @sorted_departures) {
+      my $arrival = @sorted_arrivals ? $sorted_arrivals[0] : $beyond_last;
+      my $departure = @sorted_departures ? $sorted_departures[0] : $beyond_last;
+      if ($arrival <= $departure + freeup_window) {
+         ++$present;
+         $max = $present if $present > $max;
+         shift @sorted_arrivals;
+      }
+      else {
+         --$present;
+         $min = $present if $present < $min;
+         shift @sorted_departures;
+      }
+   }
+   return $max - $min;
+}
+
+my $arrivals = shift(@ARGV)
+   // '10:20 11:00 11:10 12:20 16:20 19:00 22:00 22:10 22:20 22:30';
+my $departures = shift(@ARGV)
+   // '08:00 08:30 10:15 10:30 10:50 13:20 12:40 12:50 20:20 22:25';
+say minimum_platforms([split m{\s+}mxs, $arrivals], [split m{\s+}mxs, $departures]);
diff --git a/challenge-128/polettix/raku/ch-1.raku b/challenge-128/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..cb5e0b4548
--- /dev/null
+++ b/challenge-128/polettix/raku/ch-1.raku
@@ -0,0 +1,75 @@
+#!/usr/bin/env raku
+use v6;
+
+sub maximum-submatrix-at (@M, $y, $x) {
+   my $target = @M[$y][$x];
+   my ($max-size, @best) = 0 xx 3;
+   my $max-x = @M[$y].end;
+   for $y .. @M.end -> $Y {
+      last if @M[$Y][$x] ne $target;
+      my $y-size = $Y - $y + 1;
+      my $size = 0;
+      for $x .. $max-x -> $X {
+         if @M[$Y][$X] ne $target {
+            $max-x = $X - 1;
+            last;
+         }
+         $size += $y-size;
+         if ($size > $max-size) {
+            $max-size = $size;
+            @best = ($y-size, $X - $x + 1);
+         }
+      }
+   }
+   return ($max-size, |@best);
+}
+
+sub maximum-submatrix (@M, $target = '0') {
+   my ($max, @best) = (0);
+   for 0 .. @M.end -> $y {
+      for 0 .. @M[$y].end -> $x {
+         next unless @M[$y][$x] eq $target;
+         my ($size, @round) = maximum-submatrix-at(@M, $y, $x);
+         ($max, @best) = ($size, |@round) if $size > $max;
+      }
+   }
+   return [(1 .. @best[0]).map: { [ 0 xx @best[1] ] }];
+}
+
+sub print-matrix (@M) {
+   for @M -> @row {
+      put '[ ', @row.join(' '), ' ]';
+   }
+}
+
+my @Ms = (
+   [
+      [ 1, 0, 0, 0, 1, 0, ],
+      [ 1, 1, 0, 0, 0, 1, ],
+      [ 1, 0, 0, 0, 0, 0, ],
+   ],
+   [
+      [ 0, 0, 1, 1, ],
+      [ 0, 0, 0, 1, ],
+      [ 0, 0, 1, 0, ],
+   ],
+   [
+      [ 0, 1, 0, 1, ],
+      [ 1, 0, 1, 0, ],
+      [ 0, 1, 0, 1, ],
+      [ 1, 0, 1, 0, ],
+   ],
+   [
+      [ 1, 0, 0, 0, 1, 0, ],
+      [ 1, 0, 1, 0, 0, 1, ],
+      [ 1, 0, 0, 0, 0, 0, ],
+   ],
+);
+
+for @Ms -> @M {
+   put '';
+   print-matrix(@M);
+   put '---';
+   print-matrix(maximum-submatrix(@M));
+   put "\n--------\n";
+}
diff --git a/challenge-128/polettix/raku/ch-2.raku b/challenge-128/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..19e1f31547
--- /dev/null
+++ b/challenge-128/polettix/raku/ch-2.raku
@@ -0,0 +1,40 @@
+#!/usr/bin/env raku
+use v6;
+
+constant \freeup-window = +(%*ENV<FREEUP_WINDOW> // 10);
+
+sub minimum-platforms (@arrivals, @departures) {
+   sub pre-massage (@input) {
+      @input.map(
+         {
+            my ($h, $m) = .split: /\:/;
+            $h * 60 + $m;
+         }
+      ).sort;
+   }
+   my @sorted-arrivals = pre-massage(@arrivals);
+   my @sorted-departures = pre-massage(@departures);
+
+   constant \beyond-last = 30 * 60 + freeup-window; # 30th hour in the day... :)
+   my ($present, $min, $max) = (0, 0, 0);
+   while (@sorted-arrivals || @sorted-departures) {
+      my $arrival = @sorted-arrivals ?? @sorted-arrivals[0] !! beyond-last;
+      my $departure = @sorted-departures ?? @sorted-departures[0] !! beyond-last;
+      if $arrival <= $departure + freeup-window {
+         ++$present;
+         $max = $present if $present > $max;
+         @sorted-arrivals.shift;
+      }
+      else {
+         --$present;
+         $min = $present if $present < $min;
+         @sorted-departures.shift;
+      }
+   }
+   return $max - $min;
+}
+
+sub MAIN ($arrivals = '10:20 11:00 11:10 12:20 16:20 19:00 22:00 22:10 22:20 22:30',
+          $departures = '08:00 08:30 10:15 10:30 10:50 13:20 12:40 12:50 20:20 22:25') {
+   put minimum-platforms($arrivals.split(/\s+/), $departures.split(/\s+/));
+}