How can I optimize my sudoku solver? - prolog

Question

So I have been trying to write a sudoku solver I wrote this:
permutation([], []).
permutation([X|L], P) :-
permutation(L, L1),
insert(X, L1, P).
del(X, [X|Xs], Xs).
del(X, [Y|Ys], [Y|Zs]) :-
del(X, Ys, Zs).
insert(X, List, BiggerList) :-
del(X, BiggerList, List).
block(X1,X2,X3,X4,X5,X6,X7,X8,X9) :-
permutation([1,2,3,4,5,6,7,8,9],[X1,X2,X3,X4,X5,X6,X7,X8,X9]).
solveSudoku(X11,X12,X13,X14,X15,X16,X17,X18,X19,X21,X22,X23,X24,X25,X26,X27,X28,X29,X31,X32,X33,X34,X35,X36,X37,X38,X39,X41,X42,X43,X44,X45,X46,X47,X48,X49,X51,X52,X53,X54,X55,X56,X57,X58,X59,X61,X62,X63,X64,X65,X66,X67,X68,X69,X71,X72,X73,X74,X75,X76,X77,X78,X79,X81,X82,X83,X84,X85,X86,X87,X88,X89,X91,X92,X93,X94,X95,X96,X97,X98,X99) :-
block(X11,X12,X13,X14,X15,X16,X17,X18,X19) ,
block(X21,X22,X23,X24,X25,X26,X27,X28,X29) ,
block(X31,X32,X33,X34,X35,X36,X37,X38,X39) ,
block(X41,X42,X43,X44,X45,X46,X47,X48,X49) ,
block(X51,X52,X53,X54,X55,X56,X57,X58,X59) ,
block(X61,X62,X63,X64,X65,X66,X67,X68,X69) ,
block(X71,X72,X73,X74,X75,X76,X77,X78,X79) ,
block(X81,X82,X83,X84,X85,X86,X87,X88,X89) ,
block(X91,X92,X93,X94,X95,X96,X97,X98,X99) ,
... 27 blockes
the only problem is that for a normal input it never finishes (takes a lot of time), how can I optimize it?
It seems to be working because when I copied it for 4x4 It worked well. And for failure cases that are reviewed at the beginning (the lines) it returns false.
the full code
Or in another way

Answer 1

As you have observed, your program works fine with smaller instances of the problem, e.g. 4x4. What you see is the combinatorial explosion of the search space. To see the difference, compare 4x4 variables with 4 values each (4^16 = 4.29e+9 combinations) with 9x9 variables with 9 values each (9^81 = 1.97e+77 combinations).
The first 9 calls of your block/9 predicate build a search tree with a depth of 81 levels, while only ensuring the "no duplicates in a row" constraints. The following 18 calls of block/9 check the "column" and "block" constraints, and force backtracking into the huge search tree every time they find a violation. This is hopeless.
The way to improve this behaviour is to check immediately after a variable was set to a new value, that all the constraints are still satisfiable. This is actually one of the key techniques in constraint logic programming. Several Prolog systems support corresponding extensions (see e.g. the dif/2 predicate or the alldifferent/1 constraint).
However, I'd like to show here a program in standard Prolog that implements the same idea. Although it does so in a somewhat brute force way, it is still very effective:
?- sudoku.
[1, 2, 3, 4, 5, 6, 7, 8, 9]
[4, 5, 6, 7, 8, 9, 1, 2, 3]
[7, 8, 9, 1, 2, 3, 4, 5, 6]
[2, 1, 4, 3, 6, 5, 8, 9, 7]
[3, 6, 5, 8, 9, 7, 2, 1, 4]
[8, 9, 7, 2, 1, 4, 3, 6, 5]
[5, 3, 1, 6, 4, 2, 9, 7, 8]
[6, 4, 2, 9, 7, 8, 5, 3, 1]
[9, 7, 8, 5, 3, 1, 6, 4, 2]
Yes (0.08s cpu, solution 1, maybe more)
The code consists of a predicate check/1 that makes sure that the current variable assignments do not already violate any sudoku constraint. This check is called by checked_between/4 every time a value is assigned to a variable.
sudoku :-
Grid = [X11,X12,X13,X14,X15,X16,X17,X18,X19,
X21,X22,X23,X24,X25,X26,X27,X28,X29,
X31,X32,X33,X34,X35,X36,X37,X38,X39,
X41,X42,X43,X44,X45,X46,X47,X48,X49,
X51,X52,X53,X54,X55,X56,X57,X58,X59,
X61,X62,X63,X64,X65,X66,X67,X68,X69,
X71,X72,X73,X74,X75,X76,X77,X78,X79,
X81,X82,X83,X84,X85,X86,X87,X88,X89,
X91,X92,X93,X94,X95,X96,X97,X98,X99],
checked_between(Grid, 1, 9, check(Grid)),
write([X11,X12,X13,X14,X15,X16,X17,X18,X19]), nl,
write([X21,X22,X23,X24,X25,X26,X27,X28,X29]), nl,
write([X31,X32,X33,X34,X35,X36,X37,X38,X39]), nl,
write([X41,X42,X43,X44,X45,X46,X47,X48,X49]), nl,
write([X51,X52,X53,X54,X55,X56,X57,X58,X59]), nl,
write([X61,X62,X63,X64,X65,X66,X67,X68,X69]), nl,
write([X71,X72,X73,X74,X75,X76,X77,X78,X79]), nl,
write([X81,X82,X83,X84,X85,X86,X87,X88,X89]), nl,
write([X91,X92,X93,X94,X95,X96,X97,X98,X99]), nl.
% check whether any of the values chosen so far violate a sudoku constraint
check([ X11,X12,X13,X14,X15,X16,X17,X18,X19,
X21,X22,X23,X24,X25,X26,X27,X28,X29,
X31,X32,X33,X34,X35,X36,X37,X38,X39,
X41,X42,X43,X44,X45,X46,X47,X48,X49,
X51,X52,X53,X54,X55,X56,X57,X58,X59,
X61,X62,X63,X64,X65,X66,X67,X68,X69,
X71,X72,X73,X74,X75,X76,X77,X78,X79,
X81,X82,X83,X84,X85,X86,X87,X88,X89,
X91,X92,X93,X94,X95,X96,X97,X98,X99]) :-
nodups([X11,X12,X13,X14,X15,X16,X17,X18,X19]),
nodups([X21,X22,X23,X24,X25,X26,X27,X28,X29]),
nodups([X31,X32,X33,X34,X35,X36,X37,X38,X39]),
nodups([X41,X42,X43,X44,X45,X46,X47,X48,X49]),
nodups([X51,X52,X53,X54,X55,X56,X57,X58,X59]),
nodups([X61,X62,X63,X64,X65,X66,X67,X68,X69]),
nodups([X71,X72,X73,X74,X75,X76,X77,X78,X79]),
nodups([X81,X82,X83,X84,X85,X86,X87,X88,X89]),
nodups([X91,X92,X93,X94,X95,X96,X97,X98,X99]),
nodups([X11,X21,X31,X41,X51,X61,X71,X81,X91]),
nodups([X12,X22,X32,X42,X52,X62,X72,X82,X92]),
nodups([X13,X23,X33,X43,X53,X63,X73,X83,X93]),
nodups([X14,X24,X34,X44,X54,X64,X74,X84,X94]),
nodups([X15,X25,X35,X45,X55,X65,X75,X85,X95]),
nodups([X16,X26,X36,X46,X56,X66,X76,X86,X96]),
nodups([X17,X27,X37,X47,X57,X67,X77,X87,X97]),
nodups([X18,X28,X38,X48,X58,X68,X78,X88,X98]),
nodups([X19,X29,X39,X49,X59,X69,X79,X89,X99]),
nodups([X11,X12,X13,X21,X22,X23,X31,X32,X33]),
nodups([X41,X42,X43,X51,X52,X53,X61,X62,X63]),
nodups([X71,X72,X73,X81,X82,X83,X91,X92,X93]),
nodups([X14,X15,X16,X24,X25,X26,X34,X35,X36]),
nodups([X44,X45,X46,X54,X55,X56,X64,X65,X66]),
nodups([X74,X75,X76,X84,X85,X86,X94,X95,X96]),
nodups([X17,X18,X19,X27,X28,X29,X37,X38,X39]),
nodups([X47,X48,X49,X57,X58,X59,X67,X68,X69]),
nodups([X77,X78,X79,X87,X88,X89,X97,X98,X99]).
nodups([]).
nodups([X|Xs]) :-
not_contains(Xs, X),
nodups(Xs).
not_contains([], _).
not_contains([Y|Ys], X) :-
X \== Y,
not_contains(Ys, X).
checked_between([], _, _, _).
checked_between([X|Xs], L, H, Check) :-
between(L, H, X),
call(Check),
checked_between(Xs, L, H, Check).
between(L, H, L) :- L =< H.
between(L, H, X) :-
L < H,
L1 is L+1,
between(L1, H, X).