# RabbitFarm

### 2022-10-23

The Weekly Challenge 187 (Prolog Solutions)

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

## 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

```
magical_triple_sum(Numbers, Triple, TripleSum):-
sublist([A, B, C], Numbers),
A + B > C,
B + C > A,
A + C > B,
Triple = [A, B, C],
sum_list(Triple, TripleSum).
magical_triple(Numbers, Triple):-
fd_maximize(magical_triple_sum(Numbers, Triple, TripleSum), TripleSum).
```

### Sample Run

```
$ gprolog --consult-file prolog/ch-2.p
| ?- magical_triple([4, 2, 3], Triple).
Triple = [4,2,3] ?
(1 ms) yes
| ?- magical_triple([1, 3, 2], Triple).
no
| ?- magical_triple([1, 1, 3, 2], Triple).
no
| ?- magical_triple([1, 2, 3, 2], Triple).
Triple = [2,3,2] ?
yes
```

### 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.

I don't routinely do a lot of constraint programming, but I don't think a smaller solution for this can be written! Indeed, the code here is largely a rewriting of the given rules in slightly modified Prolog form.

## References

posted at: 17:25 by: Adam Russell | path: /prolog | permanent link to this entry

#### Days Together Are Magical

*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

posted at: 17:11 by: Adam Russell | path: /perl | permanent link to this entry