(* Displays all the solution for a sudoku grid.
   Author: Alain Frisch.

   The program reads a description of the problem on stdin.
   You must provide a grid like:

001005300
050490000
000102064
000000750
600000001
035000000
060903000
000020090
003600100

   Zero correspond to unknown digits to be guessed.

*)
   

exception Impossible
  (* Raised when a contradiction has been found *)

(* bit_rank (1 lsl k) = k for k=0..8 *)
let bit_rank =
  let a = Array.create 512 (-1) in
  for i = 0 to 8 do a.(1 lsl i) <- i done;
  fun i -> a.(i)

(* least_bit n keeps only the least significant 1 bit *)
let least_bit n = n land (lnot (n - 1))

(* is there exactly one 1 bit ? *)
let only_one_1 n = (n != 0) && (n == least_bit n)

(* number of 1 bits *)
let count_bits n =
  let rec loop i n =
    if n = 0 then i
    else loop (succ i) (n land lnot (least_bit n)) in
  loop 0 n

let nb_bits = Array.init 512 count_bits

(* The grid is represented by a one dimensional array with 81 cells.
   Each cell is a bit-mask of all the possible digits.

   coord returns the cell number given its coordinates. *)

let coord x y = x + 9 * y

(* print a grid *)
let print a =
  for y = 0 to 8 do
    for x = 0 to 8 do
      let i = coord x y in
      if only_one_1 a.(i) then
	print_char (Char.chr( 49 + bit_rank a.(i)))
      else
	print_char '.'
    done;
    print_newline ();
  done

(* print the number of possible choices for each cell *)
let print_var a =
  for y = 0 to 8 do
    for x = 0 to 8 do
      let i = coord x y in
      print_char (Char.chr (48 + nb_bits.(a.(i))))
    done;
    print_newline ();
  done



(* a bloc is a group of 9 cells such that each digit 0..8 must
   appear exactly once in this group of cells. The function sets
   digits according to this rule and returns the coordinates of
   the modified cells. A bloc is represented as a group of coordinates. *)
   
let find_in_bloc a0 bloc =
  let a = Array.init 9 (fun i -> a0.(bloc.(i))) in
  let rec check_digit k =
    if (k = 9) then []
    else none_found (1 lsl k) k 0
  and none_found m k i =
    if (i = 9) then raise Impossible
    else if (a.(i) land m != 0) then found_one m k i (succ i)
    else none_found m k (succ i)
  and found_one m k i0 i =
    if (i = 9) then 
      if a.(i0) != (1 lsl k) then 
	(a0.(bloc.(i0)) <- 1 lsl k; bloc.(i0)::(check_digit (succ k)))
      else check_digit (succ k)
    else if (a.(i) land m != 0) then check_digit (succ k)
    else found_one m k i0 (succ i)
  in
  check_digit 0


(* Assume that one cell has been resolved. Propagate the constraints.
   Accumulate in placed the set of freshly resolved cells. *)

let place a i0 placed =
  assert(only_one_1 a.(i0));
  let x = i0 mod 9 and y = i0 / 9 in
  let m = lnot a.(i0) in
  let f x' y' =
    let i = coord x' y' in
    let old = a.(i) in
    let n = old land m in
    if n = 0 then (if i == i0 then () else raise Impossible)
    else (if (only_one_1 n && (not (only_one_1 old))) 
	  then placed := i :: !placed;
	  a.(i) <- n)
  in
  for y' = 0 to 8 do f x y' done;
  for x' = 0 to 8 do  f x' y done;
  let x0 = (x / 3) * 3 and y0 = (y / 3) * 3 in
  for x' = x0 to x0+2 do for y' = y0 to y0+2 do f x' y' done done
  

let place_all a placed =
  let placed = ref placed in
  let rec loop () = match !placed with
    | i::rest -> placed := rest; place a i placed; loop ()
    | [] -> () in
  loop ()


let blocs = Array.concat [
  Array.init 9 (fun y -> Array.init 9 (fun x -> coord x y)); (* lines *)
  Array.init 9 (fun x -> Array.init 9 (fun y -> coord x y)); (* columns *)
  Array.init 9 
    (fun i ->
       let x0 = (i mod 3) * 3 
       and y0 = (i / 3) * 3 in
       Array.init 9 (fun j -> coord (x0 + (j mod 3)) (y0 + (j / 3)))
    )  (* 3x3 blocs *)
]

(* Find a cell whose number of remaining choices if minimal and >= 2 *)

let least_var a =
  let cur_min = ref 10 and cur = ref (-1) in
  for i = 0 to 80 do
    let n = nb_bits.(a.(i)) in
    if n = 0 then raise Impossible;
    if (n > 1) && (n < !cur_min) then (cur_min := n; cur := i)
  done;
(*  if !cur >= 0 then Printf.printf "Branching width %i\n" !cur_min; *)
  !cur

(* main_loop assume that all the constraints have been propagated *)

let rec main_loop a =
  (* Try to place digits in each blocs as long as possible *)
  while Array.fold_left 
    (fun changed bloc ->
       let p = find_in_bloc a bloc in
       if p != [] then (place_all a p; true)
       else changed) false blocs do () done;

  (* Find a cell to branch *)
  let i = least_var a in
  if (i < 0) then (print a; print_endline "---") (* This is a solution *)
  else
    for k = 0 to 8 do
      let m = 1 lsl k in
      if a.(i) land m <> 0 then
	(* Try with this digit *)
	try 
	  let a' = Array.copy a in
	  a'.(i) <- m;
	  place_all a' [i];
	  main_loop a'
	with Impossible -> ()
    done
  
let () =
  let a = Array.create 81 511 in
  let placed = ref [] in
  for y = 0 to 8 do
    let s = read_line () in
    for x = 0 to 8 do
      match s.[x] with
	| '0' -> ()
	| '1'..'9' as c ->
	    let i = coord x y in
	    a.(i) <- 1 lsl (Char.code c - 49);
	    placed := i :: !placed
	| _ -> failwith "Invalid input"
    done;
  done;
  place_all a !placed;
  main_loop a