Wakatta!

Like Eureka!, only cooler

Seven Languages in Seven Weeks Prolog Day 3

The final day with Prolog is called “Blowing Up Vegas” in the book, and was certainly intended as a Shock and Awe moment. Unfortunately, it feels more like Razzle Dazzle.

Certainly, the code for both solvers (8 Queens and Sudoku) is short (if slightly incomplete) and effective. But it has one, significant shortcoming: it is not Prolog code.

Prolog’s main control mechanism, backtracking, means the language is a natural match for problems that can be expressed as searches. But to be efficient, it is important to pay attention to the shape of the tree that is defined by the rules. Cutting and pruning are critical to ensure that Prolog will answer quickly (that is, before the Sun blows up or the Universe cools down).

As I was looking at the code for Day 3, I was specifically looking for the code that would shape the search tree; there were a couple of predicates (fd_domain, fd_all_different) which I didn’t know about, so I mentally replaced them with code whose meaning was derived from the names of the unknown predicates (so fd_domain would try to assign a value between 1 and the passed maximum to each variables in the passed list, while fd_all_different would ensure that all values in the passed list was indeed different). The explanation in the book supported this interpretation.

Now, my problem was that the code as I understood it would be terribly slow: the fd_domain would generate a lot of different solutions, and fd_all_different would invalidate all but a few. Certainly, I was thinking, the 9x9 Sudoku will never work, even if the 4x4 seems to.

So I was surprised when I ran the 9x9 Sudoku (see below for the code): it was really fast. My assumptions regarding the unknown predicates were all wrong. Time to look at the manual. It turns out that these predicates below to a specific GNU Prolog library (so it is not portable) designed to solve Finite Domain problems. Now, clearly, this is a great library, it simplifies things a lot. But there’s also the problem: what is so great about today’s code is due to the library, not specifically to Prolog. Many languages have such a library, so the case for Prolog is kind of weakened.

Before I finally understood the role of the finite domain solver in today’s code, I had reimplemented the 8 Queens (generalized to N Queens) with explicit search tree pruning. So here I will show variants of the book code, which I hope will be better witnesses to Prolog’s strengths.

Exercises

As stated above, I will depart considerably from the exercises, although the ones mentioned in the book are all here.

Input/Ouput

There are a number of such predicates, listed here.

Print only successful solutions

I must say I’m not sure I understand this one. My approach is always to organise clauses so that the printing occurs last, when solutions are fully known. See below the code for the solvers.

9x9 Sudoku Solver

A first thing: when using GNU Prolog’s Finite Domain Solver, the variables must be assigned a label from the domain, using fd_labeling. Otherwise, solutions will be displayed with a superset of the possible values for each unknown, rather than just the possible ones.

9x9 Sudoku Solver (sudoku_book.pl) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
sudoku(Puzzle, Solution) :-
    Solution = Puzzle,
    Puzzle = [S11, S12, S13, S14, S15, S16, S17, S18, S19,
              S21, S22, S23, S24, S25, S26, S27, S28, S29,
              S31, S32, S33, S34, S35, S36, S37, S38, S39,
              S41, S42, S43, S44, S45, S46, S47, S48, S49,
              S51, S52, S53, S54, S55, S56, S57, S58, S59,
              S61, S62, S63, S64, S65, S66, S67, S68, S69,
              S71, S72, S73, S74, S75, S76, S77, S78, S79,
              S81, S82, S83, S84, S85, S86, S87, S88, S89,
              S91, S92, S93, S94, S95, S96, S97, S98, S99],

    fd_domain(Puzzle, 1, 9),

    Col1 = [S11, S21, S31, S41, S51, S61, S71, S81, S91],
    Col2 = [S12, S22, S32, S42, S52, S62, S72, S82, S92],
    Col3 = [S13, S23, S33, S43, S53, S63, S73, S83, S93],
    Col4 = [S14, S24, S34, S44, S54, S64, S74, S84, S94],
    Col5 = [S15, S25, S35, S45, S55, S65, S75, S85, S95],
    Col6 = [S16, S26, S36, S46, S56, S66, S76, S86, S96],
    Col7 = [S17, S27, S37, S47, S57, S67, S77, S87, S97],
    Col8 = [S18, S28, S38, S48, S58, S68, S78, S88, S98],
    Col9 = [S19, S29, S39, S49, S59, S69, S79, S89, S99],

    Row1 = [S11, S12, S13, S14, S15, S16, S17, S18, S19],
    Row2 = [S21, S22, S23, S24, S25, S26, S27, S28, S29],
    Row3 = [S31, S32, S33, S34, S35, S36, S37, S38, S39],
    Row4 = [S41, S42, S43, S44, S45, S46, S47, S48, S49],
    Row5 = [S51, S52, S53, S54, S55, S56, S57, S58, S59],
    Row6 = [S61, S62, S63, S64, S65, S66, S67, S68, S69],
    Row7 = [S71, S72, S73, S74, S75, S76, S77, S78, S79],
    Row8 = [S81, S82, S83, S84, S85, S86, S87, S88, S89],
    Row9 = [S91, S92, S93, S94, S95, S96, S97, S98, S99],

    Square1 = [S11, S21, S31, S12, S22, S32, S13, S23, S33],
    Square2 = [S41, S51, S61, S42, S52, S62, S43, S53, S63],
    Square3 = [S71, S81, S91, S72, S82, S92, S73, S83, S93],
    Square4 = [S14, S24, S34, S15, S25, S35, S16, S26, S36],
    Square5 = [S44, S54, S64, S45, S55, S65, S46, S56, S66],
    Square6 = [S74, S84, S94, S75, S85, S95, S76, S86, S96],
    Square7 = [S17, S27, S37, S18, S28, S38, S19, S29, S39],
    Square8 = [S47, S57, S67, S48, S58, S68, S49, S59, S69],
    Square9 = [S77, S87, S97, S78, S88, S98, S79, S89, S99],

    valid([Row1, Row2, Row3, Row4, Row5, Row6, Row7, Row8, Row9,
           Col1, Col2, Col3, Col4, Col5, Col6, Col7, Col8, Col9,
           Square1, Square2, Square3, Square4, Square5,
           Square6, Square7, Square8, Square9]),
    fd_labeling(Puzzle).

valid([]).
valid([Head|Tail]) :-
    fd_all_different(Head),
    valid(Tail).

This was clearly tedious to write (I wrote a few Emacs functions to do the job). I will show a better (I think) way below.

Sudoko test
1
2
3
4
5
6
7
8
9
10
11
12
| ?- sudoku([_, _, _, 2, _, _, _, 6, 3,
        3, _, _, _, _, 5, 4, _, 1,
        _, _, 1, _, _, 3, 9, 8, _,
        _, _, _, _, _, _, _, 9, _,
        _, _, _, 5, 3, 8, _, _, _,
        _, 3, _, _, _, _, _, _, _,
        _, 2, 6, 3, _, _, 5, _, _,
        5, _, 3, 7, _, _, _, _, 8,
        4, 7, _, _, _, 1, _, _, _],
       Solution).

Solution = [8,5,4,2,1,9,7,6,3,3,9,7,8,6,5,4,2,1,2,6,1,4,7,3,9,8,5,7,8,5,1,2,6,3,9,4,6,4,9,5,3,8,1,7,2,1,3,2,9,4,7,8,5,6,9,2,6,3,8,4,5,1,7,5,1,3,7,9,2,6,4,8,4,7,8,6,5,1,2,3,9] ?

Note: I found a few implementations missing the fd_labeling clause, which causes the test above to return:

Sudoko test without fd_labeling
1
2
3
4
5
6
7
8
9
10
11
12
13
14
| ?- sudoku([_, _, _, 2, _, _, _, 6, 3,
        3, _, _, _, _, 5, 4, _, 1,
        _, _, 1, _, _, 3, 9, 8, _,
        _, _, _, _, _, _, _, 9, _,
        _, _, _, 5, 3, 8, _, _, _,
        _, 3, _, _, _, _, _, _, _,
        _, 2, 6, 3, _, _, 5, _, _,
        5, _, 3, 7, _, _, _, _, 8,
        4, 7, _, _, _, 1, _, _, _],
       Solution).

Solution = [_#3(8..9),_#25(4..5:8..9),_#47(4..5:8..9),2,_#83(1:4:8..9),_#105(4:9),7,6,3,3,_#191(6:8..9),_#213(7..9),_#235(6:8..9),_#257(6..9),5,4,2,1,_#343(2:6..7),_#365(4:6),1,_#401(4:6),_#423(4:6..7),3,9,8,5,_#509(1..2:6..8),_#531(1:4..6:8),_#553(2:4..5:7..8),_#575(1:4:6),_#597(1..2:4:6..7),_#619(2:4:6..7),_#641(1..3:6:8),9,_#677(2:4:6..7),_#699(1..2:6..7:9),_#721(1:4:6:9),_#743(2:4:7:9),5,3,8,_#807(1..2:6),_#829(1:4:7),_#851(2:4:6..7),_#873(1..2:6..9),3,_#909(2:4..5:7..9),_#931(1:4:6:9),_#953(1..2:4:6..7:9),_#975(2:4:6..7:9),_#997(1..2:6:8),_#1019(1:4..5:7),_#1041(2:4:6..7),_#1063(1:8..9),2,6,3,_#1127(4:8..9),_#1149(4:9),5,_#1185(1:4:7),_#1207(4:7:9),5,_#1243(1:9),3,7,_#1293(2:4:6:9),_#1315(2:4:6:9),_#1337(1..2:6),_#1359(1:4),8,4,7,_#1423(8..9),_#1445(6:8..9),_#1467(2:5..6:8..9),1,_#1503(2:6),3,_#1547(2:6:9)]

(1 ms) yes

Utility predicates

First, I need to introduce a few helper predicates which will come handy later on.

Utility predicates (utils.pl) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
% apply a clause to each element of a list, and collect the results
maplist(_, [], []).
maplist(P, [H|T], [R|Rs]) :- call(P, H, R), maplist(P, T, Rs).

% same, but without return value - only side effect
maplist_(_, []).
maplist_(P, [H|T]) :- call(P, H), maplist_(P, T).

% same as maplist, but passes the current index to the predicate
maplistidx(_, _, [], []).
maplistidx(Pred, N, [H|T], [X|R]) :-
    call(Pred, N, H, X),
    N1 is N + 1,
    maplistidx(Pred, N1, T, R).

% subtract(S, Es, R) deletes all elements in Es from S, and puts the result in R
subtract(Set, [], Set).
subtract(Set, [H|T], Result) :- delete(Set, H, R1), subtract(R1, T, Result).

% Matrix transposition. A Matrix is a list of list
transpose([], []).
transpose([[]|_], []).
transpose(M, [Hs|M1]) :- maplist(head, M, Hs), maplist(tail, M, Ts),
    transpose(Ts, M1).

% simple utility predicates used in transpose
head([H|_], H).
tail([_|T], T).

% make_var makes a list of variables
make_var(N, L) :- length(L, N).

% take up to N element from F, return them as P. The rest is returned as S
take(N, F, P, S) :-
    length(F, Fl), Sl is min(Fl, N), make_var(Sl, P),
    append(P, S, F).

% split a list into sublists of N elements
chunk(_, [], []).
chunk(N, [L|Ls], [H|R]) :- take(N, [L|Ls], H, R1), chunk(N, R1, R).

% concatenate a list of list. Unlike flatten, only operate on one level
concatenate([], A, A).
concatenate([H|T], R, A) :- append(H, A, A1), concatenate(T, R, A1).
concatenate(L, R) :- concatenate(L, R, []).

% make a list of N Char
const(N, _, N).
make_line(N, Char, Out) :- make_var(N, In), maplist(const(Char), In, Out).

% make a list with values 1 to N
make_range(N, R) :- make_var(N, L), maplistidx(const, 1, L, R).

% print_line print each element in a list without list formatting
print_list(List) :- maplist_(write, List).

maplist is just the same as the map function found in many functional programming language.

maplist: apply sort to each sublist in a list
1
2
3
4
5
| ?- maplist(sort, [[3,1,2], [7,9,8], [6,5,4]], O).

O = [[1,2,3],[7,8,9],[4,5,6]] ? ;

no

maplist_ is the same, but called only for side effects.

maplist_: output each element
1
2
3
4
5
6
| ?- maplist_(print, [1,2,3]).
123

true ? ;

no

maplistidx is the same as maplist again, but additionally passes the index (position within the list) to the predicate.

maplistidx
1
2
3
4
5
| ?- maplistidx(const, 1, [4,3,2,1], O).

O = [1,2,3,4] ? ;

no

subtract generalizes delete: it removes all the elements of a list from another one.

subtract
1
2
3
4
5
| ?- subtract([1,2,3,4,5,6,7,8,9,10], [4,5,6], O).

O = [1,2,3,7,8,9,10] ? ;

no

transpose is a matrix transposition predicate. It uses head and tail to split a list.

transpose
1
2
3
4
5
| ?- transpose([[1,2,3], [4,5,6]], O).

O = [[1,4],[2,5],[3,6]] ? ;

no

make_var makes a list of N vars

make_var
1
2
3
4
5
| ?- make_var(5, L).

L = [_,_,_,_,_]

yes

take is similar to the take function in Haskell: it split a list in two, the prefix being up to N elements long.

take
1
2
3
4
5
6
| ?- take(3, [1,2,3,4,5], T, R).

R = [4,5]
T = [1,2,3]

yes

chunk splits a list into chunks of size N.

chunk
1
2
3
4
5
| ?- chunk(3, [1,2,3,4,5,6,7,8,9], O).

O = [[1,2,3],[4,5,6],[7,8,9]] ? ;

no

make_line create a list of length N, and set each element to Char.

make_line: creating and printing a line of ‘-’
1
2
3
4
5
6
| ?- make_line(20, '-', O), maplist_(print, O), nl.
--------------------

O = [-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-,-] ? ;

no

Finally, make_range creates a list with elements ranging from 1 to N

make_range
1
2
3
4
5
| ?- make_range(10, L).

L = [1,2,3,4,5,6,7,8,9,10] ? ;

no

Pretty printing Sudoku solutions

Pretty Printing Sudoku (sudoku_print.pl) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
sudoku_print(Board) :-
    length(Board, LB),          % complete board length
    LL is floor(sqrt(LB)),      % a line length is the square root of board length
    SL is floor(sqrt(LL)),      % a square length is the square root of line length
    sudoku_print_(LL, SL, SL, Board).

% assuming values up to 9. Otherwise would need to
% configure cell width.
sudoku_print_(LL, SH, SV, Board) :-
    chunk(LL, Board, Lines),             % cut the board in lines
    maplist(chunk(SH), Lines, LSquares), % cut each line in squares
    chunk(SV, LSquares, Squares),        % group each SV lines
    SepL is (2 * LL) + round(LL/SH) + 1, % 2 spaces for each number
    make_line(SepL, '-', Line),
    print_list(Line), nl,
    maplist_(out_squares(Line), Squares).

out_squares(LineSep, SBlock) :-
    maplist_(in_squares, SBlock),
    print_list(LineSep), nl.

in_squares(Line) :-
    write('|'),
    maplist_(line, Line),nl.

line(SubLine) :-
    maplist_(print_number, SubLine),
    write('|').

print_number(N) :- format("~k ", [N]).

First, a test to show what the output looks like:

Sudoku Pretty Printer
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
GNU Prolog 1.4.0
By Daniel Diaz
Copyright (C) 1999-2011 Daniel Diaz
| ?- consult('utils').
...

| ?- consult('sudoku_book').
...

| ?- consult('sudoku_print').
....

| ?- sudoku([_, _, _, 2, _, _, _, 6, 3,
        3, _, _, _, _, 5, 4, _, 1,
        _, _, 1, _, _, 3, 9, 8, _,
        _, _, _, _, _, _, _, 9, _,
        _, _, _, 5, 3, 8, _, _, _,
        _, 3, _, _, _, _, _, _, _,
        _, 2, 6, 3, _, _, 5, _, _,
        5, _, 3, 7, _, _, _, _, 8,
        4, 7, _, _, _, 1, _, _, _],
       Solution), sudoku_print(Solution).
----------------------
|8 5 4 |2 1 9 |7 6 3 |
|3 9 7 |8 6 5 |4 2 1 |
|2 6 1 |4 7 3 |9 8 5 |
----------------------
|7 8 5 |1 2 6 |3 9 4 |
|6 4 9 |5 3 8 |1 7 2 |
|1 3 2 |9 4 7 |8 5 6 |
----------------------
|9 2 6 |3 8 4 |5 1 7 |
|5 1 3 |7 9 2 |6 4 8 |
|4 7 8 |6 5 1 |2 3 9 |
----------------------

Solution = [8,5,4,2,1,9,7,6,3,3,9,7,8,6,5,4,2,1,2,6,1,4,7,3,9,8,5,7,8,5,1,2,6,3,9,4,6,4,9,5,3,8,1,7,2,1,3,2,9,4,7,8,5,6,9,2,6,3,8,4,5,1,7,5,1,3,7,9,2,6,4,8,4,7,8,6,5,1,2,3,9] ?

First the various modules have to be loaded (GNU Prolog does not have a module system, so this is tedious). Then the solver is run on a hard problem (from this site), and finally pretty printed. As usual, Prolog then lists the variables introduced in the query, here only Solution.

Pretty printing a 6x6 (dummy) board works as well:

A 6x6 board
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
| ?- make_line(36, 1, L), sudoku_print_(6, 3, 2, L).
---------------
|1 1 1 |1 1 1 |
|1 1 1 |1 1 1 |
---------------
|1 1 1 |1 1 1 |
|1 1 1 |1 1 1 |
---------------
|1 1 1 |1 1 1 |
|1 1 1 |1 1 1 |
---------------

L = [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1] ? ;

no

The code is fairly simple; the major difficulty is to find names for the various segments that are printed.

sudoku_print computes some parameters using assumptions that are valid for some board sizes, but not all. sudoku_print_ should be used for these other sizes. The paramaters are the number of columns or rows LL and the size of the subdivisions, horizontally SH, and vertically SV.

sudoku_print_ then splits the Board into LL lines; each line is split into SH long segments (which will form the squares); and the list of lines is split into SV long vertical segments. A LineSep as large as the board: counting 2 characters per value, 2*LL, plus 1 character for each separation before, between and after subdivisions (each subdivision is SH long, so there are LL/SH subdivisions). That LineSep is first printed (the general logic is that the various predicates print the separation after their output; the calling predicate emits the separation before the output).

out_squares iterates over the group of lines (each SV long). It prints a LineSep after each group.

in_squares iterates over a group of lines inside a square. It prints the | character that begins a line.

line iterates over the groups within a line. It prints the | after each group.

Finally, print_number iterate over each number inside a group. It prints the number, then a space.

The n Queens problem

Here I depart from the book, as the code below solves the n Queens problem (that is, it is general over the number of queens), and I do not use the Finite Domain predicates, so as to show how Prolog can constrain the search tree.

The constraints on a n Queens problems are easy:

  • no two queens on the same row
  • no two queens on the same column
  • no two queens on the same diagonal

The first constraint it easy to ensure: the solution is the list of rows, each one giving the position of a single queen in that row. In other words, by the nature of the format for the solution, it is already impossible to have two queens in the same row.

For instance, the (dummy and wrong) board solution

1
[1,3,2]

puts one queen in column 1 of row 1, one queen in column 3 of row 2, and one queen in column 2 of row 3.

With such the board, the design of the algorithm starts to emerge:

  • select a column for each row top to bottom,
  • for each row, know the columns selected for rows above it
  • use the selected columns to filter out the potential candidate columns for the current row
  • if no candidate exists, backtrack
  • if all rows have a column, emit the result
n Queens Solver (queens.pl) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
%% Solver predicates 

exclude_diag(_, [], []).
exclude_diag(Diff, [X|T], [L, R| RE]) :-
    L is X + Diff,
    R is X - Diff,
    Diff1 is Diff + 1,
    exclude_diag(Diff1, T, RE).

valid(0, _, S, S).
valid(Pos, Range, Sol, R) :-
    exclude_diag(1, Sol, Excl),
    subtract(Range, Excl, Poss),
    member(X, Poss),            % pick one location
    select(X, Range, Rest),     % don't reuse it
    Pos1 is Pos - 1,
    valid(Pos1, Rest, [X|Sol], R).

queens(Max, Sol) :-
    make_range(Max, Range),
    make_var(Max, Sol),
    valid(Max, Range, [], Sol).

%% Formatting predicates

format_board(Max, In, Out) :- maplist(format_line(Max), In, Out).

put_queen(Pos, Pos, _, 'Q').
put_queen(P1, P2, E, E) :- P1 \= P2.
format_line(Max, Pos, L) :- make_line(Max, ' ', R), Prev is Pos - 1,
    take(Prev, R, P, [_|S]), append(P, ['Q'|S], L).

%% Pretty Printer predicates

print_board(B) :-
    length(B, L),
    LL is L * 2 + 1,
    make_line(LL, '-', LineSep),
    nl, print_list(LineSep), nl,
    maplist_(print_line(LineSep), B).

print_line(LineSep, L) :-
    print('|'),
    maplist_(print_square, L), nl,
    print_list(LineSep), nl.

print_square(S) :- print(S), print('|').

%% Toplevel predicate
run_queens(N) :- queens(N, S), format_board(N, S, B), print_board(B).

With the utility predicates defined above, the code becomes fairly simple. It is divided into three groups:

  • solver
  • formatting
  • pretty printer

Solver

The solver is made of three predicates:

  • queens/2
  • valid/4
  • exclude_diag/3

queens prepares the work: it generates the list of possible columns in Range (similar to the fd_domain predicate the book uses), and a list for the solutions in Sol. The actual solution is computed by valid.

valid keeps a number of parameters:

  • Pos runs from Max to 0. When Pos is 0, it means we have a valid column for each row in Sol.
  • Range is the currently available columns
  • Sol is the columns of the queens in the rows above the current one
  • the last parameter is the actual solution. It is copied from Sol when Pos is 0.

The logic to remove possible positions is the following:

  • any selected column is removed from the Range for the rows below it
  • at each row, the diagonals of previous solutions is computed by exclude_diag, and removed from the Range only for the current row

The member(X, Poss) clause is the core of the backtracking: from the list of not excluded columns, each element is selected, and then we try to fill the remaining rows by calling valid recursively. If there are no remaining columns, Prolog backtracks until the more recent member(X, Poss). When Poss is exhausted, the backtracking continues up to the next most recent member(X, Poss). So member(X, Poss) generates branching, and valid generally closes them (or finds a solution). The branching is limited as much as possible by the design of the solution, and exclude_diag.

exclude_diag rely on a trick: let’s say a queen has been put on column C in a given column. Then on the next row, it blocks the columns C+1 and C-1. On the row to the below, it blocks the columns C+2 and C-2. In other words, it blocks columns left and right its own by a number equal to the distance in rows.

So exclude_diag iterates over the existing solutions, keeping track of the difference in column in Diff, and collects the blocked diagonals.

And yes, exclude_diag could be written with maplistidx and flatten. This is left as an exercise to the reader.

With the code above, it is already possible to compute solutions. Here is a partial list of the 8 Queens boards:

queens solver
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
| ?- queens(8, Sol).

Sol = [4,2,7,3,6,8,5,1] ? ;

Sol = [5,2,4,7,3,8,6,1] ? ;

Sol = [3,5,2,8,6,4,7,1] ? ;

Sol = [3,6,4,2,8,5,7,1] ? ;

Sol = [5,7,1,3,8,6,4,2] ? ;

Sol = [4,6,8,3,1,7,5,2] ?

(3 ms) yes

and a complete list of the 4 Queens boards (there’s only two):

4 queens solutions
1
2
3
4
5
6
7
| ?- queens(4, Sol).

Sol = [3,1,4,2] ? a

Sol = [2,4,1,3]

no

Formatting Predicates

The formatting predicates simply replace the basic solution with a list of lists, each representing a line of the board. Each cell is either a space for empty, or a ‘Q’ character for a queen.

There are 2 predicates:

  • format_board/3
  • format_line/3

format_board applies format_line to each column.

format_line make a empty line, then split it to insert the ‘Q’ at the right location.

Pretty Printer

The pretty printer predicates follow pretty much the same strategy as the pretty printer for Sudoku boards above.

There are 3 predicates:

  • print_board/1
  • print_line/2
  • print_squares/1

As the design is the same as the Sudoku pretty printer, it is not repeated here.

Computing and printing solutions

Finally, run_queens provide a top level predicate that computes then render each solution board. Here are the two boards from the 4 Queens problem:

4 Queens boards
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
| ?- run_queens(4).

---------
| | |Q| |
---------
|Q| | | |
---------
| | | |Q|
---------
| |Q| | |
---------

true ? a
---------
| |Q| | |
---------
| | | |Q|
---------
|Q| | | |
---------
| | |Q| |
---------

true

(1 ms) no

and the first two boards from the 8 Queens problem:

8 Queens - first 2 boards
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
| ?- run_queens(8).

-----------------
| | | |Q| | | | |
-----------------
| |Q| | | | | | |
-----------------
| | | | | | |Q| |
-----------------
| | |Q| | | | | |
-----------------
| | | | | |Q| | |
-----------------
| | | | | | | |Q|
-----------------
| | | | |Q| | | |
-----------------
|Q| | | | | | | |
-----------------

true ? ;

-----------------
| | | | |Q| | | |
-----------------
| |Q| | | | | | |
-----------------
| | | |Q| | | | |
-----------------
| | | | | | |Q| |
-----------------
| | |Q| | | | | |
-----------------
| | | | | | | |Q|
-----------------
| | | | | |Q| | |
-----------------
|Q| | | | | | | |
-----------------

true ?

(2 ms) yes

Wrapping up n Queens problem

Given suitable utility predicates, the code to solve the n Queens problem (rather than just the 8 Queens problem) without the dedicated Finite Domain predicates is actually very short (slightly more than half is the formatting and pretty printer code).

The trick is to identify the best location for branching (the member(X, Poss) in validate above), and making sure the branching is as pruned as possible.

Prolog supports many other tricks (such at the cut ! operator) to further constrain the search tree; and of course the availability of Finite Domain extensions add expressivity and power to an already powerful base.

Improving Sudoku

The code above is tied to the size of the board, and the list of constrains has to be written by hand (or using code outside Prolog). It does not have to be this way.

Using techniques similar to the n Queens solver, and a judicious combination of utility predicates, the list of constrains can be abstracted over.

Flexible Sudoku (sudoku.pl) download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
sudoku(Puzzle, Solution) :-
    Solution = Puzzle,
    length(Solution, Len),
    Side is floor(sqrt(Len)),   % side of the board
    SH is floor(sqrt(Side)),    % horizontal length of a Square
    SV is floor(sqrt(Side)),    % vertical length of a Square

    sudoku_(Len, Side, SH, SV, Puzzle).

sudoku_(Len, Side, SH, SV, Puzzle) :-
    make_var(Len, Puzzle),      % create the Puzzle list 

    fd_domain(Puzzle, 1, Side),

    chunk(Side, Puzzle, Cols),  % split the Puzzle into columns

    transpose(Cols, Rows),      % transpose the columns into rows

    make_squares(SH, SV, Cols, Squares),
    concatenate([Cols, Rows, Squares], Constrains),
    valid(Constrains),
    fd_labeling(Puzzle).

valid([]).
valid([Head|Tail]) :-
    fd_all_different(Head),
    valid(Tail).

make_squares(SH, SV, Cols, Squares) :-
    maplist(chunk(SH), Cols, ColSplit), % split each line into SH long segments
    transpose(ColSplit, RowSplit), % transpose the result to process columns
    maplist(chunk(SV), RowSplit, ListOfListOfSquares), % split each column into SV long segments
    maplist(maplist(concatenate), ListOfListOfSquares, ListOfSquares), % group the squares together into each column 
    concatenate(ListOfSquares, Squares). % group all the columns together, so at to have a list of squares

The new code is about the size of the original 4x4 Sudoku code from the book, and clearly shorter than the 9x9 Sudoku code above. Of course it hides some or the complexity in utility predicates, but that’s what libraries are for.

Now the Sudoku solver can be used on the old 4x4 problem:

Testing new Sudoku solver on 4x4 problem
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
GNU Prolog 1.4.0
By Daniel Diaz
Copyright (C) 1999-2011 Daniel Diaz
| ?- consult('utils').
....

| ?- consult('sudoku').
....

| ?- consult('sudoku_print').
....

| ?- sudoku([_, _, 2, 3,
             _, _, _, _,
             _, _, _, _,
             3, 4, _, _],
             Solution), sudoku_print(Solution).
-----------
|4 1 |2 3 |
|2 3 |4 1 |
-----------
|1 2 |3 4 |
|3 4 |1 2 |
-----------

Solution = [4,1,2,3,2,3,4,1,1,2,3,4,3,4,1,2] ? a

no

as well as on 8x8 (hard) problems:

Testing new Sudoku solver on 8x8 problem
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
| ?- sudoku([_, _, _, 2, _, _, _, 6, 3,
        3, _, _, _, _, 5, 4, _, 1,
        _, _, 1, _, _, 3, 9, 8, _,
        _, _, _, _, _, _, _, 9, _,
        _, _, _, 5, 3, 8, _, _, _,
        _, 3, _, _, _, _, _, _, _,
        _, 2, 6, 3, _, _, 5, _, _,
        5, _, 3, 7, _, _, _, _, 8,
        4, 7, _, _, _, 1, _, _, _],
       Solution), sudoku_print(Solution).
----------------------
|8 5 4 |2 1 9 |7 6 3 |
|3 9 7 |8 6 5 |4 2 1 |
|2 6 1 |4 7 3 |9 8 5 |
----------------------
|7 8 5 |1 2 6 |3 9 4 |
|6 4 9 |5 3 8 |1 7 2 |
|1 3 2 |9 4 7 |8 5 6 |
----------------------
|9 2 6 |3 8 4 |5 1 7 |
|5 1 3 |7 9 2 |6 4 8 |
|4 7 8 |6 5 1 |2 3 9 |
----------------------

Solution = [8,5,4,2,1,9,7,6,3,3,9,7,8,6,5,4,2,1,2,6,1,4,7,3,9,8,5,7,8,5,1,2,6,3,9,4,6,4,9,5,3,8,1,7,2,1,3,2,9,4,7,8,5,6,9,2,6,3,8,4,5,1,7,5,1,3,7,9,2,6,4,8,4,7,8,6,5,1,2,3,9] ? a

(1 ms) no

Wrapping Day 3 and Prolog

I really enjoyed coding in Prolog again. Backtracking is a powerful mechanism which allows clear and concise descriptions of some problems. And I can feel that there is yet a more interesting language lurking just beyond my current understanding.

The book gives a fair account of Prolog strengths and weaknesses. While I see little to no use for it in my daily activities, I wished my copy of “The Art of Prolog” was not on another continent.

Comments