Perl Weekly Challenge 152.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 152.
Task 1: Triangle Sum Path
Submitted by: Mohammad S Anwar
You are given a triangle array.
Write a script to find the minimum sum path from top to
bottom.
Example 1:
Input: $triangle = [ [1], [5,3], [2,3,4], [7,1,0,2],
[6,4,5,2,8] ]
1
5 3
2 3 4
7 1 0 2
6 4 5 2 8
Output: 8
Minimum Sum Path = 1 + 3 + 2 + 0 + 2 => 8
Example 2:
Input: $triangle = [ [5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9] ]
5
2 3
4 1 5
0 1 2 3
7 2 4 1 9
Output: 9
Minimum Sum Path = 5 + 2 + 1 + 0 + 1 => 9
From the examples it is clear that any path down the triangle is valid, so I just have to choose the minimum values for each row and sum them. This yields a very compact oneliner:
perl -MList::Util=min,sum0 -d -E '
say "In: $_, Out: ", sum0 map {min @$_} @{eval $_} for @ARGV;
' '[[1], [5,3], [2,3,4], [7,1,0,2],[6,4,5,2,8]]' '[[5],[2,3],[4,1,5],[0,1,2,3],[7,2,4,1,9]]'
Results:
In: [[1], [5,3], [2,3,4], [7,1,0,2],[6,4,5,2,8]], Out: 8
In: [[5],[2,3],[4,1,5],[0,1,2,3],[7,2,4,1,9]], Out: 9
I assume the input is a list of strings, each describing a
correct multidimensional Perl array describing the triangle,
which by the way, does not even need a triangular shape,
so that I can eval it. The result is an array of references
to the rows of the given triangle. I convert each of them to
an array, find their minimum value and sum over the rows to
obtain the output. I use the min and sum0 subroutines from
List::Util.
A full version is
1 # Perl weekly challenge 152
2 # Task 1: Minimum sum path
3 #
4 # See https://wlmb.github.io/2022/02/14/PWC152/#task-1-minimum-sum-path
5 use v5.12;
6 use warnings;
7 use List::Util qw(min sum0 all);
8 use Try::Tiny;
9 die "Usage: ./ch-1.pl T1 [T2]...\n"
10 . "where Ti are triangles of the form '[[T00],[T10,T11],[T20,T21,T22]...'"
11 unless @ARGV;
12 for my $triangle_string (@ARGV){
13 try {
14 my $triangle=eval $triangle_string;
15 my @rows=@$triangle;
16 # Seems unnecesary, but test shape
17 die "Wrong row-size in $triangle_string"
18 unless all{$_+1==@{$rows[$_]}}(0..@rows-1);
19 my @minima=map {min @$_} @rows;
20 my $sum=sum0 @minima;
21 say "Input: $triangle_string\nOutput: $sum\nPath values: ", join "-", @minima;
22 }
23 catch {
24 say $_;
25 }
26 }
Example:
./ch-1.pl '[[1], [5,3], [2,3,4], [7,1,0,2],[6,4,5,2,8]]' '[[5],[2,3],[4,1,5],[0,1,2,3],[7,2,4,1,9]]'
Results:
Input: [[1], [5,3], [2,3,4], [7,1,0,2],[6,4,5,2,8]]
Output: 8
Path values: 1-3-2-0-2
Input: [[5],[2,3],[4,1,5],[0,1,2,3],[7,2,4,1,9]]
Output: 9
Path values: 5-2-1-0-1
Examples with errors and extreme cases:
./ch-1.pl '[[1], [5,3], [2,4], [7,1,0,2],[6,4,5,2,8]]'\
'[5],[2,3],[4,1,5],[0,1,2,3],[7,2,4,1,9]' '[[1]]' '[[]]'
Results:
Wrong row-size in [[1], [5,3], [2,4], [7,1,0,2],[6,4,5,2,8]] at ./ch-1.pl line 19.
Can't use string ("7") as an ARRAY ref while "strict refs" in use at ./ch-1.pl line 19.
Input: [[1]]
Output: 1
Path values: 1
Wrong row-size in [[]] at ./ch-1.pl line 19.
Task 2: Rectangle Area
Submitted by: Mohammad S Anwar
You are given coordinates bottom-left and top-right corner of
two rectangles in a 2D plane.
Write a script to find the total area covered by the two
rectangles.
Example 1:
Input: Rectangle 1 => (-1,0), (2,2)
Rectangle 2 => (0,-1), (4,4)
Output: 22
Example 2:
Input: Rectangle 1 => (-3,-1), (1,3)
Rectangle 2 => (-1,-3), (2,2)
Output: 25
This problem may be messy, as there are many possibilities for
the relative positions of the different vertices.
The problem may be simplified by dividing rectangles that have a partial
overlap. This allows a generalization of the problem to that
of the area of N rectangles. I obtain
the coordinates of each rectangle, four at a time, from
@ARGV. I build a list of non-overlapping
rectangles. If a rectangle doesn’t overlap the area of any
previously added
rectangle, I add it. If it does, I split it in two and try to
add the fragments instead. After a sequence of splitting
horizontally and vertically the pending rectangles, I either
end up with some rectangles that do not overlap any other
rectangle, in which case I must add them to the list, or with
rectangles that are fully contained in one of the previous
rectangles, in which case I simply throw them away. The area is
the sum of the areas of the non-overlapping rectangles.
1 # Perl weekly challenge 152
2 # Task 2: Rectangle area
3 #
4 # See https://wlmb.github.io/2022/02/14/PWC152/#task-2-rectangle-area
5 use v5.12;
6 use warnings;
7 use List::Util qw(min sum0 all);
8 die "Usage: ./ch-2.pl L1 B1 R1 T1 L2 B2 R2 T2 ..."
9 . "where L's B's R's and T's denote left, bottom, right and top coordinates"
10 unless @ARGV;
11 my @non_ol;
12 my @input;
13 my @pending;
14 while(@ARGV){
15 die "# coordinates must be multiple of four" unless @ARGV>=3;
16 my ($L,$B,$R,$T)=splice @ARGV, 0, 4;
17 ($L, $R)=($R, $L) if $L>$R; # reorder if necessary
18 ($B, $T)=($T, $B) if $B>$T;
19 push @input, {left=>$L, bottom=>$B, right=>$R, top=>$T};
20 }
21 my @pending=@input;
22 ADD1:
23 while(@pending){
24 my $rectangle=shift @pending;
25 foreach(@non_ol){
26 my @fragments=divide($rectangle, $_);
27 next ADD1 if @fragments==1; # rectangle contained in some other piece
28 push(@pending, @fragments), next ADD1 if @fragments>1;
29
30 }
31 push @non_ol, $rectangle;
32 }
33 say "Input: ";
34 say "\tRectangle $_: ($input[$_]->{left},$input[$_]->{bottom}), ",
35 "($input[$_]->{right},$input[$_]->{top})" for(0..@input-1);
36 say "Area: ", sum0 map {($_->{right}-$_->{left})*($_->{top}-$_->{bottom})} @non_ol;
37 say "Non-overlapping subregions: ";
38 say "\tRectangle $_: ($non_ol[$_]->{left},$non_ol[$_]->{bottom}), ",
39 "($non_ol[$_]->{right},$non_ol[$_]->{top})" for(0..@non_ol-1);
40 sub divide {
41 my ($p, $q)=@_;
42 return if $p->{left}>=$q->{right} # no overlap
43 or $p->{right}<=$q->{left}
44 or $p->{bottom}>=$q->{top}
45 or $p->{top}<=$q->{bottom};
46 return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$q->{left}, top=>$p->{top}},
47 {left=>$q->{left}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$p->{top}})
48 if $p->{left}<$q->{left}; # split left
49 return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$q->{right}, top=>$p->{top}},
50 {left=>$q->{right}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$p->{top}})
51 if $p->{right}>$q->{right}; # split right
52 return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$q->{bottom}},
53 {left=>$p->{left}, bottom=>$q->{bottom}, right=>$p->{right}, top=>$p->{top}})
54 if $p->{bottom}<$q->{bottom}; # split bottom
55 return ({left=>$p->{left}, bottom=>$p->{bottom}, right=>$p->{right}, top=>$q->{top}},
56 {left=>$p->{left}, bottom=>$q->{top}, right=>$p->{right}, top=>$p->{top}})
57 if $p->{top}>$q->{top}; # split top
58 return $p; # $p contained in $q
59 }
60
Examples:
./ch-2.pl -1 0 2 2 0 -1 4 4
./ch-2.pl -3 -1 1 3 -1 -3 2 2
Results:
Input:
Rectangle 0: (-1,0), (2,2)
Rectangle 1: (0,-1), (4,4)
Area: 22
Non-overlapping subregions:
Rectangle 0: (-1,0), (2,2)
Rectangle 1: (2,-1), (4,4)
Rectangle 2: (0,-1), (2,0)
Rectangle 3: (0,2), (2,4)
Input:
Rectangle 0: (-3,-1), (1,3)
Rectangle 1: (-1,-3), (2,2)
Area: 25
Non-overlapping subregions:
Rectangle 0: (-3,-1), (1,3)
Rectangle 1: (1,-3), (2,2)
Rectangle 2: (-1,-3), (1,-1)
Example with several overlapping squares along a diagonal:
./ch-2.pl 0 0 2 2 1 1 3 3 2 2 4 4 3 3 5 5
Results:
Input:
Rectangle 0: (0,0), (2,2)
Rectangle 1: (1,1), (3,3)
Rectangle 2: (2,2), (4,4)
Rectangle 3: (3,3), (5,5)
Area: 13
Non-overlapping subregions:
Rectangle 0: (0,0), (2,2)
Rectangle 1: (2,2), (4,4)
Rectangle 2: (4,3), (5,5)
Rectangle 3: (1,2), (2,3)
Rectangle 4: (2,1), (3,2)
Rectangle 5: (3,4), (4,5)
Example with overlapping crosses:
./ch-2.pl -1 -5 1 5 -2 -4 2 4 -3 -3 3 3 -4 -2 4 2 -5 -1 5 1
Results:
Input:
Rectangle 0: (-1,-5), (1,5)
Rectangle 1: (-2,-4), (2,4)
Rectangle 2: (-3,-3), (3,3)
Rectangle 3: (-4,-2), (4,2)
Rectangle 4: (-5,-1), (5,1)
Area: 60
Non-overlapping subregions:
Rectangle 0: (-1,-5), (1,5)
Rectangle 1: (-2,-4), (-1,4)
Rectangle 2: (1,-4), (2,4)
Rectangle 3: (-3,-3), (-2,3)
Rectangle 4: (2,-3), (3,3)
Rectangle 5: (-4,-2), (-3,2)
Rectangle 6: (3,-2), (4,2)
Rectangle 7: (-5,-1), (-4,1)
Rectangle 8: (4,-1), (5,1)
In the problem description there are only two rectangles, and their intersection is either empty or some rectangle. These allows a simplified solution, where we just add the area of each rectangle and subtract the area of the intersection (or 0, if empty). This suggest a one-liner (5-liner):
perl -MList::Util=min,max -E '($p,$q)=map {[splice @ARGV, 0, 4]} (1,2);
say a($p)+a($q)-i($p,$q);sub a{my ($x0,$y0,$x1,$y1)=@{$_[0]};($x1-$x0)*($y1-$y0)}
sub i{my ($x0,$y0,$x1,$y1,$x2,$y2,$x3,$y3)=map {@{$_}} @_;
return 0 if $x0>=$x3 || $x1<=$x2 || $y0>=$y3 || $y1<=$y2;
a([max($x0,$x2),max($y0,$y2),min($x1,$x3),min($y1,$y3)])}
' -- -1 0 2 2 0 -1 4 4
perl -MList::Util=min,max -E '($p,$q)=map {[splice @ARGV, 0, 4]} (1,2);
say a($p)+a($q)-i($p,$q);sub a{my ($x0,$y0,$x1,$y1)=@{$_[0]};($x1-$x0)*($y1-$y0)}
sub i{my ($x0,$y0,$x1,$y1,$x2,$y2,$x3,$y3)=map {@{$_}} @_;
return 0 if $x0>=$x3 || $x1<=$x2 || $y0>=$y3 || $y1<=$y2;
a([max($x0,$x2),max($y0,$y2),min($x1,$x3),min($y1,$y3)])}
' -- -3 -1 1 3 -1 -3 2 2
Results:
22
25
Here the subroutine a calculates the area of a rectangle and i the area
of the intersection of two rectangles. The intersection
between A and B is
empty if AL > BR, or if if AR < BL, or…
where L denotes the leftmost and R rightmost coordinate. A
similar consideration may be done for the vertical
coordinates. I change the strict inequalities to >= and
<=, as overlaping lines don’t contribute to the area.
In case of overlap, the overlapping rectangle lies to the
right of AL and BL, to the left of AR and BR and
so on. This allows the calculation and subtraction of the
area of the intersection.