RabbitFarm

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

Part 1

You are given a list of integers, @list. Write a script to find the total count of Good airs.

Solution

good_pair(Numbers, Pair):-
    length(Numbers, L),
    fd_domain(I, 1, L),
    fd_domain(J, 1, L),
    I #<# J,
    fd_labeling([I, J]), 
    fd_element(I, Numbers, Ith),  
    fd_element(J, Numbers, Jth), 
    Ith #= Jth,
    Pair = [I, J].   

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- good_pair([1, 2, 3, 1, 1, 3], Pair).

Pair = [1,4] ? a

Pair = [1,5]

Pair = [3,6]

Pair = [4,5]

no
| ?- good_pair([1, 2, 3], Pair).         

no
| ?- good_pair([1, 1, 1, 1], Pair).

Pair = [1,2] ? a

Pair = [1,3]

Pair = [1,4]

Pair = [2,3]

Pair = [2,4]

Pair = [3,4]

yes
| ?- 

Notes

I take a clpfd approach to this problem and the next. This allows a pretty concise solution. Here we get the length of the list of numbers, constrain the indices for the pair and then specify the additional conditions of a Good Pair.

Part 2

You are given an array of integers, @array and three integers $x,$y,$z. Write a script to find out total Good Triplets in the given array.

Solution

good_triplet(Numbers, X, Y, Z, Triplet):-
    length(Numbers, I),
    fd_domain(S, 1, I),
    fd_domain(T, 1, I),
    fd_domain(U, 1, I),
    S #<# T, T #<# U,   
    fd_labeling([S, T, U]),   
    fd_element(S, Numbers, Sth),  
    fd_element(T, Numbers, Tth),  
    fd_element(U, Numbers, Uth), 
    Ast is abs(Sth - Tth), Ast #=<# X,     
    Atu is abs(Tth - Uth), Atu #=<# Y,     
    Asu is abs(Sth - Uth), Asu #=<# Z, 
    Triplet = [Sth, Tth, Uth].   

Sample Run

$ gprolog --consult-file prolog/ch-2.p
| ?- good_triplet([3, 0, 1, 1, 9, 7], 7, 2, 3, Triplet).

Triplet = [3,0,1] ? a

Triplet = [3,0,1]

Triplet = [3,1,1]

Triplet = [0,1,1]

no
| ?- good_triplet([1, 1, 2, 2, 3], 0, 0, 1, Triplet).   

no
| ?-

Notes

Again for part 2 a clpfd solution ends up being fairly concise. In fact, the approach here is virtually identical to part 1. The differences are only that we are looking for a triple, not a pair, and slightly different criteria.

References

Challenge 199

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

Part 1

You are given a list of integers, @list. Write a script to find the total count of Good airs.

Solution

use v5.36;
sub good_pairs{
    my(@numbers) = @_;
    my @pairs;  
    do{ 
        my $i = $_;
        do{
            my $j = $_;
            push @pairs, [$i, $j] if $numbers[$i] == $numbers[$j] && $i < $j;  
        } for 0 .. @numbers - 1;
    } for 0 .. @numbers - 1;
    return 0 + @pairs;  
}

MAIN:{
    say good_pairs 1, 2, 3, 1, 1, 3;
    say good_pairs 1, 2, 3;
    say good_pairs 1, 1, 1, 1;
}

Sample Run

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

Notes

First off, a pair (i, j) is called good if list[i] == list[j] and i < j. Secondly, I have never written a nested loop with this mix of do blocks and postfix for, and I am greatly entertained by it! Perl fans will know that it really isn't all that different from the more standard looking do/while construct. A do block is not really a loop, although it can be repeated, and so you cannot use last, redo, or next within the block. But this is exactly the same case as within a map, which is what we are trying to replicate here, a map in void context without actually using map.

Imagine a nested map, that is basically the same thing as this, but with the more clear focus on side effects versus a return value.

Part 2

You are given an array of integers, @array and three integers $x,$y,$z. Write a script to find out total Good Triplets in the given array.

Solution

use v5.36;
use Math::Combinatorics;
sub good_triplets{
    my($numbers, $x, $y, $z) = @_;
    my $combinations = Math::Combinatorics->new(count => 3, data => [0 .. @{$numbers} - 1]);
    my @combination = $combinations->next_combination;  
    my @good_triplets;
    {
        my($s, $t, $u) = @combination;
        unless($s >= $t || $t >= $u || $s >= $u){
            push @good_triplets, [@{$numbers}[$s, $t, $u]] if(abs($numbers->[$s] - $numbers->[$t]) <= $x && 
                                                              abs($numbers->[$t] - $numbers->[$u]) <= $y &&  
                                                              abs($numbers->[$s] - $numbers->[$u]) <= $z);  

    }
        @combination = $combinations->next_combination;  
        redo if @combination;
    }
    return 0 + @good_triplets;
}

MAIN:{
    say good_triplets([3, 0, 1, 1, 9, 7], 7, 2, 3);
    say good_triplets([1, 1, 2, 2, 3], 0, 0, 1);
}

Sample Run

$ perl perl/ch-2.pl
4
0

Notes

The approach here is the same that I used for the Magical Triples problem from TWC 187. The module Math::Combinatorics is used to generate all possible triples of indices. These are then filtered according to the criteria for good triplets.

References

Challenge 199