(*
Les commentaires sur l'utilisation des fonctions sont à la fin du programme.
Un dictionnaire utilisable par se programme se trouve sur mon site (http://wall.sectionpc.info) à la section divers.
*)

type mot == int list ;;
type dictBin = VideB | NoeudB of dictBin * int * dictBin;;

let lettre l =
	if l = -1 then print_newline ()
	else if l = 0 then print_char ` `
	else print_char (char_of_int (l - 1 + (int_of_char `a`)));;

let imprimer (m:mot) =
	let rec impr = function
		  []   -> ()
		| a::s -> impr s;lettre a in
	impr m;
	lettre (-1);;

let imprimerDict (dict:dictBin) =
	let rec impr (m:mot) = function
		  VideB            -> ()
		| NoeudB (ag,i,ad) ->
			if i=0 then imprimer m;
			impr (i::m) ag;
			impr m ad	in
	impr [] dict;;


let rec estDansDict (m:mot) (dict:dictBin) =
	match m,dict with
		  _,VideB                      -> false
		| [],NoeudB (_,i,ad)           ->
			if i=0 then true else estDansDict [] ad
		| a::s,NoeudB(ag,i,_) when i=a -> estDansDict s ag
		| m,NoeudB(_,_,ad)             -> estDansDict m ad;;


let rec ajoutADict (m:mot) (dict:dictBin) =
	match m,dict with
		  [],videB             -> NoeudB (VideB,0,VideB)
		| [],NoeudB (ag,i,ad)  ->
			if i=0 then NoeudB (ag,i,ad)
			else NoeudB (ag,i,ajoutADict [] ad)
		| a::s,VideB           -> NoeudB (ajoutADict s VideB,a,VideB)
		| a::s,NoeudB(ag,i,ad) ->
			if i=a then NoeudB(ajoutADict s ag,i,ad)
			else NoeudB(ag,i,ajoutADict (a::s) ad);;


let rec contient l = function
	  ([]:mot)   -> false
	| (a::s:mot) -> if a=l then true else contient l s;;	

let rec supprime l = function
	  ([]:mot)   -> []
	| (a::s:mot) -> if a=l then s else a::(supprime l s);;

let imprimerMotsDans (dict:dictBin) (l:mot) = 
	let rec recherche m = function
		  VideB,_    -> ()
		| NoeudB(ag,i,ad),l ->
			if i=0 then imprimer m else
			if contient i l then recherche (i::m) (ag,(supprime i l));
			recherche m (ad,l)	in
	recherche [] (dict,l);;

let imprimerAnagrammes (dict:dictBin) (l:mot) = 
	let rec recherche m = function
		  VideB,_    -> ()
		| NoeudB(_,i,ad),[] -> if i=0 then imprimer m else recherche m (ad,l)
		| NoeudB(ag,i,ad),l ->
			if i=0 then recherche (0::m) (dict,l) else
			if contient i l then recherche (i::m) (ag,(supprime i l));
			recherche m (ad,l)	in
	recherche [] (dict,l);;

let mot_of_string s =
	let rec m_o_s (accu:mot) i =
		if i=0 then accu
		else m_o_s (((int_of_char (nth_char s (i-1))) + 1 – (int_of_char `a`))::accu) (i-1) in
	m_o_s [] (string_length s);;



(* On crée ainsi un dictionnaire *)
let dictB=VideB;;
let dictB=ajoutADict (mot_of_string "ame") dictB;;
let dictB=ajoutADict (mot_of_string "ames") dictB;;
let dictB=ajoutADict (mot_of_string "amen") dictB;;
let dictB=ajoutADict (mot_of_string "amer") dictB;;
let dictB=ajoutADict (mot_of_string "ami") dictB;;
let dictB=ajoutADict (mot_of_string "amis") dictB;;
let dictB=ajoutADict (mot_of_string "amie") dictB;;
let dictB=ajoutADict (mot_of_string "amies") dictB;;
let dictB=ajoutADict (mot_of_string "ane") dictB;;
let dictB=ajoutADict (mot_of_string "anes") dictB;;
let dictB=ajoutADict (mot_of_string "annee") dictB;;
let dictB=ajoutADict (mot_of_string "annees") dictB;;


(* puis on peut l'afficher *)
imprimerDict dictB;;

(* Ou chercher des mots dedans *)
estDansDict (mot_of_string "ane") dictB;;
estDansDict (mot_of_string "am") dictB;;
estDansDict (mot_of_string "amit") dictB;;


(* Ou chercher tout les mots que l'on peut écrire avec des lettres données *)
imprimerMotsDans dictB (mot_of_string "aammeerriiccaa");;



(* On peut aussi créer ainsi le dictionnaire *)
let mots=["ecole"; "polytechnique"; "hellenique"; "type"; "coco"; "pole"; "cyclone"; "ethique"; "bonjour"; "poles"; "autre"; "colline"];;
let ajoutB (dict:dictBin) m = ajoutADict (mot_of_string m) dict;;
let dictB=it_list ajoutB VideB mots;;

(* Puis rechercher les anagrammes d'un mot *)
let u=mot_of_string "cceeeehillnoopqtuy";;
imprimerAnagrammes dictB u;;



(* et enfin on peut aussi charger un dictionnaire depuis un fichier *)
let file=open_in "mots.txt";;
let dictB= ref VideB;;

let L=(in_channel_length file)-3;;
while pos_in file<L do
dictB:=ajoutADictBin (motGD_of_string (input_line file)) (!dictB)
done;;

close_in file;;

(* Mais alors dictB est une référence *)