Merge pull request #6939 from jo-37/contrib

Solutions to challenge 187

2 files changed, 206 insertions, 0 deletions

diff --git a/challenge-187/jo-37/perl/ch-1.pl b/challenge-187/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..487929bdf0
--- /dev/null
+++ b/challenge-187/jo-37/perl/ch-1.pl
@@ -0,0 +1,123 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use DateTime;
+use List::Util qw(min max);
+use experimental qw(signatures postderef);
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [SCHEDULE]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+SCHEDULE
+    A trip schedule as given in the examples.  Entries have the form
+    <name> => <key1>: '<value1>'...
+    where <name> and <keyN> can be any word and <valueN> is any string
+    not containing a single quote.  There shall be keys 'SD' and 'ED'
+    for every entry with values in the form 'DD-MM' specifying a day and
+    month, e.g.
+    $0 "Foo => SD: '12-01' ED: '20-01'" "Bar => SD: '15-01' ED: '18-01'"
+
+EOS
+
+
+### Input and Output
+
+main: {
+    my $days_together = days_together(parse_schedule(join ' ', @ARGV));
+    printf "%d day%.*s\n", $days_together, $days_together != 1, 's';
+}
+
+
+### Implementation
+
+# Splitting this task into two:
+# 1) Parse a string representing a "schedule" as given in the examples
+#    into a HoH.
+# 2) Find the number of common days that the friends stay together on
+#    their holidays based on the given schedule.
+#
+# Neither the parsing, nor the calculation of the "days together" are
+# restricted to only two traveling friends.
+
+# Parse a string into a HoH: Keys to the outer hash are "words" followed
+# by '=>'. The inner hashes are "word" keys followed by a colon and a
+# singly quoted value.
+sub parse_schedule {
+    local $_ = shift;
+    my %schedule;
+    while (/\G\s*(\w+)\s*=>/g) {
+        my $friend = $1;
+        $schedule{$friend}{$1} = $2 while /\G\s*(\w+):\s*'([^']*)'/gc;
+    }
+    \%schedule;
+}
+
+# Taking the duration between the latest start date and the earliest end
+# date almost gives the requested "days together".  Just need to add one
+# day as both dates are inclusive and turn negative durations to zero. 
+sub days_together ($schedule) {
+    my $common =
+    (min(get_dates($schedule, 'ED')) - max(get_dates($schedule, 'SD')))
+        ->in_units('days');
+
+    ($common >= 0) * ($common + 1);
+}
+
+# Pick values from the inner hash for a given key and create DateTime
+# objects for the given day/month in year 1, which is not a leap year.
+sub get_dates ($schedule, $type) {
+    map {
+        (\my %date)->@{qw(year day month)} = (1, split /-/, $_->{$type});
+        DateTime->new(%date);
+    } values %$schedule;
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is days_together({Foo => {SD => '12-01', ED => '20-01'},
+            Bar => {SD => '15-01', ED => '18-01'}}), 4, 'example 1';
+
+        is days_together({Foo => {SD => '02-03', ED => '12-03'},
+            Bar => {SD => '13-03', ED => '14-03'}}), 0, 'example 2';
+
+        is days_together({Foo => {SD => '02-03', ED => '12-03'},
+            Bar => {SD => '11-03', ED => '15-03'}}), 2, 'example 3';
+
+        is days_together({Foo => {SD => '30-03', ED => '05-04'},
+            Bar => {SD => '28-03', ED => '02-04'}}), 4, 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is days_together({Foo => {SD => '27-02', ED => '01-03'},
+            Bar => {SD => '28-02', ED => '02-03'}}), 2, 'not a leap year';
+
+        is days_together({A => {SD => '01-06', ED => '06-06'},
+                B => {SD => '02-06', ED => '07-06'},
+                C => {SD => '03-06', ED => '08-06'}}), 4, 'three friends';
+    
+        is parse_schedule("A => A1: 'va1' A2: 'va2' B => B1: 'vb1' B2: 'vb2'"),
+            {A => {A1 => 'va1', A2 => 'va2'}, B => {B1 => 'vb1', B2 => 'vb2'}},
+            'parse HoH';
+	}
+
+    done_testing;
+    exit;
+}
diff --git a/challenge-187/jo-37/perl/ch-2.pl b/challenge-187/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..5fccade5bd
--- /dev/null
+++ b/challenge-187/jo-37/perl/ch-2.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -s
+
+use v5.16;
+use Test2::V0;
+use experimental 'signatures';
+
+our ($tests, $examples);
+
+run_tests() if $tests || $examples;	# does not return
+
+die <<EOS unless @ARGV;
+usage: $0 [-examples] [-tests] [N...]
+
+-examples
+    run the examples from the challenge
+ 
+-tests
+    run some tests
+
+N...
+    List of numbers.
+
+EOS
+
+
+### Input and Output
+
+main: {
+    local $" = ', ';
+    say "(@{[mp_triangle(@ARGV)]})";
+}
+
+
+### Implementation
+
+# Demystifying the task: There is no magic in triples satisfying the
+# given inequalities.  These are just edges that form a non-degenerated
+# triangle.  The task may be formulated as finding the triangle having a
+# maximum perimeter from a given set of edges.
+# Note: There is no triangle in any sequence growing at least like a
+# Fibonacci sequence.
+sub mp_triangle {
+    # Sort descending.
+	my @e = sort {$b <=> $a} @_;
+    while () {
+        # There is no triangle, if there is no smallest edge having
+        # a positive length.
+        return () unless ($e[2] // 0) > 0;
+        # If the largest three numbers form a triangle, it has a maximum
+        # perimeter.
+        return @e[0, 1, 2] if $e[0] < $e[1] + $e[2];
+        # If the largest three edges do not form a triangle then there
+        # is no triangle including the largest edge at all.  Drop it.
+        shift @e;
+    }
+}
+
+
+### Examples and tests
+
+sub run_tests {
+    SKIP: {
+        skip "examples" unless $examples;
+
+        is [mp_triangle(1, 2, 3, 2)], [3, 2, 2], 'example 1';
+        is [mp_triangle(1, 3, 2)], [], 'example 2';
+        is [mp_triangle(1, 1, 2, 3)], [], 'example 3';
+        is [mp_triangle(2, 4, 3)], [4, 3, 2], 'example 4';
+    }
+
+    SKIP: {
+        skip "tests" unless $tests;
+
+        is [mp_triangle(1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144)], [], 
+            'no triangle from Fibonacci numbers';
+
+        is [mp_triangle(1, 2, 2, 3, 4, 6, 9, 14, 22, 35)],
+            [35, 22, 14], 'F(N) = F(N-2) + F(N-1) - 1';
+	}
+
+    done_testing;
+    exit;
+}