Add solutions to 101: Pack a Spiral & Origin-containing Triangle

2 files changed, 118 insertions, 0 deletions

diff --git a/challenge-101/e-choroba/perl/ch-1.pl b/challenge-101/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..3e9b9b1cae
--- /dev/null
+++ b/challenge-101/e-choroba/perl/ch-1.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+my @DIRECTIONS = ([1, 0], [0, -1], [-1, 0], [0, 1]);
+sub pack_spiral {
+    my (@arr) = @_;
+
+    my $w = int sqrt @arr;
+    $w++ while @arr % $w;
+    my $h = @arr / $w;
+
+    my @spiral = map [], 1 .. $h;
+    my $direction = 0;
+    my ($x, $y) = (0, $h - 1);
+
+    my @borders = ($h - 1, $w - 1, 0, 0);
+    my $turned;
+    for my $element (@arr) {
+        $spiral[$y][$x] = $element;
+
+        my $new_x = $x + $DIRECTIONS[$direction][0];
+        my $new_y = $y + $DIRECTIONS[$direction][1];
+        if ($new_x < $borders[3] || $new_x > $borders[1]
+            || $new_y < $borders[2] || $new_y > $borders[0]
+        ) {
+            last if $turned;
+
+            $borders[$direction] += (-1, -1, 1, 1)[$direction];
+            $direction = ($direction + 1) % 4;
+            $turned = 1;
+            redo
+        }
+        undef $turned;
+        ($x, $y) = ($new_x, $new_y);
+    }
+    return \@spiral
+}
+
+use Test::More tests => 6;
+
+is_deeply pack_spiral(1 .. 4),
+    [[4, 3],
+     [1, 2]],
+    'Example 1';
+
+is_deeply pack_spiral(1 .. 6),
+    [[5, 4],
+     [6, 3],
+     [1, 2]],
+    'Example 2';
+
+is_deeply pack_spiral(1 .. 12),
+    [[ 8,  7, 6],
+     [ 9, 12, 5],
+     [10, 11, 4],
+     [ 1,  2, 3]],
+    'Example 3';
+
+is_deeply pack_spiral(11 .. 30),
+    [[21, 20, 19, 18],
+     [22, 29, 28, 17],
+     [23, 30, 27, 16],
+     [24, 25, 26, 15],
+     [11, 12, 13, 14]],
+    '20=4x5';
+
+is_deeply pack_spiral(10 .. 49),
+    [[28, 27, 26, 25, 24, 23, 22, 21],
+     [29, 44, 43, 42, 41, 40, 39, 20],
+     [30, 45, 46, 47, 48, 49, 38, 19],
+     [31, 32, 33, 34, 35, 36, 37, 18],
+     [10, 11, 12, 13, 14, 15, 16, 17]],
+    '40=8x5';
+
+is_deeply pack_spiral(10 .. 36),
+    [[28, 27, 26, 25, 24, 23, 22, 21, 20],
+     [29, 30, 31, 32, 33, 34, 35, 36, 19],
+     [10, 11, 12, 13, 14, 15, 16, 17, 18]],
+    '27=9x3';
diff --git a/challenge-101/e-choroba/perl/ch-2.pl b/challenge-101/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..71bae121bc
--- /dev/null
+++ b/challenge-101/e-choroba/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use constant THRESHOLD => 1e-10;
+
+sub area {
+    my ($A, $B, $C) = @_;
+    return abs((  $B->[0] - $A->[0]) * ($C->[1] - $A->[1])
+               - ($C->[0] - $A->[0]) * ($B->[1] - $A->[1])) / 2
+}
+
+my $Z = [0, 0];
+sub origin_containing_trianlge {
+    my ($A, $B, $C) = @_;
+
+    my $whole = area($A, $B, $C);
+    my ($a1) = area($A, $B, $Z);
+    my ($a2) = area($B, $C, $Z);
+    my ($a3) = area($A, $C, $Z);
+    my $sum = $a1 + $a2 + $a3;
+
+    return abs($sum - $whole) < THRESHOLD ? 1 : 0
+}
+
+use Test::More;
+is origin_containing_trianlge([0, 1], [1, 0], [2, 2]), 0, 'Example 1';
+is origin_containing_trianlge([1, 1], [-1, 1], [0, -3]), 1, 'Example 2';
+is origin_containing_trianlge([0, 1], [2, 0], [-6, 0]), 1, 'Example 3';
+
+is origin_containing_trianlge([1, 1], [3, 7], [0, 0]), 1, 'Vertex at 0, 0';
+is origin_containing_trianlge([-2, -1], [0, 4], [5, 3]), 0, 'outside';
+is origin_containing_trianlge([-2, -1], [0, 4], [5, 2]), 1, 'inside';
+is origin_containing_trianlge([12, 3], [-10, -10], [6, 6]), 1, 'borderline';
+is origin_containing_trianlge([-10, -10], [5.999, 6], [12, 3]), 1, 'closely in';
+is origin_containing_trianlge([-10, -10], [6.001, 6], [12, 3]), 0, 'closely out';
+
+done_testing();