Module BalanceProps(X:Orders.OrderedType)(Import M : MakeRaw X).
Local Notation Rd := (Node Red).
Local Notation Bk := (Node Black).
(** ** Red-Black invariants *)
(** In a red-black tree : - a red node has no red children - the black depth at each node is the same along all paths. The black depth is here an argument of the predicate. *)
Inductive rbt : nat -> tree -> Prop :=
| RB_Leaf : rbt 0 Leaf
| RB_Rd n l k r :
notred l -> notred r -> rbt n l -> rbt n r -> rbt n (Rd l k r)
| RB_Bk n l k r : rbt n l -> rbt n r -> rbt (S n) (Bk l k r).
(** A red-red tree is almost a red-black tree, except that it has a _red_ root node which _may_ have red children. Note that a red-red tree is hence non-empty, and all its strict subtrees are red-black. *)
Inductive rrt (n:nat) : tree -> Prop :=
| RR_Rd l k r : rbt n l -> rbt n r -> rrt n (Rd l k r).
(** An almost-red-black tree is almost a red-black tree, except that it's permitted to have two red nodes in a row at the very root (only). We implement this notion by saying that a quasi-red-black tree is either a red-black tree or a red-red tree. *)
Inductive arbt (n:nat)(t:tree) : Prop :=
| ARB_RB : rbt n t -> arbt n t
| ARB_RR : rrt n t -> arbt n t.
(** The main exported invariant : being a red-black tree for some black depth. *)
Class Rbt (t:tree) :=  RBT : exists d, rbt d t.
(** ** Basic tactics and results about red-black *)
Scheme rbt_ind := Induction for rbt Sort Prop.
Local Hint Constructors rbt rrt arbt : core.
Local Hint Extern 0 (notred _) => (exact I) : core.
Ltac invrb := intros; invtree rrt; invtree rbt; try contradiction.
Ltac desarb := match goal with H:arbt _ _ |- _ => destruct H end.
Ltac nonzero n := destruct n as [|n]; [try split; invrb|].
Local Hint Resolve rr_nrr_rb : core.
Local Hint Resolve arb_nrr_rb arb_nr_rb : core.
(** ** A Red-Black tree has indeed a logarithmic depth *)
Definition redcarac s := rcase (fun _ _ _ => 1) (fun _ => 0) s.
(** ** Singleton *)

Lemma singleton_rb x : Rbt (singleton x).