diff options
| -rwxr-xr-x | challenge-187/jo-37/perl/ch-1.pl | 123 | ||||
| -rwxr-xr-x | challenge-187/jo-37/perl/ch-2.pl | 83 |
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; +} |