Yet another sudoku solver (838 bytes)

[Marco Maggesi <maggesi@math.unice.fr>]

While we are there, this is my soduku solver.  It is not as efficient
as the other solver proposed in this list, but it takes a fraction of
seconds to compute a solution on a P4 anyway.

Perhaps, the distinguishing feature of this implementation is that it
uses higher order functions in an essential way (that is, the
accumulator argument of the "fold" in the body of "search" is a
function).  And it is only 838 of code of clear (?) and concise code.

BTW, now that we have so many sudoku solvers, wouldn't be be nice to
have one with a computer certified implementation?

Marco

------------------------------------------------------------

Instructions:

  $ ocamlopt -o sudoku sudoku.ml
  
  $ cat schema
  0 6 0 1 0 0 0 5 0
  0 0 8 3 0 5 6 0 0
  2 0 0 0 0 0 0 0 1
  8 0 0 4 0 7 0 0 6
  0 0 6 0 0 0 3 0 0
  7 0 0 9 0 1 0 0 4
  5 0 0 0 0 0 0 0 2
  0 0 7 0 0 6 9 0 0
  0 4 0 0 0 8 0 7 0

  $ ./sudoku < schema
  9 6 3 1 7 4 2 5 8
  1 7 8 3 2 5 6 4 9
  2 5 4 6 8 9 7 3 1
  8 2 1 4 3 7 5 9 6
  4 9 6 8 5 2 3 1 7
  7 3 5 9 6 1 8 2 4
  5 8 9 7 1 3 4 6 2
  3 1 7 2 4 6 9 8 5
  6 4 2 5 9 8 1 7 3



------------------- 8< ----------------------------------- 8<  -------
include Set.Make(struct type t = (int * int) * int let compare = compare end)
 
let (@) g f x = g (f x) and id x = x and sw f x y = f y x and zip x y = (x, y)
 
let fold9 f = let rec loop i = if i>8 then id else loop (i+1) @ f i in loop 0
 
let fold81 f = fold9 (fold9 @ (@) f @ zip)
 
let mark ((i,j),x as e) : t -> t =
  add e @ fold9 (fun k -> remove ((i/3*3 + k/3, j/3*3 + k mod 3), x) @
    remove ((i,j),k) @ remove ((i,k),x) @ remove ((k,j),x))
 
let search =
  let g p f s = fold (f @ sw mark s) (filter ((=) p @ fst) s) in
  fold81 g
 
let read () =
  let f p = Scanf.scanf "%d " (fun x -> if x>0 then mark (p,x-1) else
  id) in
  fold81 f (fold81 (fold9 @ ((@) add @ zip)) empty)
 
let print s () =
  let pr ((i,j),x) = Printf.printf "%d%c" (x+1) (if j=8 then '\n' else ' ') in
  iter pr s; print_newline ();;
 
search print (read ()) ();;