type 'a rn =
  | V
  | N of 'a rn * 'a * 'a rn
  | R of 'a rn * 'a * 'a rn

let rec appartient t x = match t with
  | V -> false
  | N(g,y,d) | R(g,y,d) ->
    if x = y then true
    else if x < y then appartient g x
    else appartient d x

let cons t g x d = match t with
  | V -> failwith "arbre vide"
  | N(_,_,_) -> N(g,x,d)
  | R(_,_,_) -> R(g,x,d)

let corrige_rouge t = match t with
  | N (R (R (a, x, b), y, c), z, d)
  | N (R (a, x, R (b, y, c)), z, d)
  | N (a, x, R (R (b, y, c), z, d))
  | N (a, x, R (b, y, R (c, z, d)))
    -> R (N (a, x, b), y, N (c, z, d))
  | t -> t

let rec insere_aux t x = match t with
  | V -> R (V, x, V)
  | R (g, y, d) | N (g, y, d) ->
    if x = y then t
    else if x < y then corrige_rouge (cons t (insere_aux g x) y d)
    else corrige_rouge (cons t g y (insere_aux d x))

let noircit t = match t with
  | R (g, x, d) -> N (g, x, d)
  | t -> t

let insere t x = noircit (insere_aux t x)

let rec supprime_min t = match t with
  | V -> failwith "vide"
  | R (V, x, d) -> d, false
  | N (V, x, d) -> d, true
  | R (g, x, d) | N (g, x, d) -> failwith "à compléter"

let corrige_noir_gauche t b =
  if not b then (t, false)
  else match t with
    | R (a, x, N (b, y, c)) ->
      corrige_rouge (N (R (a, x, b), y, c)),
      false
    | N (R (a, x, b), y, c) ->
      N (N (a, x, b), y, c),
      false
    | N (a, x, N (b, y, c)) ->
      corrige_rouge (N (R (a, x, b), y, c)),
      true
    | N (a, x, R (N (b, y, c), z, N (d, t, e))) ->
      N (corrige_rouge (N (a, x, R (b, y, c))),
         z,
         N (d, t, e)),
      false
    | _ -> failwith "impossible"

let rec supprime_min t = match t with
  | V -> failwith "vide"
  | R (V, x, d) -> d, false
  | N (V, x, d) -> d, true
  | R (g, x, d) | N (g, x, d) ->
    let g', a_diminue = supprime_min g in
    corrige_noir_gauche (cons t g' x d) a_diminue

let corrige_noir_droite t a_faire =
  if not a_faire then (t, false)
  else match t with
    | R (N (a, x, b), y, c) ->
      corrige_rouge (N (a, x, R (b, y, c))),
      false
    | N (a, x, R (b, y, c)) ->
      N (a, x, N (b, y, c)),
      false
    | N (N (a, x, b), y, c) ->
      corrige_rouge (N (a, x, R (b, y, c))),
      true
    | N (R (N (a, x, b), y, N (c, z, d)), t, e) ->
      N (corrige_rouge (N (a, x, R (b, y, c))),
         z,
         N (d, t, e)),
      false
    | _ -> failwith "impossible"

let rec minimum t = match t with
  | V -> failwith "arbre vide"
  | N(V,x,_) | R(V,x,_) -> x
  | N(g,_,_) | R(g,_,_) -> minimum g

let rec supprime_aux t x = match t with
  | V -> V, false
  | N (g, y, d) | R (g, y, d) when x < y ->
    let g', a_diminue = supprime_aux g x in
    corrige_noir_gauche (cons t g' y d) a_diminue
  | N (g, y, d) | R (g, y, d) when x > y ->
    let d', a_diminue = supprime_aux d x in
    corrige_noir_droite (cons t g y d') a_diminue
  | N (V, _, t') | N (t', _, V) -> t', true
  | R (V, _, t') | R (t', _, V) -> t', false
  | N (g, _, d) | R (g, _, d) ->
    let m = minimum d in
    let d', a_diminue = supprime_min d in
    corrige_noir_droite (cons t g m d') a_diminue

let supprime t x =
  let t', _ = supprime_aux t x in
  noircit t'