GNU Prolog's finite domain constraint solver

The GNU Prolog compiler includes a set of features that I think is little-known: a finite domain (FD) constraint solver. FD variables are constrained to values within subsets of naturals, as set by the user.

I find this is a great way to take the ~~fun~~ guesswork out of some puzzles posted on Puzzling Stack Exchange.

Tiny example

fd_domain([X, Y], 0, 10), % Set X and Y range to 0..10
X + Y * Y #= 7,           % Our one equation to solve: X + Y² = 7
fd_labeling([X, Y]),      % Ask FD solver to assign values to X and Y
write([X, Y]),            % Print values found
fail.                     % Force backtracking to print more solutions

This prints, tersely, [3,2][6,1][7,0]. And, indeed,

3 + 2^2 = 6 + 1^2 = 7 + 0^2 = 7

, without us having to think much about how to solve quadratic equations over integers.

Puzzling example

A puzzle on Puzzling Stack Exchange ¹ tells us four people have passed a test consisting of ten boolean answers. We get the answers given by all four, and the score that the first three got. We are asked to compute the last player's score, in a

0..10

range:

Name	Q1	Q2	Q3	Q4	Q5	Q6	Q7	Q8	Q9	Q10	Score
Joe	T	T	T	F	T	T	F	F	T	T	6
Jack	F	T	F	T	T	F	F	F	F	F	8
William	T	F	F	T	F	F	T	F	T	F	7
Averell	T	T	F	T	T	F	F	T	T	F	?

Of course, we could spend time thinking about the specific problem, try to identify patterns, but where is the fun in that when we can instead ask a computer to just go through the effort?

Code

This is meant to be compiled using gplc --no-toplevel contest.pl, which should produce an executable file named contest.

/**
 * score(Answers, CorrectAnswers, Score)
 *
 * Compute score for a given set of boolean answers
 *
 * Succeeds if Answers and CorrectAnswers are lists of the same length,
 * and Score is how many positions the two lists contain the same
 * value.
 */

% Base case: empty lists, score zero
score([], [], 0).

% Case where the first elements from each list are FD-equal (#=):
% compute score as one plus score computed from rest of lists.
score([Ha | Ta], [Hc | Tc], Score) :-
    Ha #= Hc,
    score(Ta, Tc, ScoreR),
    Score #= ScoreR + 1.

% Case where the first elements from each list are FD-different (#\=):
% compute score as (zero plus) score from rest of lists.
score([Ha | Ta], [Hc | Tc], Score) :-
    Ha #\= Hc,
    score(Ta, Tc, Score).

/**
 * contest(?ScoreAverell, ?CorrectAnswers)
 *
 * Succeeds when ScoreAverell is Averell's score and CorrectAnswers is
 * the ten-element list of all the right answers to the quiz, using
 * the puzzle's parameters.
 */
contest(ScoreAverell, CorrectAnswers) :-
    % Set the length of the list of answers to 10, all unknown
    CorrectAnswers = [_, _, _, _, _, _, _, _, _, _],

    % Encode each person's answers (1 for T, 0 for F)
    AJoe =     [1, 1, 1, 0, 1, 1, 0, 0, 1, 1],
    AJack =    [0, 1, 0, 1, 1, 0, 0, 0, 0, 0],
    AWilliam = [1, 0, 0, 1, 0, 0, 1, 0, 1, 0],
    AAverell = [1, 1, 0, 1, 1, 0, 0, 1, 1, 0],

    % Tell the FD solver that each variable within CorrectAnswers is
    % constrained to 0..1
    fd_domain_bool(CorrectAnswers),

    % Encode each person's score
    score(AJoe,     CorrectAnswers, 6),
    score(AJack,    CorrectAnswers, 8),
    score(AWilliam, CorrectAnswers, 7),
    score(AAverell, CorrectAnswers, ScoreAverell),

    % Ask the FD solver to assign concrete values to ScoreAverell and
    % CorrectAnswers
    fd_labeling(ScoreAverell),
    fd_labeling(CorrectAnswers).

% The rest is boilerplate to pretty-print all solutions to the puzzle,
% in case there was more than one.
main :-
    contest(ScoreAverell, CorrectAnswers),
    format("Averell score: ~d; correct answers: ~w.\n",
           [ScoreAverell, CorrectAnswers]),
    fail.
main :-
    !.

:- initialization(main).

Reassuringly, this is the same score that the people answering on Puzzling Stack Exchange also found.

Puzzle by Puzzling Stack Exchange user ThomasL available under the CC BY-SA 4.0 license; reproduced here with modified wording and presentation.↩

David Haguenauer <www@kurokatta.org>
$Id: gnu-prolog-fd-solver.malblog,v 1.10 2021/11/23 04:46:44 homer Exp $