exception Erreur;;
exception Essai;;
exception Fin;;
exception Trouvé;;

let rec print_list l = match l with
    t :: r -> print_char t; print_list r;
    | [] -> print_string " | "
;;

let imprime t =
Printf.printf "\nRésultat:
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c\n"
(List.hd t.(0).(0)) (List.hd t.(0).(1)) (List.hd t.(0).(2)) (List.hd t.(0).(3)) (List.hd t.(0).(4)) (List.hd t.(0).(5)) (List.hd t.(0).(6)) (List.hd t.(0).(7)) (List.hd t.(0).(8))
(List.hd t.(1).(0)) (List.hd t.(1).(1)) (List.hd t.(1).(2)) (List.hd t.(1).(3)) (List.hd t.(1).(4)) (List.hd t.(1).(5)) (List.hd t.(1).(6)) (List.hd t.(1).(7)) (List.hd t.(1).(8)) 
(List.hd t.(2).(0)) (List.hd t.(2).(1)) (List.hd t.(2).(2)) (List.hd t.(2).(3)) (List.hd t.(2).(4)) (List.hd t.(2).(5)) (List.hd t.(2).(6)) (List.hd t.(2).(7)) (List.hd t.(2).(8))
(List.hd t.(3).(0)) (List.hd t.(3).(1)) (List.hd t.(3).(2)) (List.hd t.(3).(3)) (List.hd t.(3).(4)) (List.hd t.(3).(5)) (List.hd t.(3).(6)) (List.hd t.(3).(7)) (List.hd t.(3).(8))
(List.hd t.(4).(0)) (List.hd t.(4).(1)) (List.hd t.(4).(2)) (List.hd t.(4).(3)) (List.hd t.(4).(4)) (List.hd t.(4).(5)) (List.hd t.(4).(6)) (List.hd t.(4).(7)) (List.hd t.(4).(8))
(List.hd t.(5).(0)) (List.hd t.(5).(1)) (List.hd t.(5).(2)) (List.hd t.(5).(3)) (List.hd t.(5).(4)) (List.hd t.(5).(5)) (List.hd t.(5).(6)) (List.hd t.(5).(7)) (List.hd t.(5).(8))
(List.hd t.(6).(0)) (List.hd t.(6).(1)) (List.hd t.(6).(2)) (List.hd t.(6).(3)) (List.hd t.(6).(4)) (List.hd t.(6).(5)) (List.hd t.(6).(6)) (List.hd t.(6).(7)) (List.hd t.(6).(8))
(List.hd t.(7).(0)) (List.hd t.(7).(1)) (List.hd t.(7).(2)) (List.hd t.(7).(3)) (List.hd t.(7).(4)) (List.hd t.(7).(5)) (List.hd t.(7).(6)) (List.hd t.(7).(7)) (List.hd t.(7).(8))
(List.hd t.(8).(0)) (List.hd t.(8).(1)) (List.hd t.(8).(2)) (List.hd t.(8).(3)) (List.hd t.(8).(4)) (List.hd t.(8).(5)) (List.hd t.(8).(6)) (List.hd t.(8).(7)) (List.hd t.(8).(8));;


let rec except e l1 = match l1 with
    | [] -> []
    | t :: q -> if t = e then except e q else t :: except e q
;;

let copie t =
  let tt = Array.make_matrix 9 9 [] in
    for i = 0 to 8 do
      for j = 0 to 8 do
        tt.(i).(j) <- t.(i).(j);
      done;
    done;
    tt
;;

let rec réduis_aux t i j e =
  for k = 0 to 8 do
    if k <> j then
      begin
        let l1 = List.length (t.(i).(k)) in
          if l1 = 0 then raise Erreur
          else
            begin
              t.(i).(k) <- except e (t.(i).(k));
              let l2 = List.length (t.(i).(k)) in
                if l2 = 1 && l1 <> l2 then réduis_aux t i k (List.hd (t.(i).(k)));
            end;
      end;
    if k <> i then
      begin
        let l1 = List.length (t.(k).(j)) in
          if l1 = 0 then raise Erreur
          else
            begin
              t.(k).(j) <- except e (t.(k).(j));
              let l2 = List.length (t.(k).(j)) in
                if l2 = 1 && l1 <> l2 then réduis_aux t k j (List.hd (t.(k).(j)));
            end;
      end;
  done;
  let p = i / 3 * 3 and q = j / 3 * 3 in
    for u = p to p + 2 do
      for v = q to q + 2 do
        if u <> i && v <> j then
          begin
            let l1 = List.length (t.(u).(v)) in
              if l1 = 0 then raise Erreur
              else
                begin
                  t.(u).(v) <- except e (t.(u).(v));
                  let l2 = List.length (t.(u).(v)) in
                    if l2 = 1 && l1 <> l2 then réduis_aux t u v (List.hd (t.(u).(v)));
                end;
          end;
      done;
    done;
;;

let suivant t k =
  let m = ref 9 and n = ref (k + 1) in
    try
      for i = k + 1 to 80 do
        let l = List.length t.(i / 9).(i mod 9) in
          if l > 1 && l < !m then
            begin
              m := l;
              n := i;
              if l = 2 then raise Trouvé;
            end;
      done;
      !n
    with Trouvé -> !n
;;

let réduis t i j e =
  try
    réduis_aux t i j e;
  with Erreur -> ()
;;

let rec essai_erreur_aux f t k l = match l with
    h :: r -> let (i, j) = (k / 9, k mod 9) and tt = copie t in
          tt.(i).(j) <- [h];
          réduis tt i j h;
          f tt (suivant tt k);
          essai_erreur_aux f t k r;
    | [] -> ()
;;

let erreur t =
  try
    for i = 0 to 8 do
      for j = 0 to 8 do
        let l = List.length (t.(i).(j)) in
          if l = 0 then raise Erreur
      done;
    done;
  with Erreur -> raise Erreur
;;

let essai t =
  try
    for i = 0 to 8 do
      for j = 0 to 8 do
        let l = List.length (t.(i).(j)) in
          if l > 1 then raise Essai
      done;
    done;
  with Essai -> raise Essai
;;

let rec essai_erreur t k =
  try
    erreur t;
    essai t;
    imprime t;
    raise Fin;
  with Erreur -> ()
    | Essai -> essai_erreur_aux essai_erreur t (k mod 81) (t.((k mod 81) / 9).(k mod 9))
;;

let prepare t =
  for i = 0 to 8 do
    for j = 0 to 8 do
      if List.length (t.(i).(j)) = 1 then réduis_aux t i j (List.hd (t.(i).(j)));
    done;
  done;
;;

(* t est un tableau de listes d'entiers: au départ les cases connues du sudoku contiennent
une liste singleton  et les cases inconnues la liste complète [1;2;3;4;5;6;7;8;9] *)

let résous t =
  try
    prepare t;
    essai_erreur t 0;
    print_string "erreur dans sudoku";
    print_newline();
  with Fin -> ()
    | Erreur -> print_string "erreur dans sudoku";
        print_newline();
;;


let main() =
  print_string "Entrer un Sudoku:\n";
  flush stdout;
  let f = function
      | '-' -> ['1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9']
      | c -> [c]
  in
    let t = Scanf.scanf
      "%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c
%c %c %c %c %c %c %c %c %c\n"
      (fun
          a1 b1 c1 d1 p1 q1 r1 s1 t1
          a2 b2 c2 d2 p2 q2 r2 s2 t2
          a3 b3 c3 d3 p3 q3 r3 s3 t3
          a4 b4 c4 d4 p4 q4 r4 s4 t4
          a5 b5 c5 d5 p5 q5 r5 s5 t5
          a6 b6 c6 d6 p6 q6 r6 s6 t6
          a7 b7 c7 d7 p7 q7 r7 s7 t7
          a8 b8 c8 d8 p8 q8 r8 s8 t8
          a9 b9 c9 d9 p9 q9 r9 s9 t9
          ->
              [|
                [|f a1; f b1; f c1; f d1; f p1; f q1; f r1; f s1; f t1|];
                [|f a2; f b2; f c2; f d2; f p2; f q2; f r2; f s2; f t2|];
                [|f a3; f b3; f c3; f d3; f p3; f q3; f r3; f s3; f t3|];
                [|f a4; f b4; f c4; f d4; f p4; f q4; f r4; f s4; f t4|];
                [|f a5; f b5; f c5; f d5; f p5; f q5; f r5; f s5; f t5|];
                [|f a6; f b6; f c6; f d6; f p6; f q6; f r6; f s6; f t6|];
                [|f a7; f b7; f c7; f d7; f p7; f q7; f r7; f s7; f t7|];
                [|f a8; f b8; f c8; f d8; f p8; f q8; f r8; f s8; f t8|];
                [|f a9; f b9; f c9; f d9; f p9; f q9; f r9; f s9; f t9|]
              |]
      )
    in
      résous t
;;
  
main();;

(* Exemple de Sudoku: taper "enter" pour le résoudre *)
(*
- 3 - - - - 7 - -
2 - - - 3 - - - 6
9 4 1 - - 7 - 2 -
- - 9 - 1 - 6 - 8
- - - 3 - 9 - - -
4 - 3 - 5 - 2 - -
- 2 - 6 - - 5 7 3
1 - - - 7 - - - 4
- - 7 - - - - 6 -
*)

4 - - - 1 - - - -
- - 1 - - - - - -
- 5 7 6 - - - 1 -
- - - - - - 3 - 9
2 - - 7 5 - - - -
6 3 - - - 9 - 5 -
9 4 - - - - - - -
- - - - 4 - 2 - 7
- - 6 - 2 - 1 - -
