type trie = Noeud of (bool * char * trie) list;;
type mot = char list;;
let trie_vide () = Noeud [];;


(* 1 *)

let rec appartient a m = match (a,m) with
(* Cas d'arret *)
|(Noeud [],_) -> false
|(_,[]) -> false
(* On lit la première lettre du mot *)
|(Noeud ((b,e,fils)::t),[c]) when e=c -> b
|(Noeud ((b,e,fils)::t),c::s) when e=c -> appartient fils s
(* On lit autre chose *)
|(Noeud ((b,e,fils)::t),c::s) when e<c -> appartient (Noeud t) m
|(Noeud ((b,e,fils)::t),c::s) when e>c -> false;;


(* 2 *) 

(* Le nombre de comparaisons de lettres est majore par k*h
   où h est la hauteur de l'arbre et k le nombre maximal
   d'enfants par noeud.
   Pour un arbre suffisamment équilibré, c'est donc de l'ordre
   de lg(N) où N est le nombre total de lettres (la somme des
   longueurs de chaque mot), au lieu de N² pour une liste !
   L'autre intérêt c'est l'espace occupé, qui est réduit du fait
   qu'on ne duplique pas inutilement les lettres communes. *) 


(* 3 *) 

let rec ajouter a m = match (a,m) with
|(_,[]) -> a
|(Noeud [],[c]) -> Noeud [true,c,Noeud []]
|(Noeud [],c::s) -> Noeud [false,c,(ajouter (Noeud []) s)]
|(Noeud ((b,e,fils)::t),[c]) when e=c -> Noeud ((true,e,fils)::t) (* Le cas à ne pas oublier *)
|(Noeud ((b,e,fils)::t),c::s) when e=c -> Noeud ((b,e,ajouter fils s)::t)
|(Noeud ((b,e,fils)::t),c::s) when e<c -> let Noeud l = ajouter (Noeud t) (c::s) in Noeud ((b,e,fils)::l)
|(Noeud l,c::s) -> let Noeud [n] = ajouter (Noeud []) (c::s) in Noeud (n::l);;

(* ca marche ! *)
let exemple = ref (trie_vide ());;
exemple := ajouter !exemple ['a';'s'];;
exemple := ajouter !exemple ['p';'o';'r';'t'];;
exemple := ajouter !exemple ['p';'o';'r';'e'];;
exemple := ajouter !exemple ['p';'r';'e'];;
exemple := ajouter !exemple ['p';'r';'e';'s'];;
exemple := ajouter !exemple ['p';'r';'e';'t'];;
exemple;;


(* 4 *)

let rec initialiser l = match l with
|[] -> trie_vide ()
|m::s -> ajouter (initialiser s) m;;

(* Ça marche en plus rapide *)
!exemple = initialiser ([['a';'s']; ['p';'o';'r';'t']; ['p';'o';'r';'e']; ['p';'r';'e']; ['p';'r';'e';'s']; ['p';'r';'e';'t']]);;


(* 5 *)

let rec compter a = match a with
|Noeud [] -> 0
|Noeud ((false,_,fils)::t) -> compter fils + compter (Noeud t)
|Noeud ((true,_,fils)::t) -> compter fils + compter (Noeud t) + 1;;

compter !exemple;;

(* 6 *)

let rec extraire a = match a with
|Noeud [] -> []
|Noeud ((false,_,Noeud [])::suite) -> extraire (Noeud suite) (* Ce cas n'est pas censé se produire *)
|Noeud ((true,c,Noeud [])::suite) -> [c]::(extraire (Noeud suite))
|Noeud ((false,c,Noeud l)::suite) -> (List.map (function m -> c::m) (extraire (Noeud l)))@(extraire (Noeud suite))
|Noeud ((true,c,Noeud l)::suite) -> ([c]::(List.map (function m -> c::m) (extraire (Noeud l))))@(extraire (Noeud suite));;

extraire !exemple;;


(* 7 *)

let rec est_triee (liste_noeuds : (bool*char*trie) list) = match liste_noeuds with
|[] -> true
|[(b,e,n)] -> true
|(b1,e1,n1)::(b2,e2,n2)::reste -> e1<e2 && est_triee ((b2,e2,n2)::reste);;

let p3 (a,b,c) = c;;

let rec valide (Noeud l) = (est_triee l) && (List.fold_left (&&) true (List.map valide (List.map p3 l)));;