From cb50e1a036fbf8c332c8c18cbf6b3468ac197be3 Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Wed, 16 Feb 2022 07:57:57 +0100 Subject: Solution to task 1 --- challenge-152/jo-37/perl/ch-1.pl | 63 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100755 challenge-152/jo-37/perl/ch-1.pl diff --git a/challenge-152/jo-37/perl/ch-1.pl b/challenge-152/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..126abe6f47 --- /dev/null +++ b/challenge-152/jo-37/perl/ch-1.pl @@ -0,0 +1,63 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use Math::Prime::Util qw(vecmin vecsum); + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die < Date: Wed, 16 Feb 2022 16:07:25 +0100 Subject: Solution to task 2 --- challenge-152/jo-37/perl/ch-2.pl | 131 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100755 challenge-152/jo-37/perl/ch-2.pl diff --git a/challenge-152/jo-37/perl/ch-2.pl b/challenge-152/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..4dfd6ae6af --- /dev/null +++ b/challenge-152/jo-37/perl/ch-2.pl @@ -0,0 +1,131 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use List::AllUtils qw(reduce pairmap any); +use Syntax::Keyword::Gather; +use experimental qw(signatures postderef); + +our ($tests, $examples, $verbose); + +run_tests() if $tests || $examples; # does not return + +die <[1] * any {$_->($b->[0]->@*)} @chi} 0, @$subrect; +} + +# Generate the characteristic function for a rectangle with given bottom +# left and top right vertices. +sub gen_chi ($bl, $tr) { + sub ($x, $y) { + $bl->[0] <= $x && + $x <= $tr->[0] && + $bl->[1] <= $y && + $y <= $tr->[1]; + } +} + +# For N given rectangles, record center coordinates and area for all +# subrectangles build from the rectangles' coordinate grid. +sub subrect (@vertices) { + my @x = sort {$a <=> $b} map $_->[0], @vertices; + my @y = sort {$a <=> $b} map $_->[1], @vertices; + + gather { + for (my $ix = 0; $ix < $#x; $ix++) { + my $dx = $x[$ix + 1] - $x[$ix]; + for (my $iy = 0; $iy < $#y; $iy++) { + my $dy = $y[$iy + 1] - $y[$iy]; + take [[$x[$ix] + $dx / 2, $y[$iy] + $dy / 2], + $dx * $dy]; + } + } + } +} + + +### Examples and tests + +# Example 1: +# Original rectangles in bold lines within the surrounding rectangle and +# the product of the subrectangle's area and the OR'ed characteristic +# functions inside the subrectangle. +# +# 4 ┌───┲━━━━━━━┯━━━━━━━┓ +# │ ┃ │ ┃ +# 3 │ 0 ┃ 4 │ 4 ┃ +# │ ┃ │ ┃ +# 2 ┢━━━╋━━━━━━━╅───────┨ +# ┃ ┃ ┃ ┃ +# 1 ┃ 2 ┃ 4 ┃ 4 ┃ +# ┃ ┃ ┃ ┃ +# 0 ┡━━━╋━━━━━━━╃───────┨ +# │ 0 ┃ 2 │ 2 ┃ +# -1└───┺━━━━━━━┷━━━━━━━┛ +# -1 0 1 2 3 4 + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + 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'; + } + + SKIP: { + skip "tests" unless $tests; + is rectangle_area([0, 0], [1, 1], [1, 1], [2, 2], [2, 2], [3, 3], + [2, 2], [4, 4]), 6, 'four squares'; + is rectangle_area([0, 0], [1, 1], [1, 0], [2, 1]), 2, + 'some empty subrectangles'; + } + + done_testing; + exit; +} -- cgit