(* TP 13 - Arbres rouge noir *)

type couleur = R | B ;;

type arn = V | N of couleur * arn * int * arn ;;

let a0 = V;; (* ok *)
let a1 = N (R, N (B, V, 0, V), 3, N (B, V, 5, V));; (* non *)
let a2 = N (B, N (R, V, 0, V), 3, N (R, V, 5, V));; (* ok *)
let a3 = N (B, N (R, V, 0, V), 3, N (B, V, 5, V));; (* non *)
let a4 = N (B, N (B, V, 0, V), 3, N (B, V, 5, V));; (* ok *)
let a5 = N (B, N (B, V, 0, V), 3, N (R, N (B, V, 4, V), 5, V));; (* non *)
let a6 = N (B, N (B, V, 0, V), 3, N (R, N (B, V, 4, V), 5, N (B, V, 7, V)));; (* ok *)
let a7 = N (B, N (B, V, 0, V), 3, N (R, N (B, V, 4, V), 5, N (R, V, 7, N (B, V, 8, V) )));; (* non *)

(* Q14 *)
let valide a =
  let rec parcours a = match a with
    (* renvoie un booleen et la hauteur noire *)
    | V -> (true, 0)
    | N (R, N (R, _, _, _), _, _) | N (R, _, _, N (R, _, _, _)) -> (false, 0)
    | N (R, fg, _, fd) ->
        let (b1, h1) = parcours fg in
        let (b2, h2) = parcours fd in
        (b1 && b2 && h1 = h2, h1)
    | N (B, fg, _, fd) ->
        let (b1, h1) = parcours fg in
        let (b2, h2) = parcours fd in
        (b1 && b2 && h1 = h2, h1 + 1)
  in
  match a with
  | N (R, _, _ , _) -> false
  | _ -> fst (parcours a);;

(* pour ajouter les contraintes sur les étiquettes en une passe :
le parcours peut renvoyer la plus grande et la plus petite valeur
d'un arbre *)

assert (valide a0);;
assert (not (valide a1));;
assert (valide a2);;
assert (not (valide a3));;
assert (valide a4);;
assert (not (valide a5));;
assert (valide a6);;
assert (not (valide a7));;

(* Q15 *)
let rec hauteur_noire a = match a with
  | V -> 0
  | N (R, fg, _, _) -> hauteur_noire fg
  | N (B, fg, _, _)  -> 1 + hauteur_noire fg ;;

assert (hauteur_noire a6 = 2);;

(* Q16 *)
let rec hauteur a = match a with
  | V -> -1
  | N (_, fg, _, fd) -> 1 + max (hauteur fg) (hauteur fd) ;;
                             
assert (hauteur a7 = 3);;

(* Q18 *)
let rec rechercher a x = match a with
  | V -> false
  | N (_, fg, y, fd) ->
      if (x = y) then true
      else if (x < y) then rechercher fg x
      else rechercher fd x;;

(* Q19 *)
let correction_rr a = match a with
  | N (B, N(R, N(R, a, x, b), y, c), z, d)
  | N (B, N(R, a, z, N(R, b, x, c)), y, d)
  | N (B, a, x, N(R, N(R, b, y, c), z, d))
  | N (B, a, x, N(R, b, y, N(R, c, z, d)))
    -> N(R, N(B, a, x, b), y, N(B, c, z, d))
  | _ -> a;;

(* Q20 *)
let rec insere_rec a x = match a with
  | V -> N (R, V, x, V) (* correction inutile *)
  | N (c, fg, y, fd) when x < y -> correction_rr (N (c, insere_rec fg x, y, fd))
  | N (c, fg, y, fd) when y < x -> correction_rr (N (c, fg, y, insere_rec fd x))
  | _ -> a (* sans doublons ici *)

(* Q21 *)
let rec insere a x =
  let a2 = insere_rec a x in
  match a2 with
  | N (R, fg, y, fd) -> N (B, fg, y, fd) (* on noircit la racine rouge *)
  | _ -> a2
;;

(* Q23 *)
let arbre = ref V in
for i = 1 to 1000 do
  arbre := insere !arbre i
done;
assert (valide !arbre);
for i = 1 to 1000 do
  assert (rechercher !arbre i)
done;
Printf.printf "hn = %d, h = %d \n" (hauteur_noire !arbre) (hauteur !arbre)