Advanced · Lesson 35 of 43

Generate & test: puzzles

Solving puzzles by describing them, and making the search smarter.

Many puzzles have the shape: there are some unknowns, each from a small set, and some rules they must obey. In Prolog you write exactly that: generate candidate values, test the rules. Backtracking does the rest.

Map colouring

Colour six Australian regions with three colours so that neighbours differ:

colour(red).
colour(green).
colour(blue).

% Regions: WA, NT, SA, Q, NSW, V
colouring([WA, NT, SA, Q, NSW, V]) :-
    maplist(colour, [WA, NT, SA, Q, NSW, V]),          % generate: every region gets some colour
    WA \= NT,  WA \= SA,  NT \= SA,  NT \= Q,          % test: neighbours differ
    SA \= Q,   SA \= NSW, SA \= V,   Q \= NSW,  NSW \= V.

?- colouring(Regions)

?- aggregate_all(count, colouring(_), N)

Six different colourings, SA touches everything, so once it has a colour the others alternate between the remaining two. This version tries all 3⁶ = 729 colour combinations then tests each. Interleaving the tests with the generation prunes the search far earlier:

colouring2([WA, NT, SA, Q, NSW, V]) :-
    colour(WA), colour(NT), WA \= NT,
    colour(SA), WA \= SA, NT \= SA,
    colour(Q),  NT \= Q,  SA \= Q,
    colour(NSW), SA \= NSW, Q \= NSW,
    colour(V),  SA \= V,  NSW \= V.

?- time(aggregate_all(count, colouring(_), _))

?- time(aggregate_all(count, colouring2(_), _))

Compare the inferences reported by time/1. Same answers, a fraction of the work: test as early as you can.

A logic puzzle with permutations

Three friends, Ann, Bo and Cy, own a cat, a dog and a fish (one each). Ann doesn't own the cat. Bo owns neither the dog nor the cat. Who owns what?

solve(Owners) :-
    Owners = [ann-A, bo-B, cy-C],
    permutation([cat, dog, fish], [A, B, C]),     % generate every assignment
    A \== cat,                                    % test the clues
    B \== dog, B \== cat.

?- solve(Owners)

N-queens

Place N queens on an N×N board so none attack each other. Represent a solution as a list of row numbers, one per column. A queen attacks along rows and diagonals:

% generate every permutation, then test
queens(N, Qs) :-
    numlist(1, N, Rows),
    permutation(Rows, Qs),
    safe(Qs).

safe([]).
safe([Q|Qs]) :- no_attack(Q, Qs, 1), safe(Qs).

no_attack(_, [], _).
no_attack(Q, [Q1|Qs], D) :-
    Q =\= Q1 + D, Q =\= Q1 - D,
    D1 is D + 1,
    no_attack(Q, Qs, D1).

% place queens one at a time, checking as we go
queens2(N, Qs) :- numlist(1, N, Rows), place(Rows, [], Qs).

place([], Qs, Qs).
place(Unplaced, Safe, Qs) :-
    select(Q, Unplaced, Rest),
    no_attack(Q, Safe, 1),
    place(Rest, [Q|Safe], Qs).

?- queens(6, Qs)

?- aggregate_all(count, queens(6, _), N)

?- time(queens(8, Qs))

?- time(queens2(8, Qs))

The second version prunes as it goes, so it explores a tiny fraction of the 8! = 40,320 permutations. For larger puzzles even smart generate-and-test runs out of steam, the next lesson shows constraint solving, which prunes automatically.

Exercise: Pythagorean triples

Write triple(A, B, C) for all integers 1 ≤ A < B < C ≤ 20 with A² + B² = C². Generate with between/3 and test.