Perl Weekly Challenge: Week 187

Challenge 1:

Days Together

Two friends, Foo and Bar gone on holidays seperately to the same city. You are given their schedule i.e. start date and end date.

To keep the task simple, the date is in the form DD-MM and all dates belong to the same calendar year i.e. between 01-01 and 31-12. Also the year is non-leap year and both dates are inclusive.

Write a script to find out for the given schedule, how many days they spent together in the city, if at all.

Example 1
Input: Foo => SD: '12-01' ED: '20-01'
    Bar => SD: '15-01' ED: '18-01'

Output: 4 days
Example 2
Input: Foo => SD: '02-03' ED: '12-03'
    Bar => SD: '13-03' ED: '14-03'

Output: 0 day
Example 3
Input: Foo => SD: '02-03' ED: '12-03'
    Bar => SD: '11-03' ED: '15-03'

Output: 2 days
Example 4
Input: Foo => SD: '30-03' ED: '05-04'
    Bar => SD: '28-03' ED: '02-04'

Output: 4 days

The spec makes things easy for us by removing the need to deal with overlapping and leap years and other fiddly bits that make Calendrical calculations so cumbersome. My code takes the four start and end dates for foo and bar on the command line and the first thing I do is to convert them into days from the start of the year.

    my ($fooStartDay, $fooEndDay, $barStartDay, $barEndDay) =
        map { dateToDays($_); }, 
        ($fooStartDate, $fooEndDate, $barStartDate, $barEndDate);

dateToDays() is the function shown below. @monthFirst is probably a poor choice of name. It is in fact the day of the year previous to the first of the month. The incoming date is split up into a day and month and the appropriate entry from @monthFirst (minus 1 because while the months are numbered 1 - 12, the array goes from 0 - 11.) is retrieved and the day is added to it. The end result is a number from 0 (January 1st) to 364 (December 31st).

sub dateToDays($date) {
    constant @monthFirst = (-1, 30, 58, 89, 120, 150, 181, 212, 242, 273, 303, 333);
    my ($day, $month) = split '-', $date;

    return @monthFirst[$month - 1] + $day;
}

A small optimization we can make is that if foo's holiday ends before bar's starts or foo's holiday starts after bar's ends, there is no overlap so we can print "0 days" without the need for further calculations.

    if ($fooEndDay < $barStartDay || $fooStartDay > $barEndDay) {
        say "0 days";

Otherwise we need to find the beginning and end of the overlap period. If foo's start day is before bar's start day, the overlap begins from bar's start day otherwise it is foo's. Similarly, if foo's end day is before bar's end day, the overlap end's on foo's end day otherwise on bar's. Finally we have to add 1 because, as the spec says, the dates are inclusive.

    } else {
        my $commonStart =
            $fooStartDay < $barStartDay ?? $barStartDay !! $fooStartDay;
        my $commonEnd = $fooEndDay < $barEndDay ?? $fooEndDay !! $barEndDay;
        my $common = $commonEnd - $commonStart + 1;

As I have mentioned before, a pet peeve of mine is programs that print "1 days" so I check if the result is 1 and adjust the output accordingly.

        say "$common day", ($common == 1 ?? q{} !! 's');
    }
}

(Full code on Github.)

This is the equivalent Perl code.

sub dateToDays {
    my ($date) = @_;
    my @monthFirst = (-1, 30, 58, 89, 120, 150, 181, 212, 242, 273, 303, 333);
    my ($day, $month) = split '-', $date;

    return $monthFirst[$month - 1] + $day;
}

my ($fooStartDate, $fooEndDate, $barStartDate, $barEndDate) = @ARGV;

my ($fooStartDay, $fooEndDay, $barStartDay, $barEndDay) =
    map { dateToDays($_); }
    ($fooStartDate, $fooEndDate, $barStartDate, $barEndDate);

if ($fooEndDay < $barStartDay || $fooStartDay > $barEndDay) {
    say "0 days";
} else {
    my $commonStart = $fooStartDay < $barStartDay ? $barStartDay : $fooStartDay;
    my $commonEnd = $fooEndDay < $barEndDay ? $fooEndDay : $barEndDay;
    my $common = $commonEnd - $commonStart + 1;

    say "$common day", ($common == 1 ? q{} : 's');
}

(Full code on Github.)

Challenge 2:

Magical Triplets

You are given a list of positive numbers, @n, having at least 3 numbers.

Write a script to find the triplets (a, b, c) from the given list that satisfies the following rules.

1. a + b > c
2. b + c > a
3. a + c > b
4. a + b + c is maximum.

In case, you end up with more than one triplets having the maximum then pick the triplet where a >= b >= c.

Example 1
Input: @n = (1, 2, 3, 2);
Output: (3, 2, 2)
Example 2
Input: @n = (1, 3, 2);
Output: ()
Example 3
Input: @n = (1, 1, 2, 3);
Output: ()
Example 4
Input: @n = (2, 4, 3);
Output: (4, 3, 2)

I began my Raku version by declaring two variables. $maximum will hold the current highest sum amongst triplets. It is initially set to the smallest possible number, negative infinity. @maxima will hold the triplet itself; or themselves because as the spec suggests, there may be more than one triplet with the same sum.

my $maximum = -Inf;
my @maxima;

Raku's List class has a .combinations() method that would seem to be what we need to get all triplets but unfortunately it only returns combinations with unique values and the examples show numbers can be repeated. So instead I used the related .permutations() method and took the first three values of each permutation. (.unique() in hindsight didn't add anything and could have been omitted.)

for @n.permutations.map({ @$_[0 .. 2]; }).unique -> $combo {

The members of each triplet are assigned to the variables $a, $b and $c for easy comprehension.

    my ($a, $b, $c) = @$combo;

Then the first three conditions in the spec are tested.

    if ($a + $b > $c) && ($b + $c > $a) && ($a + $c > $b) {

If the triplet passes and its' sum is higher than $maximum, @maxima is reset.

        if ($a + $b + $c) > $maximum {
            @maxima = ();
        }

If its' sum is higher or equal to $maximum, $maximum is set to the new value and the triplet is added to @maxima. Doing it this way allows for the situation where two triplets have the same sum.

        if ($a + $b + $c) >= $maximum {
            $maximum = $a + $b + $c;
            @maxima.push(($a, $b, $c));
        }
    }
}

If after looking through all the candidates, @maxima does not contain any magic triplets we can print () and finish.

if @maxima.elems == 0 {
    say '()';
} else {

If @maxima has more than one element, we sort them in order of a >= b >= c as the spec says.

    if @maxima.elems > 1 {
        @maxima = @maxima.grep({ @$_[0] >= @$_[1] && @$_[1] >= @$_[2]; });
    }

In any case, we print the first triplet in @maxima.

    say @maxima[0];
}

(Full code on Github.)

This is the Perl version. It uses the permute() function I have used in previous challenges. Other than that it works the same as the Raku version.

my $maximum = -Inf;
my @maxima;
my @perms;

permute { push @perms, \@_; } @n;

for my $combo (map { [@$_[0..2] ]; } @perms) {
    my ($a, $b, $c) = @{$combo};
    if (($a + $b > $c) && ($b + $c > $a) && ($a + $c > $b)) {
        if (($a + $b + $c) > $maximum) {
            @maxima = ();
        }
        if (($a + $b + $c) >= $maximum) {
            $maximum = $a + $b + $c;
            push @maxima, [$a, $b, $c];
        }
    }
}

if (scalar @maxima == 0) {
    say '()';
} else {
    if (scalar @maxima > 1) {
        @maxima = grep{ $_->[0] >= $_->[1] && $_->[1] >= $_->[2]; } @maxima;
    }
    say q{(}, (join q{, }, @{$maxima[0]}), q{)};
}

(Full code on Github.)