(* Cette fonction permet de construire des matrices à partir du constructeur d'un type et non pas d'un objet de ce type *)
let make_matrix_bis a b t=
	let m = make_vect a (make_vect b (t ())) in
	for i = 0 to a-1 do
		m.(i) <- make_vect b (t ());
		for j = 0 to b-1 do
			m.(i).(j) <- t ()
		done
	done;
	m;;

let n = 3;;
let nn = n*n;;

type possib_c = {mutable nb_possib : int; possib : int vect};;
type case_c   = {mutable valeur : int; pos : possib_c};;
type sudok_c  = {jeu : case_c vect vect;mutable nb_void : int ; ligne : case_c vect vect ; colonne : case_c vect vect ; carre : case_c vect vect};;

let r_MODIF=2 and r_NO_MODIF=1 and r_ERROR=0;;

let make_possib () = {nb_possib=nn;possib=make_vect nn 1};;
let make_case   () = {valeur=(-1);pos=make_possib ()};;
let make_sudok  () = {jeu=make_matrix_bis nn nn make_case;nb_void=nn*nn;ligne=make_matrix_bis nn nn make_case;colonne=make_matrix_bis nn nn make_case;carre=make_matrix_bis nn nn make_case};;

(* indique si la case (i,j) est libre *)
let is_free c=
	c.valeur=(-1);;

let is_free_cas s i j =
	is_free s.jeu.(i).(j);;
let is_free_lig s i j =
	is_free s.ligne.(i).(j);;
let is_free_col s i j =
	is_free s.colonne.(i).(j);;
let is_free_car s i j =
	is_free s.carre.(i).(j);;

(* renvoie une valeur que l'on peut mettre sur la case (i,j) *)
let get_pos p =
	let rec g_p l =
		if l=nn then -1
		else if p.(l)=1 then l
		else g_p (l+1)
	in g_p 0;;

let get_pos_cas s i j =
	(get_pos s.jeu.(i).(j).pos.possib) + 1;;
let get_pos_lig s i j =
	(get_pos s.ligne.(i).(j).pos.possib);;
let get_pos_col s i j =
	(get_pos s.colonne.(i).(j).pos.possib);;
let get_pos_car s i j =
	(get_pos s.carre.(i).(j).pos.possib);;

(* rend impossible l'utilisation de la valeur t sur la case (i,j) ainsi que sur les colonne, ligne et carré auxquelles elle appartient. *)
let remove p t =
	let r = p.possib.(t) in begin
		if r=1 then p.nb_possib <- p.nb_possib-1;
		p.possib.(t) <- r-1
	end;;
let remove_cas s i j t =
	remove s.jeu.(i).(j).pos (t-1);;
let remove_lig s i j t =
	remove s.ligne.(i).(t-1).pos j;;
let remove_col s i j t =
	remove s.colonne.(j).(t-1).pos i;;
let remove_car s i j t =
	remove s.carre.(i).(t-1).pos j;;

let remove_all s i j t =
	remove_cas s i j t;
	remove_lig s i j t;
	remove_col s i j t;
	remove_car s ((i/n)*n+(j/n)) ((i mod n)*n+(j mod n)) t;;

(* assigne la valeur t à la case (i,j) *)
let assign s i j t=
	for m = 0 to nn-1 do
		remove_all s i m t;
		remove_all s m j t;
		remove_all s i j (m+1);
		remove_all s ((i/n)*n+(m mod n)) ((j/n)*n+(m/n)) t
	done;
	s.jeu.(i).(j).valeur <- t;
	s.ligne.(i).(t-1).valeur <- j;
	s.colonne.(j).(t-1).valeur <- i;
	s.carre.((i/n)*n+(j/n)).(t-1).valeur <- ((i mod n)*n+(j mod n));
	s.nb_void <- s.nb_void-1;;

let print v = 
	if v=2 then print_string "r_MODIF "
	else if v=1 then print_string "r_NO_MODIF "
	else print_string "r_ERROR ";;

let get_sup s =
	let rec boucle_i_j i j =
		if i=nn then (nn+1,0,0)
		else if j=nn then boucle_i_j (i+1) 0
		else let m=s.jeu.(i).(j).pos.nb_possib in
			if m = 2 then (2,i,j)
			else if m<2 then boucle_i_j i (j+1)
			else let (mm,ii,jj)=boucle_i_j i (j+1) in
				if mm<2 then (m,i,j)
				else if mm<m then (mm,ii,jj)
				else (m,i,j)
	in
	let (_,i,j)=boucle_i_j 0 0 in (i,j);;

let copy_case from toto =
	toto.valeur <- from.valeur;
	toto.pos.nb_possib <- from.pos.nb_possib;
	for i = 0 to nn-1 do
		toto.pos.possib.(i) <- from.pos.possib.(i)
	done;;

let copy_su from toto =
	toto.nb_void <- from.nb_void;
	for i = 0 to nn-1 do
		for j = 0 to nn-1 do
			copy_case from.jeu.(i).(j) toto.jeu.(i).(j);
			copy_case from.ligne.(i).(j) toto.ligne.(i).(j);
			copy_case from.colonne.(i).(j) toto.colonne.(i).(j);
			copy_case from.carre.(i).(j) toto.carre.(i).(j)
		done
	done;;

(* résoud le sudoku avec les 3 heuristiques principales *)
let rec solve s =
	let rec boucle_i_j i j =
		let m_case () =
			if (is_free_cas s i j) then
				let nb = s.jeu.(i).(j).pos.nb_possib in
				if nb = 0 then r_ERROR
				else if nb=1 then (assign s i j (get_pos_cas s i j);r_MODIF)
				else r_NO_MODIF
			else r_NO_MODIF in
		let m_ligne () =
			if (is_free_lig s i j) then
				let nb = s.ligne.(i).(j).pos.nb_possib in
				if nb = 0 then r_ERROR
				else if nb=1 then (assign s i (get_pos_lig s i j) (j+1);r_MODIF)
				else r_NO_MODIF
			else r_NO_MODIF in
		let m_colonne () =
			if (is_free_col s i j) then
				let nb = s.colonne.(i).(j).pos.nb_possib in
				if nb = 0 then r_ERROR
				else if nb=1 then (assign s (get_pos_col s i j) i (j+1);r_MODIF)
				else r_NO_MODIF
			else r_NO_MODIF in
		let m_carre () =
			if (is_free_car s i j) then
				let nb = s.carre.(i).(j).pos.nb_possib in
				if nb = 0 then r_ERROR
				else if nb=1 then let p=get_pos_car s i j in
					(assign s ((i/n)*n+(p/n)) ((i mod n)*n+(p mod n)) (j+1);r_MODIF)
				else r_NO_MODIF
			else r_NO_MODIF
		in
		if i=nn then r_NO_MODIF
		else if j=nn then boucle_i_j (i+1) 0
		else let val = (m_case ())*(m_ligne ())*(m_colonne ())*(m_carre ()) in
			if val =r_ERROR then r_ERROR
			else if val=r_NO_MODIF then boucle_i_j i (j+1)
			else (boucle_i_j i (j+1);r_MODIF)
	in
	let res=ref r_MODIF in
	while !res = r_MODIF do
		res:=boucle_i_j 0 0
	done;
	if s.nb_void=0 then true
	else let (i,j)=get_sup s and tmp=make_sudok () in begin
		copy_su s tmp;
		assign tmp i j (get_pos_cas s i j);
		if solve tmp then
			(copy_su tmp s;true)
		else begin
			remove_all s i j (get_pos_cas s i j);
			solve s
		end
	end;;

let print_s s =
	print_newline ();
	for i = 0 to nn-1 do
		for j = 0 to nn-1 do
			if is_free_cas s i j then
				print_char `.`
			else
				print_int s.jeu.(i).(j).valeur;
			print_char ` `
		done;
		print_newline ()
	done;;


let main () =
	let su=make_sudok() in begin
		assign su 0 2 5;
		assign su 0 6 7;
		assign su 1 4 2;
		assign su 1 5 4;
		assign su 1 7 9;
		assign su 2 0 7;
		assign su 2 7 1;
		assign su 3 1 8;
		assign su 3 3 2;
		assign su 3 5 7;
		assign su 4 4 4;
		assign su 4 5 9;
		assign su 4 8 6;
		assign su 5 1 9;
		assign su 5 3 6;
		assign su 5 4 5;
		assign su 5 7 7;
		assign su 7 0 8;
		assign su 7 1 4;
		assign su 7 2 7;
		assign su 7 4 1;
		assign su 8 0 1;
		assign su 8 5 8;
		assign su 8 6 5;
		assign su 8 8 3;

		print_s su;
		let start=sys__time() in
		let s=solve su in
		let temps=sys__time()-.start in begin
			print_s su;
			if s then
				print_string "Sudoku résolu en "
			else
				print_string "Sudoku non résolu en ";
			print_float temps;
			print_string "s"
		end
	end;;

main ();;







(*
SUDO 1 : facile (ne nécessite que la recherche par case ).

let su=make_sudok();;
begin
assign su 0 0 8;
assign su 0 2 7;
assign su 0 4 9;
assign su 0 6 4;
assign su 1 0 9;
assign su 1 1 2;
assign su 1 3 5;
assign su 1 7 8;
assign su 2 0 5;
assign su 3 0 2;
assign su 3 1 9;
assign su 3 6 5;
assign su 3 7 6;
assign su 4 6 3;
assign su 5 1 8;
assign su 5 4 1;
assign su 5 6 9;
assign su 5 8 4;
assign su 6 1 1;
assign su 6 2 2;
assign su 6 4 8;
assign su 7 0 7;
assign su 7 1 5;
assign su 7 3 1;
assign su 7 5 9;
assign su 8 0 3;
assign su 8 3 7;
assign su 8 8 2
end;;


SUDO 2 : moyen (nécessite la recherche par case ainsi que par ligne, colonne et carré).
let su=make_sudok();;
begin
assign su 0 0 4;
assign su 0 2 8;
assign su 0 3 2;
assign su 0 4 9;
assign su 0 8 5;
assign su 1 0 7;
assign su 2 5 3;
assign su 3 4 1;
assign su 3 5 6;
assign su 3 7 7;
assign su 3 8 4;
assign su 4 6 8;
assign su 5 2 9;
assign su 5 7 1;
assign su 6 0 5;
assign su 6 3 1;
assign su 6 8 8;
assign su 7 3 8;
assign su 7 5 4;
assign su 7 6 2;
assign su 7 7 9;
assign su 8 1 4;
assign su 8 5 2;
assign su 8 7 6
end;;


SUDO 3 : difficile (nécessite toutes les heuristiques (dont les supposition)).

let su=make_sudok();;
begin
assign su 0 2 5;
assign su 0 6 7;
assign su 1 4 2;
assign su 1 5 4;
assign su 1 7 9;
assign su 2 0 7;
assign su 2 7 1;
assign su 3 1 8;
assign su 3 3 2;
assign su 3 5 7;
assign su 4 4 4;
assign su 4 5 9;
assign su 4 8 6;
assign su 5 1 9;
assign su 5 3 6;
assign su 5 4 5;
assign su 5 7 7;
assign su 7 0 8;
assign su 7 1 4;
assign su 7 2 7;
assign su 7 4 1;
assign su 8 0 1;
assign su 8 5 8;
assign su 8 6 5;
assign su 8 8 3
end;;



*)