module type TypeOrdonne =
  sig
    type t
    val compare : t -> t -> int
  end

module EntierOrdreNaturel:TypeOrdonne with type t = int =
  struct
    type t = int
    let compare = (-)
  end

module OrdreLexicographique:TypeOrdonne with type t = string =
  struct
    type t = string
    let compare x y = String.compare x y
  end

module type Ensemble =
  sig
    type element
    type abc
    val vide : abc
    val estVide : abc -> bool
    val estDans : element -> abc -> bool
    (* val inserer : element -> abc -> abc     *)
    (* val supprimer : element -> abc -> abc   *)
    (* val supprimerMax : abc -> element * abc *)
    (* val union : abc -> abc -> abc           *)
    (* val intersection : abc -> abc -> abc                         *)
    (* val difference : abc -> abc -> abc                           *)
    (* val differenceSym : abc -> abc -> abc                        *)
    (* val ensemble_vers_liste : abc -> element list                *)
    (* val liste_vers_ensemble  : element list -> abc               *)
    (* val est_inclus_dans : abc -> abc -> bool                     *)
    (* val est_egal : abc -> abc -> bool                            *)
    (* val appliquer_sur : (element -> 'a -> 'a) -> abc -> 'a -> 'a *)
    (* val card : abc -> int                                        *)
    (* val est_verifie_par_tous : (element -> bool) -> abc -> bool  *)
    (* val est_verifie_par_un : (element -> bool) -> abc -> bool    *)
    (* val filtrer_selon : (element -> bool) -> abc -> abc          *)
    (* val separer_selon : (element -> bool) -> abc -> abc * abc    *)
    (* val separer_selon_pivot : element -> abc -> abc * bool * abc *)
  end

module type CoupleHashMap =
	sig
		type clef
		val compClef : clef -> clef -> int
		type valeur
		val val_comp : valeur -> valeur -> int
		val hash : valeur -> clef
	end;;

module Couple : CoupleHashMap with type clef = int and type valeur = string =
	struct
		type clef = int
		type valeur = string

		let compClef = (-)

		let val_comp x y =
			match x with
				| x when x < y -> (-1)
				| x when x > y -> 1
				| x when x = y -> 0
				| _ -> failwith "erreur val_comp"

		let hash = String.length
	end

module MakeEnsemble (O : CoupleHashMap) : Ensemble  with type element = O.valeur =
  struct

		type element = O.valeur

		type couleur =
			| Rouge
			| Noir
			| DoubleNoir ;;

		type abcS =
			| VideS
			| VideNoirS
			| NoeudS of (element * couleur * abcS * abcS);;

    type abc =
			| Vide
			| VideNoir
			| Noeud of ((O.clef * abcS) * couleur * abc * abc);;

		let compC x y =
			O.compClef (O.hash x) (fst y);;

		let ($=$) x y = (compC x y = 0);;
    let ($<$) x y = (compC x y < 0);;
    let ($>$) x y = (compC x y > 0);;

		let compS x y =
			O.val_comp x y;;


    (* Noeud(x, _, ag, ad) {x} U ad U ag *)
    let vide = Vide

		let estVide = function
    	| Vide -> true
    	| _ -> false;;


    (* Un arbre est soit vide soit un noeud. Vide -> true est correct car si l'arbre est vide alors l'ensemble est vide.*)
    (* Si c'est un noeud alors il contient au moins x donc renvoie false *)
    let rec estDansS a x =
      match a with
        | VideS -> false
        | NoeudS(s, _, _, _) when compS s x == 0 -> true
        | NoeudS(s, _, ag, _) when compS s x == 0 -> estDansS ag x
        | NoeudS(s, _, _, ad) when compS s x == 0 -> estDansS ad x
        | _ -> failwith("Erreur compS");;

		let rec estDans x = function
    	| Vide -> false
      | Noeud(r, _, ag, _) when x $<$ r -> estDans x ag
      | Noeud(r, _, _, ad) when x $<$ r -> estDans x ad
      | Noeud(r, _, _, _) when x $=$ r  -> estDansS (snd r) x
			| _ -> failwith("Erreur estDans");;

		let rec pasDeuxRougesDeSuiteS a =
  		match a with
      	| VideS -> true
      	| NoeudS(_,Rouge,NoeudS(_,Rouge,_,_),_) -> false
      	| NoeudS(_,Rouge,_,NoeudS(_,Rouge,_,_)) -> false
    		| NoeudS(_,Rouge,sg,sd) -> pasDeuxRougesDeSuiteS sg && pasDeuxRougesDeSuiteS sd
    		| NoeudS(_,Noir,sg,sd) -> pasDeuxRougesDeSuiteS sg && pasDeuxRougesDeSuiteS sd;;

    let racineRouge = function
    	| Noeud(_, Rouge, _, _) -> true
    	| _ -> false;;

    let aUnFilsRouge = function
      | Noeud(_, _, ag, ad) -> racineRouge ag || racineRouge ad
      | _ -> false;;

    let rec pasDeuxRougesDeSuite = function
      | Noeud(_, Rouge, _, _) as ab when aUnFilsRouge ab -> false
      | Noeud(x, _, ag, ad) -> pasDeuxRougesDeSuite ag && pasDeuxRougesDeSuite ad && pasDeuxRougesDeSuiteS (snd x)
      | _ -> true;;