smock: add --overwrite option
[fedora-mingw.git] / ocaml / sudoku.ml
1 (* Jon Harrop's Sudoku Solver in 19 lines of code, from:
2  * http://www.ffconsultancy.com/ocaml/sudoku/index.html
3  *)
4
5 let m = Array.init 9 (fun _ -> input_line stdin)
6
7 let print() = Array.iter print_endline m
8
9 let rec invalid ?(i=0) x y n =
10   i<9 && (m.(y).[i] = n || m.(i).[x] = n ||
11       m.(y/3*3 + i/3).[x/3*3 + i mod 3] = n || invalid ~i:(i+1) x y n)
12
13
14 let rec fold f accu l u = if l=u then accu else fold f (f accu l) (l+1) u
15
16 let rec search ?(x=0) ?(y=0) f accu = match x, y with
17     9, y -> search ~x:0 ~y:(y+1) f accu (* Next row *)
18   | 0, 9 -> f accu                      (* Found a solution *)
19   | x, y ->
20       if m.(y).[x] <> '0' then search ~x:(x+1) ~y f accu else
21         fold (fun accu n ->
22                 let n = Char.chr (n + 48) in
23                 if invalid x y n then accu else
24                   (m.(y).[x] <- n;
25                    let accu = search ~x:(x+1) ~y f accu in
26                    m.(y).[x] <- '0';
27                    accu)) accu 1 10
28
29 let () = Printf.printf "%d solutions\n" (search (fun i -> print(); i+1) 0)