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

let rank = 4
let chars = 
  match rank with
    | 4 -> "123456789ABCDEFG"
    | 5 -> "ABCDEFGHIJKLMNOPQRSTUVWXY"
    | _ -> assert false


let rank2 = rank * rank
let rank4 = rank2 * rank2

let bit_rank k =
  let rec aux i k = if (k = 1) then i else aux (succ i) (k lsr 1) in
  aux 0 k

(* 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_byte = Array.init 256 count_bits

let nb_bits n =
  nb_bits_byte.(n land 0xff) +
  nb_bits_byte.((n lsr 8) land 0xff) +
  nb_bits_byte.((n lsr 16) land 0xff) +
  nb_bits_byte.((n lsr 24) land 0xff)


(* 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 + rank2 * y


(* print a grid *)
let print a =
  for y = 0 to rank2 - 1 do
    for x = 0 to rank2 - 1 do
      let i = coord x y in
      if only_one_1 a.(i) then
	print_char chars.[bit_rank a.(i)]
      else
	print_char '.'
    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 rank2 (fun i -> a0.(bloc.(i))) in
  let rec check_digit k =
    if (k = rank2) then []
    else none_found (1 lsl k) k 0
  and none_found m k i =
    if (i = rank2) 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 = rank2) 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 rank2 and y = i0 / rank2 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 rank2 - 1 do f x y' done;
  for x' = 0 to rank2 - 1 do  f x' y done;
  let x0 = (x / rank) * rank and y0 = (y / rank) * rank in
  for x' = x0 to x0+(rank-1) do for y' = y0 to y0+(rank-1) 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 rank2 (fun y -> Array.init rank2 (fun x -> coord x y)); (* lines *)
  Array.init rank2 (fun x -> Array.init rank2 (fun y -> coord x y)); (* columns *)
  Array.init rank2 
    (fun i ->
       let x0 = (i mod rank) * rank
       and y0 = (i / rank) * rank in
       Array.init rank2 (fun j -> coord (x0 + (j mod rank)) (y0 + (j / rank)))
    )  (* 3x3 blocs *)
]

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

let least_var a =
  let cur_min = ref max_int and cur = ref (-1) in
  (try
  for i = 0 to rank4 - 1 do
    let n = nb_bits a.(i) in
    if n = 0 then raise Impossible;
    if (n = 2) then (cur := i; raise Exit);
    if (n > 1) && (n < !cur_min) then (cur_min := n; cur := i)
  done;
  with Exit -> ());
(*  Printf.printf "Remains %i\n" !rem; *)
(*  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 rank2 - 1 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 rank4 ((1 lsl rank2) - 1) in
  let placed = ref [] in
  for y = 0 to rank2 - 1 do
    let s = read_line () in
    for x = 0 to rank2 - 1 do
      match s.[x] with
	| '0' | '.' -> ()
	| c ->
	    let n = String.index chars c in
	    let i = coord x y in
	    a.(i) <- 1 lsl n;
	    placed := i :: !placed
    done;
  done;
  place_all a !placed;
  main_loop a