CY's Take on The Weekly Challenge #128
If you want to challenge yourself on programming, especially on Perl and/or Raku, go to https://theweeklychallenge.org, code the latest challenges, submit codes on-time (by GitHub or email).
Do tell me, if I am wrong or you strongly oppose my statements!
It's time for challenges in Week #128 !
Previous Challenges: I have updated my short notes on The Weekly Challenge.
Task 1: Maximum Sub-Matrix
It grabbed me several hours to handle the typing and casting. This link is useful in general but did not help in this case. Finally I realised that the numeric value 011 is interpreted by the Perl interpreter as base-8 number. A roundabout which does not affect the completion of the task is concatenating a "1" on its leading position. (Well, honestly, I coded it from early morning to lunch time, upto a degree that I was not sure what I was doing; the trailing position is concatenated by a 1 as well.)
I compared the matrix row by row and used NOR.
And then the script replaces "1" by "x", "0" by "o".
Usually, I want the code speaks, not the comments. Hence I post a code with running result. This code is made of the final submitted code and the code during production.
The name of the important subroutine contiguous_block_of_xs explains the use of itself, so I skipped its details here.
#!/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 => 2;
use Test::Deep;
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);
say "bottom line area: $max_area";
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];
say "== ", $arr_dec[$i], "($arr_bin[$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) {
say sprintf("%0b",$arr_dec[$j]);
$temp = not_or( $temp, $arr_dec[$j], $N);
my $x = sprintf("%0b",$temp);
say "binary string version of x: $x"; # testing line
$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;
printf " %0b\n", $arr_dec[$j];
print "x: ", $x, " h: ", $this_height, " w: ", $this_width, " "; #testing line
say "area: ", $this_area; #testing line
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 contiguous_block_of_xs {
# skip here
}
sub zeros {
# skip here
}
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 {
# skip here
}
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"
);
$ perl ch-1-for-blogpost.pl bottom line area: 5 == 197(100010) == 11100011 binary string version of x: 11000 11100011 x: xxooo h: 2 w: 2 area: 4 11000001 binary string version of x: 11000 11000001 x: xxooo h: 3 w: 2 area: 6 == 227(110001) == 11000001 binary string version of x: 11100 11000001 x: xxxoo h: 2 w: 3 area: 6 ok 1 - Example 1 bottom line area: 2 == 39(0011) == 100011 binary string version of x: 11000 100011 x: xxooo h: 2 w: 2 area: 4 100101 binary string version of x: 11000 100101 x: xxooo h: 3 w: 2 area: 6 == 35(0001) == 100101 binary string version of x: 11000 100101 x: xxooo h: 2 w: 2 area: 4 ok 2 - Example 2
At the end I would like to say, for me, this is the most challenging Task 1 recently. It reminds me that I haven't coded the Trapped Rain Water of Week 080.
Task 2: Minimum Platforms
I was lazy but finally I try for this task: write a brute-force/not-that-time-efficient solution and then write a thoughtful solution, and compare whether they give the same result.
The primitive subroutine is "time-driven"; the thoughtful subrountine is "event-driven". (Terminology inspired by the algorithm course from Princeton Univesity: details.)
For the thoughtful subrountine, hashes store the number of trains in the station and use the minutes as hash keys.
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) {
#skip here, similar to the above loop
}
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;
}
For the primitive subroutine, I let the code speak:
(it works on the assumption that
neither two trains come nor leave the station at the same time)
sub platforms_needed_primitive {
my @arrive_min = $_[0]->@*;
my @depart_min = $_[1]->@*;
my $p = 0;
my $max_p = 0;
for my $t (0..1439) { # 60*24-1 = 1439
$p++ if any { $t == $_ } @arrive_min;
$max_p = $p if $p > $max_p;
$p-- if any { $t == $_ } @depart_min;
}
return $max_p;
}
Wear your mask, stay alert and healthy! □
Footnotes:
This week, a tweet from the creator of Advent of Code made me reminds what language I would use in the coming December. I like LISP, and for marketing reason, I thought of learning its modern dialect, Clojure. I have been also interested in Haskell ‐ again a functional programming language. Just discover I get the book Perl Debugged by Peter Scott and Ed Wright, and I should learn how to use a debugger and trace values of variables by official tools (instead of using "print" or "say"). For living, better focus on one to three programming languages first; for AoC, try to collect all fifty stars first. I decide I will use Perl for the event this year. Codes from last year is here. You are going to see my solutions here. I may blog about AoC HERE.
There are still many other concerns recently, especially on education and career, and I had many negative thoughts. I am trying to go back to regular cross country running ‐ a hobby not related to coding, science or math ‐ to alter the focus.
Anyway hopefully I can have a December 2021 full of codes.
The image of the train station is taken by me in 2009 and you may share it under the free and open content spirit.
Except from images and codes from other personnels, the content of this blogpost is released under a copyleft spirit. One may share (full or partial) content of this blogpost on other platform if you share it under the free and open content spirit.
link for CY's full codes: ch-1.pl, ch-2.pl
Contact on twitter: @e7_87.
Discuss via GitHub issues: here.
Email: fungcheokyin at gmail.com; I check email everyday.
Created Date: 3rd September, 2021. Updated: 4th Sep 07:43 HKT.