Solve 152: Triangle Sum Path & Rectangle Area by E. Choroba

2 files changed, 117 insertions, 0 deletions

diff --git a/challenge-152/e-choroba/perl/ch-1.pl b/challenge-152/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..8f693c3144
--- /dev/null
+++ b/challenge-152/e-choroba/perl/ch-1.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use List::Util qw{ min sum };
+
+sub triangle_sum_path {
+    my ($triangle) = @_;
+    return sum(map min(@$_), @$triangle)
+}
+
+use Test::More tests => 2;
+
+is triangle_sum_path([ [1], [5,3], [2,3,4], [7,1,0,2], [6,4,5,2,8] ]),
+    8,
+    'Example 1';
+is triangle_sum_path([ [5], [2,3], [4,1,5], [0,1,2,3], [7,2,4,1,9] ]),
+    9,
+    'Example 2';
diff --git a/challenge-152/e-choroba/perl/ch-2.pl b/challenge-152/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..705428433d
--- /dev/null
+++ b/challenge-152/e-choroba/perl/ch-2.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# First point is the lower left, second point is the upper right.
+sub canonical_rect {
+    my ($rect) = @_;
+    my ($point1, $point2) = @$rect;
+    my @x = sort { $a <=> $b } map $_->[0], $point1, $point2;
+    my @y = sort { $a <=> $b } map $_->[1], $point1, $point2;
+    return [[$x[0], $y[0]], [$x[1], $y[1]]]
+}
+
+sub area {
+    my ($r) = @_;
+    return ($r->[1][0] - $r->[0][0]) * ($r->[1][1] - $r->[0][1])
+}
+
+sub overlap {
+    my ($r1, $r2) = @_;
+
+    my ($point1, $point2) = ([], []);
+
+    for my $i (0, 1) {
+        ($r1, $r2) = ($r2, $r1) if $r1->[0][$i] > $r2->[0][$i];
+        return 0 unless $r2->[0][$i] < $r1->[1][$i]
+                     && $r2->[1][$i] > $r1->[0][$i];
+
+        push @$point1, $r2->[0][$i];
+        push @$point2, (($r1->[1][$i] < $r2->[1][$i]) ? $r1 : $r2)->[1][$i];
+    }
+
+    return area([$point1, $point2])
+}
+
+sub rectangle_area {
+    my ($r1, $r2) = @_;
+    $_ = canonical_rect($_) for $r1, $r2;
+    return area($r1) + area($r2) - overlap($r1, $r2)
+}
+
+# Count every square in both the rectangles.
+sub rectangle_area_naive {
+    my ($r1, $r2) = @_;
+
+    my %grid;
+    for my $r ($r1, $r2) {
+        my @xs = $r->[0][0] < $r->[1][0]
+               ? $r->[0][0] .. $r->[1][0] - 1
+               : $r->[1][0] .. $r->[0][0] - 1;
+        for my $x (@xs) {
+            my @ys = $r->[0][1] < $r->[1][1]
+                   ? $r->[0][1] .. $r->[1][1] - 1
+                   : $r->[1][1] .. $r->[0][1] - 1;
+            for my $y (@ys) {
+                undef $grid{"$x $y"};
+            }
+        }
+    }
+    return scalar keys %grid
+}
+
+use Test::More tests => 35;
+
+is_deeply canonical_rect([[1, 2], [3, 4]]), [[1, 2], [3, 4]], 'cannonical 1';
+is_deeply canonical_rect([[3, 4], [1, 2]]), [[1, 2], [3, 4]], 'cannonical 2';
+is_deeply canonical_rect([[1, 4], [3, 2]]), [[1, 2], [3, 4]], 'cannonical 3';
+is_deeply canonical_rect([[3, 2], [1, 4]]), [[1, 2], [3, 4]], 'cannonical 4';
+
+is area([[0, 0], [3, 3]]), 9, 'area 1';
+is area([[1, 2], [4, 5]]), 9, 'area 2';
+
+is overlap(map canonical_rect($_), [[-1,  0], [2, 2]], [[ 0, -1], [4, 4]]),
+    4, 'overlap 1';
+is overlap(map canonical_rect($_), [[-3, -1], [1, 3]], [[-1, -3], [2, 2]]),
+    6, 'overlap 2';
+
+is rectangle_area([[-1,  0], [2, 2]], [[ 0, -1], [4, 4]]), 22, 'Example 1';
+is rectangle_area([[-3, -1], [1, 3]], [[-1, -3], [2, 2]]), 25, 'Example 2';
+
+for (1 .. 25) {
+    my @points = map [-50 + int rand 100, -50 + int rand 100], 1 .. 4;
+    is rectangle_area([@points[0, 1]], [@points[2, 3]]),
+        rectangle_area_naive([@points[0, 1]], [@points[2, 3]]),
+        "same $_";
+}
+
+use Benchmark qw{ cmpthese };
+cmpthese(-3, {
+    fast => 'rectangle_area([[-20, -15], [10, 15]], [[-5, -2], [7, 9]])',
+    naive => 'rectangle_area_naive([[-20, -15], [10, 15]], [[-5, -2], [7, 9]])',
+});
+
+__END__
+
+          Rate naive  fast
+naive   2625/s    --  -98%
+fast  121457/s 4527%    --