From 4ac8c31653428ddd155466e2886285e0f6fd86d3 Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 23 Aug 2021 15:01:46 +0200 Subject: Solution to task 1 --- challenge-127/jo-37/perl/ch-1.pl | 117 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 117 insertions(+) create mode 100755 challenge-127/jo-37/perl/ch-1.pl diff --git a/challenge-127/jo-37/perl/ch-1.pl b/challenge-127/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..af0734a74b --- /dev/null +++ b/challenge-127/jo-37/perl/ch-1.pl @@ -0,0 +1,117 @@ +#!/usr/bin/perl -s + +use v5.16; +use PDL; +use Test2::V0 '!float'; +use experimental qw(signatures postderef); + +our ($tests, $examples, $verbose, $pdl); + +run_tests() if $tests || $examples; # does not return + +die <(@s)]})"; + } else { + say 0 + !$impl->(@s); + } +} + + +### Implementation + +# Not just checking if the two sets are disjoint. Determining the +# actual intersection and providing it on request. + +# The 'delete' function applied to a hash returns a list of the deleted +# values and an 'undef' for every to-be-deleted key that was not +# present. +# Constructing a hash of keys and values equal to the elements of one +# set and then deleting the keys corresponding to the other set results +# in a list of the elements of the intersection plus some 'undef's. +sub intersect_hash ($s1, $s2) { + (\my %s1)->@{@$s1} = @$s1; + grep defined, delete @s1{@$s2}; +} + +# PDL makes it even shorter. +sub intersect_pdl ($s1, $s2) { + intersect(long($s1), long($s2))->list; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + for my $impl (\&intersect_hash, \&intersect_pdl) { + { + my @s1 = (1, 2, 5, 3, 4); + my @s2 = (4, 6, 7, 8, 9); + is [$impl->(\@s1, \@s2)], [4], 'example 1'; + } + { + my @s1 = (1, 3, 5, 7, 9); + my @s2 = (0, 2, 4, 6, 8); + is [$impl->(\@s1, \@s2)], [], 'example 2'; + } + } + } + + SKIP: { + skip "tests" unless $tests; + for my $impl (\&intersect_hash, \&intersect_pdl) { + { + my @s1 = (1, 2, 5, 3, 4); + my @s2 = (5, 3, 2); + is [$impl->(\@s1, \@s2)], + bag { item 2; item 3; item 5; end}, + 'true subset'; + is [$impl->(\@s2, \@s1)], + bag { item 2; item 3; item 5; end}, + 'true subset, swapped'; + } + { + my @s1 = (1, 3, 5, 7, 9); + my @s2 = (2, 4, 6, 9, 7); + is [$impl->(\@s1, \@s2)], + bag {item 7; item 9; end}, + 'multi element intersection'; + is [$impl->(\@s2, \@s1)], + bag {item 7; item 9; end}, + 'multi element intersection, swapped'; + } + } + } + + done_testing; + exit; +} -- cgit From 348f047723b8b5f2afca3e3463d99c289e8a453e Mon Sep 17 00:00:00 2001 From: Jörg Sommrey <28217714+jo-37@users.noreply.github.com> Date: Mon, 23 Aug 2021 21:05:51 +0200 Subject: Solution to task 2 --- challenge-127/jo-37/perl/ch-2.pl | 123 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 123 insertions(+) create mode 100755 challenge-127/jo-37/perl/ch-2.pl diff --git a/challenge-127/jo-37/perl/ch-2.pl b/challenge-127/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..3b3f83612e --- /dev/null +++ b/challenge-127/jo-37/perl/ch-2.pl @@ -0,0 +1,123 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use List::Util 'pairs'; +use List::MoreUtils 'any'; +use experimental 'signatures'; + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die <[0][0] < $_->[1][0] && + $_->[1][0] < $_->[0][1] && + $_->[0][1] < $_->[1][1] && + return 1 for [$i, $k], [$k, $i]; +} + +# Traversing backwards seems to be a bit easier to handle. +sub conflicting_intervals (@intervals) { + my @conflicts; + while (defined (my $i = pop @intervals)) { + unshift @conflicts, $i if any {conflicting($_, $i)} @intervals; + } + @conflicts; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + is [conflicting_intervals([1, 4], [3, 5], [6, 8], [12, 13], [3, 20])], + [[3, 5], [3, 20]], 'example 1'; + is [conflicting_intervals([3, 4], [5, 7], [6, 9], [10, 12], [13, 15])], + [[6, 9]], 'example 2'; + } + + SKIP: { + skip "tests" unless $tests; + + # Let + # [i₀, i₁) ≤ [k₀, k₁) if i₁ ≤ k₀ + # [i₀, i₁) < [k₀, k₁) if i₁ < k₀ etc. + is conflicting([0, 1], [0, 1]), F(), 'i = k'; + is conflicting([0, 1], [1, 2]), F(), 'i ≤ k'; + is conflicting([1, 2], [0, 1]), F(), 'i ≥ k'; + is conflicting([0, 1], [2, 3]), F(), 'i < k'; + is conflicting([2, 3], [0, 1]), F(), 'i > k'; + is conflicting([1, 2], [0, 3]), F(), 'i ⊂ k'; + is conflicting([0, 3], [1, 2]), F(), 'i ⊃ k'; + is conflicting([0, 1], [0, 2]), F(), 'i ⊂ k, i₀ = k₀'; + is conflicting([0, 2], [0, 1]), F(), 'i ⊃ k, i₀ = k₀'; + is conflicting([1, 2], [0, 2]), F(), 'i ⊂ k, i₁ = k₁'; + is conflicting([0, 2], [1, 2]), F(), 'i ⊃ k, i₁ = k₁'; + is conflicting([2, 1], [0, 3]), F(), 'i = ∅'; + is conflicting([0, 3], [2, 1]), F(), 'k = ∅'; + is conflicting([0, 2], [3, 1]), F(), 'k = ∅'; + is conflicting([3, 1], [0, 2]), F(), 'i = ∅'; + is conflicting([3, 2], [0, 1]), F(), 'i = ∅, i > k'; + is conflicting([0, 1], [3, 2]), F(), 'k = ∅, i < k'; + is conflicting([1, 0], [2, 3]), F(), 'i = ∅, i < k'; + is conflicting([2, 3], [1, 0]), F(), 'k = ∅, i > k'; + is conflicting([0, 2], [1, 3]), T(), + 'conflict: i ⊈ k, i ≰ k, i ⊉ k, i ≱ k'; + is conflicting([1, 3], [0, 2]), T(), + 'conflict: i ⊈ k, i ≰ k, i ⊉ k, i ≱ k'; + + is [conflicting_intervals([3, 5], [6, 8], [12, 13], [3, 20])], + [], 'example 1 without the conflicting (1, 4)'; + is [conflicting_intervals([0, 1], [1, 2], [2, 3])], [], + 'lined up'; + is [conflicting_intervals([1, 2], [0, 4])], [], + 'contained'; + is [conflicting_intervals([0, 2], [1, 1])], [], + 'non conflicting empty interval'; + is [conflicting_intervals([1, 1], [0, 2])], [], + 'non conflicting empty interval'; + } + + done_testing; + exit; +} -- cgit