Challenge 2**7

2 files changed, 159 insertions, 0 deletions

diff --git a/challenge-128/dave-jacoby/perl/ch-1.pl b/challenge-128/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..9ec6f05290
--- /dev/null
+++ b/challenge-128/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures };
+no warnings qw{ experimental };
+
+use utf8;
+use JSON;
+use List::Util qw{ sum0 };
+
+my $json = JSON->new;
+
+my @experiments;
+push @experiments, <<'END';
+    1 0 0 0 1 0 
+    1 1 0 0 0 1 
+    1 0 0 0 0 0 
+END
+push @experiments, <<'END';
+    0 0 1 1 
+    0 0 0 1 
+    0 0 1 0 
+END
+push @experiments, <<'END';
+    
+    1 1 0 0 1 0 1 0
+    0 0 0 0 1 0 1 0
+    0 0 0 0 0 1 1 0
+    1 1 1 1 0 0 0 1
+    1 1 0 1 0 0 0 1
+
+END
+
+for my $e (@experiments) {
+    my @m =
+        map {
+        my @r = grep { /\d/ } split /\s+/, $_;
+        \@r
+        }
+        grep { /\d/ }
+        split m{\n}, $e;
+    my @subs =
+        sort { matrix_size($b) <=> matrix_size($a) } find_submatrices( \@m );
+    my $sub  = shift @subs;
+    my $size = matrix_size($sub);
+    say 'INPUT:';
+    display_matrix( \@m );
+    say 'OUTPUT:';
+    display_matrix($sub);
+    say '';
+}
+
+sub find_submatrices ( $matrix ) {
+    my @subs;
+    my $maxx = -1 + scalar $matrix->@*;
+    my $maxy = -1 + scalar $matrix->[0]->@*;
+    for my $x ( 0 .. $maxx ) {
+        for my $y ( 0 .. $maxy ) {
+            if ( $matrix->[$x][$y] == 0 ) {
+                for my $i ( $x + 1 .. $maxx ) {
+                    for my $j ( $y + 1 .. $maxy ) {
+                        my $sub = make_submatrix( $matrix, $x, $y, $i, $j );
+                        my $n   = sum0 flatten_matrix($sub);
+                        next if $n;
+                        push @subs, $sub;
+                    }
+                }
+            }
+        }
+    }
+    return @subs;
+}
+
+sub make_submatrix ( $matrix, $startx, $starty, $endx, $endy ) {
+    my $sub = [];
+    for my $i ( $startx .. $endx ) {
+        my $x = $i - $startx;
+        for my $j ( $starty .. $endy ) {
+            my $y = $j - $starty;
+            my $v = $matrix->[$i][$j];
+            $sub->[$x][$y] = $v;
+        }
+    }
+    return $sub;
+}
+
+sub matrix_size ( $matrix ) {
+    return scalar flatten_matrix($matrix);
+}
+
+sub display_matrix ($matrix ) {
+    say join "\n", map { join ' ', "\t", '[', $_->@*, ']' } $matrix->@*;
+}
+
+sub flatten_matrix ($matrix) {
+    return map { $_->@* } $matrix->@*;
+}
diff --git a/challenge-128/dave-jacoby/perl/ch-2.pl b/challenge-128/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..d9d3e6bfe3
--- /dev/null
+++ b/challenge-128/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+my @examples;
+push @examples,
+    {
+    arrivals   => [ '11:20', '14:30' ],
+    departures => [ '11:50', '15:00' ],
+    };
+
+push @examples,
+    {
+    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' ],
+    };
+
+for my $e (@examples) {
+    my $min_platforms = min_platforms($e);
+    my $arrivals      = join ', ', $e->{arrivals}->@*;
+    my $departures    = join ', ', $e->{departures}->@*;
+    say <<"END";
+    Input: \@arrivals   = ($arrivals)
+    Input: \@departures = ($departures)
+    Output: $min_platforms
+END
+}
+
+sub min_platforms ($timetable) {
+    my $p  = 0;
+    my $mp = 0;
+    my @arrivals =
+        map { s/\D//g; $_ }
+        map { $_ }
+        sort $timetable->{arrivals}->@*;
+    my @departures =
+        map { s/\D//g; $_ }
+        map { $_ }
+        sort $timetable->{departures}->@*;
+
+    my $first = $arrivals[0];
+    my $last  = $departures[-1];
+    for my $t ( $first .. $last ) {
+        if ( @arrivals && $t == $arrivals[0] ) {
+            shift @arrivals;
+            $p++;
+            $mp = $p if $p > $mp;
+        }
+        if ( @departures && $t == $departures[0] ) {
+            shift @departures;
+            $p--;
+        }
+    }
+
+    return $mp;
+}
+