let any = [1;2;3;4;5;6;7;8;9]

(** Plateau de jeu: saisie, affichage et exemple *)

let input () =
  Printf.printf "Entrez un tableau par lignes de 9 chiffres.\n" ;
  Printf.printf "Utilisez 0 pour les cases inconnues.\n%!" ;
  let t =
    Array.init 3 (fun i -> Array.init 3
      (fun ii -> Array.init 3 (fun j -> Array.init 3 (fun jj -> any))))
  in
  for i = 0 to 2 do
    for ii = 0 to 2 do
      let l = input_line stdin in
        assert (String.length l = 9) ;
        for j = 0 to 2 do
          for jj = 0 to 2 do
            t.(i).(ii).(j).(jj) <-
              let i = int_of_string (String.make 1 l.[j*3+jj]) in
                if i>=1 then [i] else any
          done
        done
    done
  done ;
  t

let print t =
  Printf.printf "+---+---+---+\n" ;
  for i = 0 to 2 do
    for ii = 0 to 2 do
      print_char '|' ;
      for j = 0 to 2 do
        for jj = 0 to 2 do
          match t.(i).(ii).(j).(jj) with
            | [x] -> print_int x
            | []  -> print_char 'X'
            | _  -> print_char '.'
        done ;
        print_char '|'
      done ;
      print_newline ()
    done ;
    Printf.printf "+---+---+---+\n" ;
  done

let exemple =
  let t =
    Array.init 3 (fun i -> Array.init 3
      (fun ii -> Array.init 3 (fun j -> Array.init 3 (fun jj -> any))))
  in
    t.(0).(0).(0).(0) <- [5] ;
    t.(0).(0).(0).(2) <- [4] ;
    t.(0).(0).(2).(2) <- [1] ;

    t.(0).(1).(0).(2) <- [6] ;
    t.(0).(1).(1).(0) <- [4] ;
    t.(0).(1).(2).(1) <- [7] ;

    t.(0).(2).(1).(0) <- [6] ;
    t.(0).(2).(1).(2) <- [8] ;

    t.(1).(0).(1).(1) <- [5] ;
    t.(1).(0).(2).(1) <- [1] ;

    t.(1).(2).(0).(0) <- [8] ;
    t.(1).(2).(0).(1) <- [3] ;
    t.(1).(2).(1).(1) <- [2] ;

    t.(2).(0).(1).(0) <- [9] ;
    t.(2).(0).(1).(2) <- [4] ;

    t.(2).(1).(0).(1) <- [4] ;
    t.(2).(1).(1).(2) <- [7] ;
    t.(2).(1).(2).(0) <- [6] ;

    t.(2).(2).(0).(0) <- [2] ;
    t.(2).(2).(2).(0) <- [8] ;
    t.(2).(2).(2).(2) <- [9] ;

    (* Ceux du dessus devraient suffir, avec des méthodes plus avancées..
     * Gros coup de bol si on ajoute celui là en plus on s'en sort avec
     * nos deux étapes de déduction *)
    t.(0).(1).(0).(0) <- [1] ;
    t

(** Manipulation d'ensembles de possibilités *)

let intersect a b = List.filter (fun e -> List.mem e b) a
let complem l     = List.filter (fun e -> not (List.mem e l)) any

(** Iteration sur les lignes/colonnes/blocs *)

let iter_col (j,jj) f =
  for i = 0 to 2 do
    for ii = 0 to 2 do
      f i ii j jj
    done
  done

let iter_line (i,ii) f =
  for j = 0 to 2 do
    for jj = 0 to 2 do
      f i ii j jj
    done
  done

let iter_block (i,j) f =
  for ii = 0 to 2 do
    for jj = 0 to 2 do
      f i ii j jj
    done
  done

(** Une étape de résolution *)

type choix = None | One of (int*int*int*int) | Many

let deduce t =

  (* Notons si on arrive à déduire de nouvelles infos *)
  let progress = ref false in

  (** Première étape de déduction: éliminer les choix déja pris *)
  let narrow iter =
    (* Liste des choix restants dans le groupement *)
    let remaining =
      let decided = ref [] in
        iter (fun i ii j jj -> decided :=
                match t.(i).(ii).(j).(jj) with
                  | [] -> assert false
                  | [e] -> e::!decided
                  | _ -> !decided) ;
        complem !decided
    in
      iter (fun i ii j jj ->
              let v = t.(i).(ii).(j).(jj) in
                if List.length v > 1 then begin
                  t.(i).(ii).(j).(jj) <- intersect remaining v ;
                  if t.(i).(ii).(j).(jj) <> v then progress := true
                end)
  in

  (** Second procédé: quand un choix n'est plus possible que sur une case *)
  let force iter =
    let all = Array.make 9 None in
      iter (fun i ii j jj ->
              let l = t.(i).(ii).(j).(jj) in
                List.iter
                  (fun c ->
                     all.(c-1) <- match all.(c-1) with
                       | None -> One (i,ii,j,jj)
                       | _ -> Many)
                  l) ;
      for c = 1 to 9 do
        match all.(c-1) with
          | One (i,ii,j,jj) -> t.(i).(ii).(j).(jj) <- [c]
          | _ -> ()
      done
  in

  (** Appliquer les deux méthodes à tous les groupements *)
  let both iter = narrow iter ; force iter in
    for a = 0 to 2 do
      for b = 0 to 2 do
        both (iter_col (a,b)) ;
        both (iter_line (a,b)) ;
        both (iter_block (a,b))
      done
    done ;
    !progress

let auboulot t = while deduce t do Printf.printf "J'ai du nouveau...\n" done

let test =
  print exemple ;
  auboulot exemple ;
  print exemple