Perl Weekly Challenge 051

ch-1.pl

use strict;
use warnings;
##
# Given an array @L of integers. Write a script 
# to find all unique triplets such that a + b + c is 
# the same as the given target T. Also make sure a <= b <= c.
##
use AI::Prolog;
use constant TARGET => 0; 
use constant NUMBERS => "-25, -10, -7, -3, 2, 4, 8, 10"; 
my $prolog = do{
    local $/;
    <DATA>;
}; 
my $numbers = NUMBERS; 
$prolog =~ s/NUMBER_LIST/$numbers/; 
$prolog = new AI::Prolog($prolog); 
$prolog->query("unique_triplets(X, Y, Z, " . TARGET . ").");
my $result = $prolog->results;
my($x, $y, $z) = @{$result}[1 .. @{$result} - 1];
print "X: $x\nY: $y\nZ: $z\n";

__DATA__
member(X,[X|T]).
member(X,[H|T]) :- member(X,T).
numbers([NUMBER_LIST]).
unique_triplets(X, Y, Z, T) :-
    numbers(L), 
    member(X, L),
    member(Y, L),
    member(Z, L),
    X <= Y,
    Y <= Z,
    X <= Z,
    T is X + Y + Z.

ch-2.pl

use strict;
use warnings;
##
# Write a script to display all Colorful Numbers with 3 digits.
# A number can be declared a "Colorful Number" when
# all the products of consecutive subsets of the digits
# are different.
##
use AI::Prolog;
MAIN:{
    my $prolog = do{
        local $/;
        <DATA>;
    };
    $prolog = new AI::Prolog($prolog);
    for my $n (100..999){
        my($x, $y, $z) = split(//, $n);
        $prolog->query("colorful($x, $y, $z).");
        my $result = $prolog->results;
        if($result){ 
            print "$n: colorful number\n";
        }
        else{
            print "$n: not a colorful number\n";
        }
    }
}

__DATA__
colorful(X, Y, Z) :-
    A is X * Y, 
    B is Y * Z, 
    C is X * Y * Z, 
    X \= Y,  
    Y \= Z,  
    X \= Z, 
    X \= A,   
    X \= B,   
    X \= C,
    Y \= A,   
    Y \= B,   
    Y \= C,
    Z \= A,   
    Z \= B,   
    Z \= C.