laurent_r

These are some answers to the Week 187 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Days Together

Two friends, Foo and Bar gone on holidays separately 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

Days Together in Raku

The idea here is to create a yearly calendar mapping dates such as ‘05-04’ to their day number in the year. It is then quite easy to use simple arithmetic subtraction to find the result.

my @m = < 0 31 28 31 30 31 30 31 31 30 31 30 31 >;
my $c = 1;
my %dates = map { $_ => $c++ }, 
            (map { ((1..@m[$_])>>.fmt("%02d-$_")) }, 
            map {.fmt("%02d")}, 1..12).flat;

sub compute-common ($sd1, $ed1, $sd2, $ed2) {
    my $start-common = max %dates{$sd1}, %dates{$sd2};
    my $end-common = min %dates{$ed1}, %dates{$ed2};
    return $end-common - $start-common + 1;
}

for <12-01 20-01 15-01 18-01>, <03-03 12-03 13-03 14-03>,
    <02-03 12-03 11-03 15-03>, <30-03 05-04 28-03 02-04>,
    <12-01 13-03 09-01 25-04>
        -> @input-dates {
    say "Number of days together for dates @input-dates[]: ", compute-common | @input-dates;
}

This program displays the following output:

$ raku ./days-together.raku
Number of days together for dates 12-01 20-01 15-01 18-01: 4
Number of days together for dates 03-03 12-03 13-03 14-03: 0
Number of days together for dates 02-03 12-03 11-03 15-03: 2
Number of days together for dates 30-03 05-04 28-03 02-04: 4
Number of days together for dates 12-01 13-03 09-01 25-04: 61

Days Together in Perl

This is port to Perl of the Raku program above, using the same idea of creating first a yearly calendar to make date computations easy.

use strict;
use warnings;
use feature qw/say/;

my @months = < 0 31 28 31 30 31 30 31 31 30 31 30 31 >;
my @dates;
for my $m (map {sprintf( "%02d", $_ ) } 1..12) {
    push @dates, map {sprintf ( "%02d-$m", $_ )} 1..$months[$m];
}
my $c = 1;
my %d = map { $_ => $c++ } @dates;

sub compute_common {
    my ($sd1, $ed1, $sd2, $ed2) = map $d{$_}, @_;
    my $start_common = $sd1 > $sd2 ? $sd1 : $sd2;
    my $end_common   = $ed1 < $ed2 ? $ed1 : $ed2;
    return $end_common - $start_common + 1;
}

for my $test (
    [<12-01 20-01 15-01 18-01>], [<03-03 12-03 13-03 14-03>],
    [<02-03 12-03 11-03 15-03>], [<30-03 05-04 28-03 02-04>],
    [<12-01 13-03 09-01 25-04>] ) {
        say "Number of days together for dates @$test]: ",
            compute_common @$test;
}

This program displays the following output:

$ perl ./days-together.pl
Number of days together for dates 12-01 20-01 15-01 18-01]: 4
Number of days together for dates 03-03 12-03 13-03 14-03]: 0
Number of days together for dates 02-03 12-03 11-03 15-03]: 2
Number of days together for dates 30-03 05-04 28-03 02-04]: 4
Number of days together for dates 12-01 13-03 09-01 25-04]: 61

Task 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)

In essence, the rules for a triplet to be valid are the same as those to determine whether three segments can form a triangle. But that doesn’t really help solving the problem.

Although the task specification says “to find the triplets”, it appears from the examples that what is required is only one triplet, the “maximum” one, i.e. the one with the maximum sum. To achieve that, I’ll simply sort the input list in descending order so that the the first triplet found will be the “maximum” one. In my humble view, the second rule to find the best triplet doesn’t really make sense (there may be several triplets matching that second rule, and this is what would happen in fact with the first example if the maximum rule did not apply first), so I’ll simply skip it.

Magical Triplets in Raku

The is-valid-triplet subroutine checks that size rules are satisfied. As mentioned above, we start with sorting in descending order the input list to make sure that the first triplet found is the maximum one (we could actually stop the for loop after having found the first triplet but didn’t do it because it would make sense to modify the program at some time in the future to list all valid triplets).

sub is-valid-triplet ($a, $b, $c) {
    return False if $c >= $a + $b;
    return False if $b >= $a + $c;
    return False if $a >= $b + $c;
    return True;
}
for <1 2 3 2>, <1 3 2>, <1 1 2 3>, <2 4 3> -> @test {
    my @valid;
    for @test.sort.reverse.combinations: 3 -> @triplet {
        push @valid, @triplet if is-valid-triplet | @triplet;
    }
    say @test, " => ", @valid.elems > 0 ?? @valid[0] !! "()";
}

This program displays the following output:

$ raku ./magical-triplet.raku
(1 2 3 2) => (3 2 2)
(1 3 2) => ()
(1 1 2 3) => ()
(2 4 3) => (4 3 2)

Magical Triplets in Perl

This is a port to Perl of the Raku program above, and the comments made above also apply here. Since there is no built-in combinations routine in Perl, we roll out our own recursive combine subroutine.

use strict;
use warnings;
use feature qw/say/;

my @result;

sub is_valid_triplet {
    my ($a, $b, $c) = @_;
    return 0 if $c >= $a + $b;
    return 0 if $b >= $a + $c;
    return 0 if $a >= $b + $c;
    return 1;
}

sub combine {
    my @out = @{$_[0]};
    my @in  = @{$_[1]};
    if (@out == 3) {
        push @result, $_[0] if is_valid_triplet @out;
        return;
    }
    for my $i (0..$#in) {
        combine ([ @out, $in[$i] ], [ @in[$i+1..$#in] ]);
    }
}

for my $test ( [<1 2 3 2>], [<1 3 2>], [<1 1 2 3>], [<2 4 3> ]) {    
    @result = ();
    combine ([], [ sort { $b <=> $a } @$test]);
    say "@$test => ", @result > 0 ? "@{$result[0]}" : "()";
}

This program displays the following output:

$ perl ./magical-triplet.pl
1 2 3 2 => 3 2 2
1 3 2 => ()
1 1 2 3 => ()
2 4 3 => 4 3 2

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on October 30, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.