sudoku & FD

[Dr. David Alan Gilbert]

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   |_______/