From 7e75637ee74f89864599aca46998ef2ec9f49ca6 Mon Sep 17 00:00:00 2001 From: "E. Choroba" Date: Thu, 25 Feb 2021 18:08:05 +0100 Subject: Add solutions to 101: Pack a Spiral & Origin-containing Triangle --- challenge-101/e-choroba/perl/ch-1.pl | 80 ++++++++++++++++++++++++++++++++++++ challenge-101/e-choroba/perl/ch-2.pl | 38 +++++++++++++++++ 2 files changed, 118 insertions(+) create mode 100755 challenge-101/e-choroba/perl/ch-1.pl create mode 100755 challenge-101/e-choroba/perl/ch-2.pl (limited to 'challenge-101') 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(); -- cgit