type color = Red | Black ;; type 'a tree = Empty | N of color * 'a tree * 'a * 'a tree ;; let rec mem e = function Empty -> false | N(_,_,a,_) when a = e -> true | N(_,g,a,_) when a > e -> mem e g | N(_,_,a,d) -> mem e d ;; let rec check_1 = function Empty -> true | N(Red,N(Red,_,_,_),_,_) | N(Red,_,_,N(Red,_,_,_)) -> false | N(_,g,_,d) -> check_1 g && check_1 d;; exception invalid_height;; let rec black_height = function Empty -> 0 | N(c,g,_,d) -> let hg = black_height g and hd = black_height d in if( hg <> hd ) then raise invalid_height else hg + if (c = Black) then 1 else 0;; let check_2 a = try let _ = black_height a in true with | invalid_height -> false;; let rec simple insert x = function Empty -> N(Red, Empty, x, Empty) | N(c,t1,y,t2) when x < y -> N(c,simple insert x t1, y,t2) | N(c,t1,y,t2) -> N(c,t1,y,simple insert x t2) ;; let conflict = function N(Black, N(Red, N(Red, t1, x1, t2), x2, t3), x3, t4) -> N(Red, N(Black, t1, x1, t2), x2, N(Black, t3, x3, t4)) | N(Black, N(Red, t1, x1, N(Red, t2, x2, t3)), x3, t4) -> N(Red, N(Black, t1, x1, t2), x2, N(Black, t3, x3, t4)) | N(Black, t1, x1, N(Red, N(Red, t2, x2, t3), x3, t4)) -> N(Red, N(Black, t1, x1, t2), x2, N(Black, t3, x3, t4)) | N(Black, t1, x1, N(Red, t2, x2, N(Red, t3, x3, t4))) -> N(Red, N(Black, t1, x1, t2), x2, N(Black, t3, x3, t4)) | t -> t;;