Merge pull request #5659 from wlmb/challenges

Solve PWC152

3 files changed, 88 insertions, 0 deletions

diff --git a/challenge-152/wlmb/blog.txt b/challenge-152/wlmb/blog.txt
new file mode 100644
index 0000000000..7e179b07fc
--- /dev/null
+++ b/challenge-152/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/02/14/PWC152/
diff --git a/challenge-152/wlmb/perl/ch-1.pl b/challenge-152/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..8cfb5aaaa3
--- /dev/null
+++ b/challenge-152/wlmb/perl/ch-1.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 152
+# Task 1: Minimum sum path
+#
+# See https://wlmb.github.io/2022/02/14/PWC152/#task-1-minimum-sum-path
+use v5.12;
+use warnings;
+use List::Util qw(min sum0 all);
+use Try::Tiny;
+die "Usage: ./ch-1.pl T1 [T2]...\n"
+    . "where Ti are triangles of the form '[[T00],[T10,T11],[T20,T21,T22]...'"
+    unless @ARGV;
+for my $triangle_string (@ARGV){
+    try {
+	my $triangle=eval $triangle_string;
+	my @rows=@$triangle;
+	# Seems unnecesary, but test shape
+	die "Wrong row-size in $triangle_string"
+	    unless all{$_+1==@{$rows[$_]}}(0..@rows-1);
+	my @minima=map {min @$_} @rows;
+	my $sum=sum0 @minima;
+	say "Input: $triangle_string\nOutput: $sum\nPath values: ", join "-", @minima;
+    }
+    catch {
+	say $_;
+    }
+}
diff --git a/challenge-152/wlmb/perl/ch-2.pl b/challenge-152/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..4e9ca2e932
--- /dev/null
+++ b/challenge-152/wlmb/perl/ch-2.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 152
+# Task 2: Rectangle area
+#
+# See https://wlmb.github.io/2022/02/14/PWC152/#task-2-rectangle-area
+use v5.12;
+use warnings;
+use List::Util qw(min sum0 all);
+die "Usage: ./ch-2.pl L1 B1 R1 T1 L2 B2 R2 T2 ..."
+    . "where L's B's R's and T's denote left, bottom, right and top coordinates"
+    unless @ARGV;
+my @non_ol;
+my @input;
+my @pending;
+while(@ARGV){
+    die "# coordinates must be multiple of four" unless @ARGV>=3;
+    my ($L,$B,$R,$T)=splice @ARGV, 0, 4;
+    ($L, $R)=($R, $L) if $L>$R; # reorder if necessary
+    ($B, $T)=($T, $B) if $B>$T;
+    push @input, {left=>$L, bottom=>$B, right=>$R, top=>$T};
+}
+my @pending=@input;
+ ADD1:
+    while(@pending){
+	my $rectangle=shift @pending;
+	foreach(@non_ol){
+	    my @fragments=divide($rectangle, $_);
+	    next ADD1 if @fragments==1; # rectangle contained in some other piece
+	    push(@pending, @fragments), next ADD1 if @fragments>1;
+
+	}
+	push @non_ol, $rectangle;
+}
+say "Input: ";
+say "\tRectangle $_: ($input[$_]->{left},$input[$_]->{bottom}), ",
+    "($input[$_]->{right},$input[$_]->{top})" for(0..@input-1);
+say "Area: ", sum0 map {($_->{right}-$_->{left})*($_->{top}-$_->{bottom})} @non_ol;
+say "Non-overlapping subregions: ";
+say "\tRectangle $_: ($non_ol[$_]->{left},$non_ol[$_]->{bottom}), ",
+    "($non_ol[$_]->{right},$non_ol[$_]->{top})" for(0..@non_ol-1);
+sub divide {
+    my ($p, $q)=@_;
+    return if $p->{left}>=$q->{right}    # no overlap
+              or $p->{right}<=$q->{left}
+              or $p->{bottom}>=$q->{top}
+              or  $p->{top}<=$q->{bottom};
+    return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$q->{left}, top=>$p->{top}},
+	    {left=>$q->{left}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$p->{top}})
+	if $p->{left}<$q->{left}; # split left
+    return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$q->{right}, top=>$p->{top}},
+	    {left=>$q->{right}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$p->{top}})
+	if $p->{right}>$q->{right}; # split right
+    return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$q->{bottom}},
+	    {left=>$p->{left}, bottom=>$q->{bottom}, right=>$p->{right}, top=>$p->{top}})
+	if $p->{bottom}<$q->{bottom}; # split bottom
+    return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$q->{top}},
+	    {left=>$p->{left}, bottom=>$q->{top}, right=>$p->{right}, top=>$p->{top}})
+	if $p->{top}>$q->{top}; # split top
+    return $p; # $p contained in $q
+}