week 128

2 files changed, 314 insertions, 0 deletions

diff --git a/challenge-128/cheok-yin-fung/perl/ch-1.pl b/challenge-128/cheok-yin-fung/perl/ch-1.pl
new file mode 100644
index 0000000000..3b978b2e4a
--- /dev/null
+++ b/challenge-128/cheok-yin-fung/perl/ch-1.pl
@@ -0,0 +1,203 @@
+#!/usr/bin/perl
+# The Weekly Challenge 128
+# Task 1 Maximum Sub-Matrix
+# Usage: $ ch-1.pl 
+use v5.12.0;
+use warnings;
+use List::Util qw/max/;
+use Test::More tests => 5;
+use Test::Deep;
+
+my $input_bin;
+
+$input_bin = [
+    [1,1,], 
+    [1,1,] 
+];
+
+say "Input:";
+print_matrix($input_bin);
+
+say "Output:";
+print_matrix(max_sub_matrix($input_bin));
+
+
+
+
+sub max_sub_matrix {
+    my $bin = $_[0];
+    my $M = scalar $bin->@*;
+    my $N = 2 + scalar $bin->[0]->@*;
+
+    my @arr_bin;
+    my @arr_dec;
+    for my $i (0..$M-1) {
+        push @arr_bin, join("", $bin->[$i]->@*) ;
+        push @arr_dec, 2**(2+$bin->[0]->$#*)+2*oct("0b".$arr_bin[$i])+1;
+    }
+
+
+    #  === BEGIN: use the last row as reference and initialization ===
+    my $btm_line = sprintf("%0b", my_not($arr_dec[-1], $N)); 
+    $btm_line =~ tr/01/ox/;
+    my $max_area = contiguous_block_of_xs($btm_line);
+    my $max_width = $max_area;
+    my $max_height = 1;
+    #  === END: use the last row as reference and initialization =====
+
+    for my $i (0..$M-2) {
+
+        my $temp = $arr_dec[$i];
+        my $tmp_temp = sprintf("%0b", my_not($temp, $N)); 
+        $tmp_temp =~ tr/01/ox/;
+
+    #  ====== BEGIN: whether the i-th row contains a large number of x's ===
+        my $the_row_ones = contiguous_block_of_xs($tmp_temp);
+        if ($the_row_ones > $max_area) {
+            $max_height = 1;
+            $max_width = $the_row_ones;
+            $max_area = $the_row_ones;
+        }
+    #  ====== END: whether the i-th row contains a large number of x's =====
+
+    #  === BEGIN: check from the next row to the bottom of the matrix ===
+        for my $j ($i+1..$M-1) {
+            $temp = not_or( $temp, $arr_dec[$j], $N);      
+        
+            my $x = sprintf("%0b",$temp);  
+            $x =~ tr/01/ox/;
+            my $this_height = $j-$i+1;
+            my $this_width = contiguous_block_of_xs($x);
+ 
+            my $this_area = $this_width * $this_height;
+            if ($this_area > $max_area) {
+                $max_height = $this_height;
+                $max_width = $this_width;
+                $max_area = $this_area;
+            }
+
+    #  ============ BEGIN: preparation for next loop ================
+            $temp = ~$temp;  
+    #  ============ END: preparation for next loop ==================
+    #  === END: check from the next row to the bottom of the matrix ===
+
+        }
+    }
+    return zeros($max_height, $max_width) if $max_area > 0;
+    return [];
+}
+
+
+
+sub zeros {
+    my $height = $_[0];
+    my $width = $_[1];
+    my @a;
+    for (1..$height) {
+        push @a, [('0') x $width];
+    }
+    return [@a]; 
+}
+
+
+
+sub contiguous_block_of_xs {
+    my @arr = split //, $_[0];
+    my @ans;
+    my $counter = 0;
+    while ( $counter < scalar @arr ) {
+        my $i = 0;
+        $ans[$counter] = 0;
+
+        while (defined($arr[$counter+$i]) && $arr[$counter+$i] eq "x") {
+            $ans[$counter]++;
+            $i++;
+        }
+        $counter++;
+    }
+    return max( @ans ) if scalar @ans > 0;
+    return 0;
+}
+
+
+
+sub my_not {
+    my $N = $_[1];
+    return ~$_[0] & (2**($N-1)-1);
+}
+
+
+
+sub not_or {
+    my $N = $_[2];
+    return ~($_[0] | $_[1]) & (2**($N-1)-1) ;
+}
+
+
+sub print_matrix {
+    my $m = $_[0];
+    say "[", (join " ", $m->[$_]->@*), "]" for (0..$m->$#*);
+    say "[]" if scalar $m->@* == 0;
+}
+
+
+
+cmp_deeply(
+    max_sub_matrix(
+        [[1,0,0,0,1,0,],
+         [1,1,0,0,0,1,],
+         [1,0,0,0,0,0,]]
+    ) ,
+    [ [0,0], [0,0] ,[0,0] ],
+    "Example 1",
+);
+
+
+cmp_deeply(
+    max_sub_matrix(
+       [[ 0,0,1,1 ],
+        [ 0,0,0,1 ],
+        [ 0,0,1,0 ]]
+    ) ,
+    [ [0,0], [0,0] ,[0,0] ] ,
+    "Example 2"
+);
+
+
+cmp_deeply(
+    max_sub_matrix(
+       [[ 0,1,1,1 ],
+        [ 0,0,0,0 ],
+        [ 1,1,1,0 ]]
+    ) ,
+    [ [0,0,0,0] ] ,
+    "Test 1"
+);
+
+
+cmp_deeply(
+    max_sub_matrix(
+        [ [1,0,0,0,1,0,],
+          [1,1,0,0,0,1,],
+          [1,0,0,0,0,0,],
+          [1,0,0,0,0,0,] ]
+    ) ,
+    [ [0,0,0,0,0], [0,0,0,0,0]],
+    "Test 2",
+);
+
+
+cmp_deeply(
+    max_sub_matrix(
+       [  [qw/0 1 1 1 0 1 0 1/],
+          [qw/0 1 0 0 0 1 1 0/],
+          [qw/1 1 1 0 1 1 1 1/],
+          [qw/0 1 1 1 1 0 0 0/],
+          [qw/1 1 1 1 0 0 0 0/],
+          [qw/0 0 0 1 0 0 0 0/],
+          [qw/0 0 1 1 1 0 1 1/],
+          [qw/0 0 1 1 1 0 0 0/] ]
+    ),
+    [ [0,0,0,], [0,0,0,], [0,0,0,]],
+    "Test 3"
+);
diff --git a/challenge-128/cheok-yin-fung/perl/ch-2.pl b/challenge-128/cheok-yin-fung/perl/ch-2.pl
new file mode 100644
index 0000000000..3b695524b5
--- /dev/null
+++ b/challenge-128/cheok-yin-fung/perl/ch-2.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/perl
+# The Weekly Challenge 128
+# Task 2 Minimum Platforms
+# Usage: $ ch-2.pl arrival timetable x departure timetable
+use v5.12.0;
+use warnings;
+use List::Util qw/any/;
+use Data::Dumper;
+use Test::More tests => 2;
+
+my (@a, @a1, @a2);
+@a = @ARGV;
+@a = ("08:00", "15:30", "04:11", 'x', "15:00", "18:00", "09:27") 
+    if !defined($ARGV[0]);
+my $i = 0;
+
+while ($a[$i] ne 'x' && $i < scalar @a) {
+    push @a1, $a[$i];
+    $i++;
+}
+
+$i++;
+
+while ($i < scalar @a) {
+    push @a2, $a[$i];
+    $i++;
+}
+
+die if scalar @a1 != scalar @a2;
+
+say "\@arrivals  : ", "@a1";
+say "\@departures: ", "@a2";
+say "minimum number of platform(s) needed:";
+say platforms_needed( 
+    [map {hourmin_to_min($_)} @a1 ],  
+    [map {hourmin_to_min($_)} @a2 ]
+);
+
+
+
+sub hourmin_to_min {
+    my $s = $_[0];
+    $s =~ m/(\d+):(\d+)/;
+    return $1*60 + $2;
+}
+
+
+
+sub platforms_needed {
+    my @arrive_min = $_[0]->@*;
+    my @depart_min = $_[1]->@*;
+    my %station_traffic; 
+    for (@arrive_min) {
+        if (defined($station_traffic{$_})) {
+            $station_traffic{ $_ }++;
+        }
+        else {
+            $station_traffic{ $_ } = 1;
+        }
+    }
+    for (@depart_min) {
+        if (defined($station_traffic{$_})) {
+            $station_traffic{ $_ }--;
+        }
+        else {
+            $station_traffic{ $_ } = -1;
+        }
+    }
+
+    my @events = sort {$a<=>$b} keys %station_traffic;
+    my $status = 0;
+    my $max_status = 0;
+    for (@events) {
+        $status += $station_traffic{ $_ };
+        $max_status = $status if $status > $max_status;
+    }
+    return $max_status;
+}
+
+
+
+sub platforms_needed_primitive {
+    # An assumption: 
+    # neither two trains arrive at the same 
+    # time nor leave at the same time
+    my @arrive_min = $_[0]->@*;
+    my @depart_min = $_[1]->@*;
+
+    my $p = 0;
+    my $max_p = 0;
+    for my $t (0..1439) {
+        $p++ if any { $t == $_ } @arrive_min;
+        $max_p = $p if $p > $max_p;
+        $p-- if any { $t == $_ } @depart_min;
+    }
+
+    return $max_p;
+}
+
+
+ok platforms_needed(
+    [ 11*60+20, 14*60+30 ], 
+    [ 11*60+50, 15*60 ] 
+) == 1,
+"Example 1";
+
+ok platforms_needed(
+    [ 10*60+20, 11*60+00, 11*60+10, 12*60+20, 16*60+20, 19*60+00 ], 
+    [ 10*60+30, 13*60+20, 12*60+40, 12*60+50, 20*60+20, 21*60+20 ] 
+) == 3,
+"Example 2";