« Perl Weekly Challenge 186. Perl Weekly Challenge 188. »

Perl Weekly Challenge 187.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 187.

Task 1: Days Together

Submitted by: Mohammad S Anwar
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

Using the simplifications allowed by the task statement, I make a routine to convert from dates to 0-based day of the year. Then I subtract the smallest of the ending dates from the largest of the starting dates. If negative, there is no overlap. Otherwise, it is the off-by-one answer. This yelds the 2-liner

perl -MList::Util=sum,max,min -E '
@m=qw(31 28 31 30 31 30 31 31 30 31 30); sub d($x){($d,$m)=split "-", $x; $d-1+sum @m[(0..$m-2)]}
$d=min(map {d($ARGV[$_])}(1,3))-max(map {d($ARGV[$_])}(0,2)); say $d<0?0:$d+1
' 12-01 20-01 15-01 18-01

perl -MList::Util=sum,max,min -E '
@m=qw(31 28 31 30 31 30 31 31 30 31 30); sub d($x){($d,$m)=split "-", $x; $d-1+sum @m[(0..$m-2)]}
$d=min(map {d($ARGV[$_])}(1,3))-max(map {d($ARGV[$_])}(0,2)); say $d<0?0:$d+1
' 02-03 12-03 13-03 14-03

perl -MList::Util=sum,max,min -E '
@m=qw(31 28 31 30 31 30 31 31 30 31 30); sub d($x){($d,$m)=split "-", $x; $d-1+sum @m[(0..$m-2)]}
$d=min(map {d($ARGV[$_])}(1,3))-max(map {d($ARGV[$_])}(0,2)); say $d<0?0:$d+1
' 02-03 12-03 11-03 15-03

perl -MList::Util=sum,max,min -E '
@m=qw(31 28 31 30 31 30 31 31 30 31 30); sub d($x){($d,$m)=split "-", $x; $d-1+sum @m[(0..$m-2)]}
$d=min(map {d($ARGV[$_])}(1,3))-max(map {d($ARGV[$_])}(0,2)); say $d<0?0:$d+1
' 30-03 05-04 28-03 02-04

Results:

The full code is similar. I just add a few tests. A better code would use the package DateTime and friends, to allow for dates in different years and for leap years.

# Perl weekly challenge 187
# Task 1:  Days Together
#
# See https://wlmb.github.io/2022/10/17/PWC187/#task-1-days-together
use v5.36;
use List::Util qw(sum max min);
sub ddmm2days($x){
    state @month_lengths=qw(31 28 31 30 31 30 31 31 30 31 30 31);
    die "Wrong format: $x" unless $x=~/(\d\d)-(\d\d)/;
    my ($d,$m)=($1, $2);
    die "Wrong month: $m" unless 1<=$m<=12;
    die "Wrong day: $d. Only $month_lengths[$m-1] days in month $m"
        unless 1<=$d<=$month_lengths[$m-1];
    $d-1+sum @month_lengths[(0..$m-2)]
}
die <<"FIN" unless @ARGV==4;
Usage: $0 fs fe bs be
to obtain the number of days Foo and Bar are together,
where fs and fe are the start and end dates of Foo's holidays and
bs and be are the start and end dates of Bar's holidays. Dates are in the
format DD-MM.
FIN
my ($foo_start, $foo_end, $bar_start, $bar_end)=@ARGV;
my $days=  min(map {ddmm2days($_)} ($foo_end, $bar_end))
      - max(map {ddmm2days($_)}($foo_start, $bar_start));
$days=$days<0?0:1+$days;
say "Overlap between intervals ($foo_start, $foo_end) and ($bar_start, $bar_end) is $days days";

Examples:

./ch-1.pl 12-01 20-01 15-01 18-01
./ch-1.pl 02-03 12-03 13-03 14-03
./ch-1.pl 02-03 12-03 11-03 15-03
./ch-1.pl 30-03 05-04 28-03 02-04

Results:

Overlap between intervals (12-01, 20-01) and (15-01, 18-01) is 4 days
Overlap between intervals (02-03, 12-03) and (13-03, 14-03) is 0 days
Overlap between intervals (02-03, 12-03) and (11-03, 15-03) is 2 days
Overlap between intervals (30-03, 05-04) and (28-03, 02-04) is 4 days

Task 2: Magical Triplets

Submitted by: Mohammad S Anwar
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 first sort the list in descending order. Then I use combinations from Algorithm::Combinatorics to produce all triplets (a,b,c). I choose the first (if any) that obeys b+c>a assuming that combinations returns combinations in order. As a>=b>=c, and all numbers are positive, this guarantees that a+b>c and a+c>b. The code fits a oneliner:

perl -MAlgorithm::Combinatorics=combinations -MList::Util=first -E '
@n=sort {$b<=>$a} @ARGV; say join " ", @$_ for first {$_->[1]+$_->[2]>$_->[0]} combinations(\@n, 3)
' 1 2 3 2

Results:

3 2 2

perl -MAlgorithm::Combinatorics=combinations -MList::Util=first -E '
@n=sort {$b<=>$a} @ARGV; say join " ", @$_ for first {$_->[1]+$_->[2]>$_->[0]} combinations(\@n, 3)
' 1 3 2

Results:

perl -MAlgorithm::Combinatorics=combinations -MList::Util=first -E '
@n=sort {$b<=>$a} @ARGV; say join " ", @$_ for first {$_->[1]+$_->[2]>$_->[0]} combinations(\@n, 3)
' 4 3 2

Results:

4 3 2

I add a few checks to the full code. I use an iterator to avoid needlesly producing all triplets.

# Perl weekly challenge 187
# Task 2:  Magical Triplets
#
# See https://wlmb.github.io/2022/10/17/PWC187/#task-2-magical-triplets
use v5.36;
use Algorithm::Combinatorics qw(combinations);
use List::Util qw(first);
die <<FIN unless @ARGV;
Usage: $0 N1 N2 N3 [N4...]
to find the maximum ordered triplet with elements from {N1, N2...} that obeys
the strict triangle inequalities.
FIN
my @set = sort {$b<=>$a} @ARGV;
die "All numbers should be positive" unless $set[-1]>0;
my $iterator=combinations(\@set, 3);
while(my $triplet=$iterator->next){
    die "Expected ordered triplet: $triplet" # Currently uneeded
        unless $triplet->[0]>=$triplet->[1]>=$triplet->[2];
    next unless $triplet->[1]+$triplet->[2]>$triplet->[0];
    say "Input: (", join(", ", @ARGV), ") Output: (", join(", ", @$triplet), ")";
    exit;
}
say "Input: (", join(", ", @ARGV), ") Output: ()";

Examples:

./ch-2.pl 1 2 3 2
./ch-2.pl 1 3 2
./ch-2.pl 1 1 2 3
./ch-2.pl 2 4 3
#+end_example

Results:

Input: (1, 2, 3, 2) Output: (3, 2, 2)
Input: (1, 3, 2) Output: ()
Input: (1, 1, 2, 3) Output: ()
Input: (2, 4, 3) Output: (4, 3, 2)

Written on October 17, 2022