Merge pull request #4844 from Util/branch-for-challenge-128

Add Raku and Perl solutions for #128 by Bruce Gray

4 files changed, 229 insertions, 0 deletions

diff --git a/challenge-128/bruce-gray/perl/ch-1.pl b/challenge-128/bruce-gray/perl/ch-1.pl
new file mode 100755
index 0000000000..7fad53b99a
--- /dev/null
+++ b/challenge-128/bruce-gray/perl/ch-1.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/env perl
+# Translation of my Raku solution.
+use strict;
+use warnings;
+use 5.026;
+use experimental    qw<signatures>;
+use List::Util 1.56 qw<min first>;
+
+# Count uninterrupted zeros, omitting left-side neighbors.
+# So, <1 0 0 0 1 0> becomes <0 3 2 1 0 1>.
+sub streaks_of_zeros ( @row ) {
+    my $streak = 0;
+    return [reverse map {
+        +( $streak = $_ ? 0 : $streak+1 )
+    } reverse @row];
+}
+sub running_min_unil_zero ( @n ) {
+    my $min = $n[0];
+    my @r;
+    for (@n) {
+        $min = ($min <= $_) ? $min : $_;
+        last if $min <= 0;
+        push @r, $min;
+    }
+    return @r;
+}
+# Based on "bottleneck"; The max width of a rectangle that you are trying to fit as you scan downward,
+# gets squeezed narrower each time you iterate through a less-wide row.
+sub largest_sub_matrix_of_zeros ( $m ) {
+    # Build parallel matrix of zeros-to-my-right. @m not needed after this.
+    my @sog = map streaks_of_zeros(@{$_}), @{$m};
+
+    my @max = ( 0, 0, 0 );
+    for my $i ( keys @sog ) {
+        my @row = @{ $sog[$i] };
+        for my $j ( keys @row ) {
+            my $v = $row[$j];
+            # Since @sog holds the max-width to the right, a triangular reduce on `min` yields
+            # the max rectangle size from i,j down to each row.
+            my @column = map $_->[$j], @sog[ $i .. $#sog ];
+            my @slice_mins = running_min_unil_zero @column;
+            for my $depth0 ( keys @slice_mins ) {
+                my $width = $slice_mins[$depth0];
+                my $depth = $depth0 + 1;
+                my $area  = $depth * $width;
+                @max = ($depth, $width, $area) if $area > $max[2];
+            }
+        }
+    }
+    return @max;
+}
+
+my @tests = (
+    [
+        [qw<1 0 0 0 1 0>],
+        [qw<1 1 0 0 0 1>],
+        [qw<1 0 0 0 0 0>],
+    ],
+    [
+        [qw<0 0 1 1>],
+        [qw<0 0 0 1>],
+        [qw<0 0 1 0>],
+    ],
+    [
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+    ],
+    [
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+        [qw<1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>],
+    ],
+    [],
+);
+# @tests = @tests[0,1];
+for (@tests) {
+    my ($depth, $width) = largest_sub_matrix_of_zeros($_);
+    say '---';
+    say join(' ' => '[', (0) x $width, ']') for 1..$depth;
+}
diff --git a/challenge-128/bruce-gray/perl/ch-2.pl b/challenge-128/bruce-gray/perl/ch-2.pl
new file mode 100755
index 0000000000..35d7715c9f
--- /dev/null
+++ b/challenge-128/bruce-gray/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+# Translation of my Raku solution.
+use strict;
+use warnings;
+use 5.026;
+use experimental    qw<signatures>;
+use List::Util 1.56 qw<max zip>;
+
+sub time_to_offset ( $hh_mm_time ) {
+    $hh_mm_time =~ m{ \A (\d\d?) : (\d\d) \z }msx
+        or return; 
+    return $1 * 60 + $2;
+}
+sub max_trains ( $arrivals, $departures ) {
+    die if @{$arrivals} != @{$departures};
+
+    my @times;
+    for ( zip($arrivals, $departures) ) {
+        my ( $start, $end ) = map { time_to_offset($_) // die } @{$_};
+        $times[$_]++ for $start..$end;
+    }
+
+    return max grep {defined} @times;
+}
+
+my @tests = (
+    [
+        [ qw<11:20 14:30> ],
+        [ qw<11:50 15:00> ],
+    ],
+    [
+        [ qw<10:20 11:00 11:10 12:20 16:20 19:00> ],
+        [ qw<10:30 13:20 12:40 12:50 20:20 21:20> ],
+    ],
+);
+say max_trains($_->[0], $_->[1]) for @tests;
diff --git a/challenge-128/bruce-gray/raku/ch-1.raku b/challenge-128/bruce-gray/raku/ch-1.raku
new file mode 100644
index 0000000000..27bb095cf6
--- /dev/null
+++ b/challenge-128/bruce-gray/raku/ch-1.raku
@@ -0,0 +1,75 @@
+# Count uninterrupted zeros, omitting left-side neighbors.
+# So, <1 0 0 0 1 0> becomes <0 3 2 1 0 1>.
+sub streaks-of-zeros ( @row ) {
+    my $streak = 0;
+    return reverse @row.reverse.map: {
+        +( $streak = $_ ?? 0 !! $streak+1 )
+    }
+}
+# Based on "bottleneck"; The max width of a rectangle that you are trying to fit as you scan downward, 
+# gets squeezed narrower each time you iterate through a less-wide row.
+sub largest-sub-matrix-of-zeros ( @m ) {
+    # Build parallel matrix of zeros-to-my-right. @m not needed after this.
+    my @sog = @m.map(&streaks-of-zeros); 
+
+    my %max = <depth width area i j> Z=> (0,0,0, Any, Any);
+    for     @sog.kv -> $i, @row {
+        for @row.kv -> $j, $v   {
+            # Since @sog holds the max-width to the right, a triangular reduce on `min` yields
+            # the max rectangle size from i,j down to each row.
+            my @slice_mins = [\min] @sog.skip($i)».[$j].grep({ $_ or last });
+            for @slice_mins.kv -> $depth0, $width {
+                my $depth = $depth0 + 1;
+                my $area  = $depth * $width;
+                %max = :$area, :$depth, :$width, :$i, :$j if $area > %max<area>;
+            }
+        }
+    }
+    return %max;
+}
+
+my @tests =
+    (
+        <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>,
+    ),
+    (
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+    ),
+    (
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+        <1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1>,
+    ),
+    [],
+;
+for @tests {
+    my %r = largest-sub-matrix-of-zeros([.list».Int]);
+    say '---';
+    say %r;
+    say 0 xx %r<width> for ^%r<depth>;
+}
diff --git a/challenge-128/bruce-gray/raku/ch-2.raku b/challenge-128/bruce-gray/raku/ch-2.raku
new file mode 100644
index 0000000000..7f96df329c
--- /dev/null
+++ b/challenge-128/bruce-gray/raku/ch-2.raku
@@ -0,0 +1,21 @@
+sub max_trains ( @arrivals, @departures --> Int ) {
+    die if @arrivals != @departures;
+
+    sub time_to_offset ($_) { /^(\d\d?)\:(\d\d)$/ or die; $0 * 60 + $1; }
+    my @a =   @arrivals».&time_to_offset;
+    my @d = @departures».&time_to_offset;
+
+    return (@a Z.. @d).Bag.values.max;
+}
+
+my @tests =
+    (
+        <11:20 14:30>,
+        <11:50 15:00>,
+    ),
+    (
+        <10:20 11:00 11:10 12:20 16:20 19:00>,
+        <10:30 13:20 12:40 12:50 20:20 21:20>,
+    ),
+;
+say max_trains(|$_) for @tests;