users-prolog
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

## sudoku & FD

 From: Dr. David Alan Gilbert Subject: sudoku & FD Date: Sun, 26 Dec 2004 02:01:47 +0000 User-agent: Mutt/1.5.6+20040907i

```Hi,
Is it a requirement to call fd_labeling to get the
minimum result set?

I seem to have spent Xmas day writing my first Prolog program
in many years; it solves the 'Su Doku' puzzles currently
running in the Times newspaper (and on www.sudoku.com).
(The fiendish holiday one they included took me about 4 hours
to solve with pen and paper - it has taken me longer to
write the program!).

I first wrote it using standard Prolog but it is VERY slow
and filling in about half the puzzle still takes it more
than half an hour to work out the rest on my 1.5GHz Athlon.

So I decided to try the constraint/fd stuff in gprolog and
this manages it in a few miliseconds - very nice.

One thing; it seems that it is a requirement to call
fd_labeling if you actually want it to try and find
the minimum constraints on all the values - this wasn't
obvious to me from the manual, although perhaps I just
missed it - this took me many hours to figure out.

As I say this is the first program I've written in
a long time in Prolog, so all comments welcome.

Thanks for your work on GNU Prolog!

Dave

{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}
/* (c) Dr. David Alan Gilbert (address@hidden)

This program solves the 'Su Doku' puzzles from
www.sudoku.com and as currently published in
The Times. (Apparently this is an old Japanese
puzzle that can have grids of any size).

It uses the Finite Domain solver facilities
in GNU Prolog.

(It is my first Prolog program for more than 10 years
so suggestions welcome).

26/12/2004

The puzzle is a 9x9 grid organised into 3x3 squares.
The rules are:
All rows must contain the digits 1..9 unrepeated
All columns must contain the digits 1..9 unrepeated
All 3x3 squares must contain the digits 1..9 unrepeated

Some of the puzzles can be rather good mental exercise!

Here is an example run:
| ?-
sudokufd([6,_,_,1,3,_,_,_,7,5,7,_,6,_,_,_,_,_,9,_,1,_,2,_,3,_,_,_,4,_,_,_,_,2,_,_,1,_,_,_,5,_,_,_,9,2,_,_,_,4,6,_,_,1,_,_,_,9,_,_,_,_,8,_,6,_,_,7,_,_,_,_,8,_,_,4,1,_,5,_,3]).
[6,2,4][1,3,5][9,8,7]
[5,7,3][6,8,9][4,1,2]
[9,8,1][7,2,4][3,5,6]
---------------------
[7,4,6][8,9,1][2,3,5]
[1,3,8][2,5,7][6,4,9]
[2,5,9][3,4,6][8,7,1]
---------------------
[4,1,5][9,6,3][7,2,8]
[3,6,2][5,7,8][1,9,4]
[8,9,7][4,1,2][5,6,3]

true ? ;

(4 ms) no

(I'm not sure if this one is hard on paper - I just used the program to make it
up).

*/

validSet(S) :-
fd_all_different(S).

/* See if a square is valid - takes 3 lists of 3 */
validSquare(A,B,C) :-
append(A,B,T1),
append(C,T1,T2),
validSet(T2).

/* Takes 9 lists of 3 and an integer index - checks a whole
* column */
validColumn([A,B,C,D,E,F,G,H,I],Index) :-
nth(Index, A, Ae), nth(Index, B, Be), nth(Index, C, Ce),
nth(Index, D, De), nth(Index, E, Ee), nth(Index, F, Fe),
nth(Index, G, Ge), nth(Index, H, He), nth(Index, I, Ie),
validSet([Ae,Be,Ce,De,Ee,Fe,Ge,He,Ie]).

/* Take in a 3 element list and spit out the elements individually */
split3list(In,A,B,C) :-
length(In,3),
nth(1,In,A),
nth(2,In,B),
nth(3,In,C).

/* Takes a list in, strips the first 9 elements off and returns
* them as 3 lists of 3 and another list with the remaining
* elements
*/
splitList39(In, Remains, Out1, Out2, Out3) :-
append(T1, Remains, In),
length(T1, 9),
append(Out1,T2 , T1), length(Out1,3),
append(Out2,Out3 , T2), length(Out2,3), length(Out3,3).

/* Write the result out in a format similar to the printed format */
writeResult(L) :-
splitList39(L, T1, A1,A2,A3),
splitList39(T1, T2, B1,B2,B3),
splitList39(T2, T3, C1,C2,C3),
splitList39(T3, T4, D1,D2,D3),
splitList39(T4, T5, E1,E2,E3),
splitList39(T5, T6, F1,F2,F3),
splitList39(T6, T7, G1,G2,G3),
splitList39(T7, T8, H1,H2,H3),
splitList39(T8, [], I1,I2,I3),
write(A1), write(A2), write(A3),nl,
write(B1), write(B2), write(B3),nl,
write(C1), write(C2), write(C3),nl,
write('---------------------'),nl,
write(D1), write(D2), write(D3),nl,
write(E1), write(E2), write(E3),nl,
write(F1), write(F2), write(F3),nl,
write('---------------------'),nl,
write(G1), write(G2), write(G3),nl,
write(H1), write(H2), write(H3),nl,
write(I1), write(I2), write(I3),nl.

/* Takes one list of 81 elements - rows then columns */
sudokufd(L) :-
fd_domain(L,1,9),
splitList39(L, T1, A1,A2,A3),
splitList39(T1, T2, B1,B2,B3),
splitList39(T2, T3, C1,C2,C3),
splitList39(T3, T4, D1,D2,D3),
splitList39(T4, T5, E1,E2,E3),
splitList39(T5, T6, F1,F2,F3),
splitList39(T6, T7, G1,G2,G3),
splitList39(T7, T8, H1,H2,H3),
splitList39(T8, [], I1,I2,I3),
/* Check rows */
append(A1,A2,At1), append(At1,A3,At2), validSet(At2),
append(B1,B2,Bt1), append(Bt1,B3,Bt2), validSet(Bt2),
append(C1,C2,Ct1), append(Ct1,C3,Ct2), validSet(Ct2),
append(D1,D2,Dt1), append(Dt1,D3,Dt2), validSet(Dt2),
append(E1,E2,Et1), append(Et1,E3,Et2), validSet(Et2),
append(F1,F2,Ft1), append(Ft1,F3,Ft2), validSet(Ft2),
append(G1,G2,Gt1), append(Gt1,G3,Gt2), validSet(Gt2),
append(H1,H2,Ht1), append(Ht1,H3,Ht2), validSet(Ht2),
append(I1,I2,It1), append(It1,I3,It2), validSet(It2),
/* Check squares */
validSquare(A1,B1,C1), validSquare(A2,B2,C2), validSquare(A3,B3,C3),
validSquare(D1,E1,F1), validSquare(D2,E2,F2), validSquare(D3,E3,F3),
validSquare(G1,H1,I1), validSquare(G2,H2,I2), validSquare(G3,H3,I3),
/* Check columns */
validColumn([A1,B1,C1,D1,E1,F1,G1,H1,I1],1),
validColumn([A1,B1,C1,D1,E1,F1,G1,H1,I1],2),
validColumn([A1,B1,C1,D1,E1,F1,G1,H1,I1],3),
validColumn([A2,B2,C2,D2,E2,F2,G2,H2,I2],1),
validColumn([A2,B2,C2,D2,E2,F2,G2,H2,I2],2),
validColumn([A2,B2,C2,D2,E2,F2,G2,H2,I2],3),
validColumn([A3,B3,C3,D3,E3,F3,G3,H3,I3],1),
validColumn([A3,B3,C3,D3,E3,F3,G3,H3,I3],2),
validColumn([A3,B3,C3,D3,E3,F3,G3,H3,I3],3),
fd_labeling(L),
writeResult(L).

{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}{<>}

-----Open up your eyes, open up your mind, open up your code -------
/ Dr. David Alan Gilbert    | Running GNU/Linux on Alpha,68K| Happy  \
\ gro.gilbert @ treblig.org | MIPS,x86,ARM,SPARC,PPC & HPPA | In Hex /
\ _________________________|_____ http://www.treblig.org   |_______/

```

reply via email to

 [Prev in Thread] Current Thread [Next in Thread]
• sudoku & FD, Dr. David Alan Gilbert <=