Add Perl solution to challenge 128

5 files changed, 207 insertions, 0 deletions

diff --git a/challenge-128/paulo-custodio/perl/ch-1.pl b/challenge-128/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..ac750c3abc
--- /dev/null
+++ b/challenge-128/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+
+# 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 ]
+
+use Modern::Perl;
+
+my @mx = parse_matrix();
+my @submx = find_zeros(@mx);
+print_matrix(@submx);
+
+sub parse_matrix {
+    my @mx;
+    while (<>) {
+        s/^\s*\[([01 ]+)\]\s*$/$1/ or die "malformed matrix\n";
+        my @row = split(' ', $_);
+        push @mx, \@row;
+    }
+    return @mx;
+}
+
+sub print_matrix {
+    my(@mx) = @_;
+    for (@mx) {
+        my @row = @$_;
+        say "[ ", join(" ", @row), " ]";
+    }
+}
+
+sub find_zeros {
+    my(@mx) = @_;
+    my($max_rows, $max_cols) = (0, 0);
+
+    for my $r1 (0 .. $#mx) {
+        for my $c1 (0 .. $#{$mx[$r1]}) {
+            next unless $mx[$r1][$c1]==0;
+            for my $r2 ($r1 .. $#mx) {
+                for my $c2 ($c1 .. $#{$mx[$r1]}) {
+                    next unless $mx[$r2][$c2]==0;
+                    my $rows = $r2-$r1+1;
+                    my $cols = $c2-$c1+1;
+                    if ($rows*$cols > $max_rows*$max_cols) {
+                        if (all_zeros(\@mx, $r1, $c1, $r2, $c2)) {
+                            ($max_rows, $max_cols) = ($rows, $cols);
+                        }
+                    }
+                }
+            }
+        }
+    }
+    my @submx;
+    for my $r (1 .. $max_rows) {
+        push @submx, [(0) x $max_cols];
+    }
+    return @submx;
+}
+
+sub all_zeros {
+    my($mx, $r1, $c1, $r2, $c2) = @_;
+    for my $r ($r1 .. $r2) {
+        for my $c ($c1 .. $c2) {
+            return 0 if $mx->[$r][$c];
+        }
+    }
+    return 1;
+}
diff --git a/challenge-128/paulo-custodio/perl/ch-2.pl b/challenge-128/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..dccbdc1cc4
--- /dev/null
+++ b/challenge-128/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+
+# 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.
+
+use Modern::Perl;
+use Time::Piece;
+
+my @stops = parse_arrivals_departures();
+my @platforms = allocate_platforms(@stops);
+say scalar(@platforms);
+
+sub parse_arrivals_departures {
+	my @arrivals = parse_times();
+	my @departures = parse_times();
+	
+	my @stops;
+	while (@arrivals && @departures) {
+		push @stops, [shift @arrivals, shift @departures];
+	}
+	return @stops;
+}
+
+sub parse_times {
+	my @times = map {Time::Piece->strptime($_, "%H:%M")->epoch} 
+				split(' ', scalar(<>));
+}
+
+sub allocate_platforms {
+	my(@stops) = @_;
+	my @platforms;
+	
+	for my $stop (@stops) {
+		allocate_stop(\@platforms, @$stop);
+	}
+	return @platforms;
+}
+
+sub allocate_stop {
+	my($platforms, $s, $e) = @_;
+	for my $p (0 .. $#$platforms) {
+		if (platform_free($platforms->[$p], $s, $e)) {
+			push @{$platforms->[$p]}, [$s, $e];
+			return;
+		}
+	}
+	push @$platforms, [[$s, $e]];
+}
+
+sub platform_free {
+	my($platform, $s, $e) = @_;
+	for my $stop (@$platform) {
+		if (($s >= $stop->[0] && $s <  $stop->[1]) ||
+		    ($e >= $stop->[0] && $e <  $stop->[1]) ||
+			($s <  $stop->[0] && $e >= $stop->[1])) {
+			return 0;
+		}
+	}
+	return 1;
+}
diff --git a/challenge-128/paulo-custodio/t/test-1.yaml b/challenge-128/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..4c66347089
--- /dev/null
+++ b/challenge-128/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,22 @@
+- setup:
+  cleanup:
+  args:
+  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 ]
+- setup:
+  cleanup:
+  args:
+  input:    |
+            [ 0 0 1 1 ]
+            [ 0 0 0 1 ]
+            [ 0 0 1 0 ]
+  output:   |
+            [ 0 0 ]
+            [ 0 0 ]
+            [ 0 0 ]
diff --git a/challenge-128/paulo-custodio/t/test-2.yaml b/challenge-128/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..adfe949621
--- /dev/null
+++ b/challenge-128/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,14 @@
+- setup:
+  cleanup:
+  args:     
+  input:    |
+            11:20 14:30
+            11:50 15:00
+  output:   1
+- setup:
+  cleanup:
+  args:     
+  input:    |
+            10:20 11:00 11:10 12:20 16:20 19:00
+            10:30 13:20 12:40 12:50 20:20 21:20
+  output:   3
diff --git a/challenge-128/paulo-custodio/test.pl b/challenge-128/paulo-custodio/test.pl
new file mode 100644
index 0000000000..ba6c37260b
--- /dev/null
+++ b/challenge-128/paulo-custodio/test.pl
@@ -0,0 +1,4 @@
+#!/usr/bin/env perl
+use Modern::Perl;
+use Test::More;
+require '../../challenge-001/paulo-custodio/test.pl';