RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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.

Solution

use v5.36;
use strict;
use warnings;

use Time::Piece;
use Time::Seconds;

sub days_together{
    my($together) = @_;
    my $days_together = 0;
    my($start, $end);
    my $foo_start = Time::Piece->strptime($together->{Foo}->{SD}, q/%d-%m/);
    my $bar_start = Time::Piece->strptime($together->{Bar}->{SD}, q/%d-%m/);
    my $foo_end = Time::Piece->strptime($together->{Foo}->{ED}, q/%d-%m/);
    my $bar_end = Time::Piece->strptime($together->{Bar}->{ED}, q/%d-%m/);
    $start = $foo_start;
    $start = $bar_start if $bar_start > $foo_start;
    $end = $foo_end;
    $end = $bar_end if $bar_end < $foo_end;
    {
        $days_together++ if $start <= $end;
        $start += ONE_DAY;
        redo if $start <= $end;
    }
    return $days_together;
}


MAIN:{
    my $days;
    $days = days_together({Foo => {SD => q/12-01/, ED => q/20-01/},
                           Bar => {SD => q/15-01/, ED => q/18-01/}});
    say $days;
    $days = days_together({Foo => {SD => q/02-03/, ED => q/12-03/},
                           Bar => {SD => q/13-03/, ED => q/14-03/}});
    say $days;
    $days = days_together({Foo => {SD => q/02-03/, ED => q/12-03/},
                           Bar => {SD => q/11-03/, ED => q/15-03/}});
    say $days;
    $days = days_together({Foo => {SD => q/30-03/, ED => q/05-04/},
                           Bar => {SD => q/28-03/, ED => q/02-04/}});
    say $days;        
}

Sample Run

$ perl perl/ch-1.pl
4
0
2
4

Notes

Time:Piece makes this easy, once we figure out the logic. The start date should be the later of the two start dates since clearly there can be no overlap until the second person shows up. Similarly the end date should be the earlier of the two dates since once one person leaves their time together is over. By converting the dates to Time::Piece objects the comparisons are straightforward.

Now, once the dates are converted to Time::Piece objects and the start and end dates determined we could also use Time::Piece arithmetic to subtract one from the other and pretty much be done. However, since that might be a little too boring I instead iterate and count the number of days in a redo loop!

Part 2

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 a set of rules.

Solution

use v5.36;
use strict;
use warnings;

use Hash::MultiKey;
use Math::Combinatorics;

sub magical_triples{
    my(@numbers) = @_;
    my %triple_sum;
    tie %triple_sum, q/Hash::MultiKey/;
    my $combinations = Math::Combinatorics->new(count => 3, data => [@numbers]);
    my($s, $t, $u);
    while(my @combination = $combinations->next_combination()){
        my($s, $t, $u) = @combination;
        my $sum;
        $sum = $s + $t + $u if $s + $t > $u && $t + $u > $s && $s + $u > $t;
        $triple_sum{[$s, $t, $u]} = $sum if $sum;
    }
    my @triples_sorted = sort {$triple_sum{$b} <=> $triple_sum{$a}} keys %triple_sum; 
    return ($triples_sorted[0]->[0], $triples_sorted[0]->[1], $triples_sorted[0]->[2]) if @triples_sorted;
    return ();
}

MAIN:{
    say "(" . join(", ", magical_triples(1, 2, 3, 2)) . ")";
    say "(" . join(", ", magical_triples(1, 3, 2)) . ")";
    say "(" . join(", ", magical_triples(1, 1, 2, 3)) . ")";
    say "(" . join(", ", magical_triples(2, 4, 3)) . ")";
}

Sample Run

$ perl perl/ch-2.pl
(2, 3, 2)
()
()
(4, 3, 2)

Notes

The "magical" rules, if not clear from the above code are:

• a + b > c

• b + c > a

• a + c > b

• a + b + c is maximum.

To be certain, this problem is an excellent application of constraint programming. Unfortunately I do not know of a good constraint programming library in Perl. If you see my Prolog Solutions for this problem you can see just how straightforward such a solution can be!

Here we find ourselves with a brute force implementation. Math::Combinatorics is a battle tested module when dealing with combinatorics problems in Perl. For all possible selections of three elements of the original list we evaluate the rules and track their sums in a hash. We then sort the hash keys based on the associated values and return the triple which has maximal sum and otherwise passes all the other requirements.

A nice convenient module used here is Hash::MultiKey which allows us to use an array reference as a hash key. In this way we can have immediate access to the triples when needed.

References

Challenge 187