let rec somme_h arr i j =
  if j<0 then 0 else
  if arr.(i).(j)=0 then 0 else
  arr.(i).(j) + somme_h arr i (j-1);;

let rec somme_v arr i j =
  if i<0 then 0 else
  if arr.(i).(j)=0 then 0 else
  arr.(i).(j) + somme_v arr (i-1) j;;

let crds k =
  k / 7, k mod 7;;

let init () =
  let arr = Array.make 9 4 in 
  arr.(0) <- 32; arr;;

let retire arr i =
  if arr.(i) <= 0 then failwith "illégal" else
  arr.(i) <- arr.(i)-1; arr.(0) <- arr.(0)-1;;

let ajoute arr i =
  arr.(i) <- arr.(i)+1; arr.(0) <- arr.(0)+1;;

let possible gr jt (i, j) k =
  gr.(i).(j) <- 1;
  let opts = List.init
    (min 9 (k + 2 - max (somme_h gr i j) (somme_v gr i j)))
    (fun i -> i)
  in gr.(i).(j) <- 0; List.filter (fun i -> i=0 || jt.(i) > 0) opts;;

let resout kmax =
  let gr = Array.make_matrix 7 7 0 in
  let jt = init () in
  let rec solve k =
    if jt.(0) = 0 then Some gr else
    if k = 49 then None else
    let i, j = crds k in
    let opts = possible gr jt (i, j) kmax in
    let rec teste = function
      | [] -> gr.(i).(j) <- 0; None
      | h::t -> gr.(i).(j) <- h;
                if h>0 then retire jt h;
                match solve (k+1) with
                  | Some arr -> Some arr
                  | None -> ajoute jt h; teste t
    in teste (List.rev opts)
  in solve 0;;

let disp tab =
  for i=0 to Array.length tab - 1 do
    Array.iter (fun i -> print_int i; print_string " ") tab.(i);
    print_newline ()
  done;;

match resout 10 with
  | None -> print_string "Pas de solution !\n"
  | Some tab -> disp tab;;

(* Détermine le nombre de zones différentes *)

let nb_zones grp =
  Array.fold_left max 0
    (Array.map (Array.fold_left max 0) grp) + 1;;

(* Détermine, pour chaque zone, les valeurs 
   qu'il reste à mettre (non présentes) *)

let prepare grp ind =
  let n = nb_zones grp in
  let tailles = Array.make n 0 
  and vus = Array.make n [] in
  for i = 0 to Array.length grp - 1 do
    for j = 0 to Array.length grp.(i) - 1 do
      let zone = grp.(i).(j) in
      tailles.(zone) <- tailles.(zone) + 1;
      match ind.(i).(j) with
        | 0 -> ()
        | v -> vus.(zone) <- v::vus.(zone)
    done;
  done;
  let rec diff k lst = 
    if k = 0 then [] else match lst with
      | t::q when t=k -> diff (k-1) q
      | lst -> k::diff (k-1) lst
  in
  let res = Array.make n [] in
  for zone = 0 to n-1 do
    res.(zone) <- diff (tailles.(zone))
                       (List.rev (List.sort compare vus.(zone)))
  done;
  res;;

(* Vérifie si l'on peut placer v ligne i colonne j *)

let possible tab i j v =
  let res = ref true in
  for i' = i-1 to i+1 do
    for j' = j-1 to j+1 do
      if i'>=0 && i'<Array.length tab 
         && j'>=0 && j' <Array.length tab.(i')
         && tab.(i').(j') = v
      then res := false
    done;
  done;
  !res;;

(* Cf cours, extraction des éléments d'une liste *)

let rec extrait = function
  | [] -> []
  | t::q -> (t, q)::List.map
      (fun (t2, q2) -> (t2, t::q2)) (extrait q);;

(* Retour sur trace ! *)

let solution grp ind =
  let restants = prepare grp ind in
  let h = Array.length grp 
  and l = Array.length grp.(0) in
  let rec explore k =
    if k = h*l then Some ind else
    let i, j = k/l, k mod l in
    let zone = grp.(i).(j) in
    if ind.(i).(j) > 0 then explore (k+1) else
    let dispos = restants.(zone) in
    let options = extrait dispos in
    let rec teste = function
      | [] -> ind.(i).(j) <- 0;
              restants.(zone) <- dispos;
              None
      | (v, rst)::q -> 
           if not (possible ind i j v)
             then teste q
             else begin
               ind.(i).(j) <- v;
               restants.(zone) <- rst;
               match explore (k+1) with
                 | Some arr -> Some arr
                 | None -> teste q
             end
    in teste options
  in explore 0;;

(* Test... *)

let grp = [|[|0; 1; 2; 2; 2; 3; 3|];
            [|0; 1; 2; 2; 4; 3; 3|];
            [|0; 1; 1; 1; 4; 3; 3|];
            [|0; 0; 1; 1; 4; 5; 3|];
            [|0; 6; 6; 6; 5; 5; 7|];
            [|8; 6; 6; 5; 5; 5; 7|];
            [|8; 8; 6; 6; 9; 5; 10|];
            [|8; 8; 11; 11; 11; 11; 10|];
            [|12; 12; 11; 11; 11; 10; 10|]|];;

let ind = [|[|3; 0; 0; 0; 0; 2; 0|];
            [|4; 1; 0; 5; 0; 0; 7|];
            [|0; 0; 7; 0; 0; 6; 0|];
            [|2; 1; 0; 4; 0; 0; 5|];
            [|0; 7; 0; 0; 0; 7; 1|];
            [|0; 6; 0; 0; 0; 0; 0|];
            [|3; 0; 0; 0; 0; 0; 3|];
            [|0; 0; 0; 3; 0; 0; 0|];
            [|0; 0; 0; 6; 0; 2; 0|]|];;

let disp tab =
  for i=0 to Array.length tab - 1 do
    Array.iter (fun i -> print_int i; print_string " ") tab.(i);
    print_newline ()
  done;;

match solution grp ind with
  | None -> print_string "Pas de solution !\n"
  | Some tab -> disp tab;;