83 lines
2.0 KiB
Coq
83 lines
2.0 KiB
Coq
(*
|
|
Cormen - Chapter 13:
|
|
|
|
Red-black trees are Binary trees such that:
|
|
1) Each node is either red or black
|
|
2) Root is black
|
|
3) All leaves are black
|
|
4) All children of a red node are black
|
|
5) For each node, number of black nodes in every possible simple path to
|
|
leaves is the same.
|
|
*)
|
|
|
|
Inductive colour: Set := Red | Black.
|
|
|
|
(* [rbtree c d] denotes a tree of black depth [d]
|
|
whose root node is coloured [c]
|
|
|
|
Black depth is the number of black nodes (not including current node)
|
|
in a path to one of the leaf nodes.
|
|
|
|
Root needn't be red in this implementation. *)
|
|
Inductive rbtree: colour -> nat -> Type :=
|
|
| Leaf: rbtree Black 0
|
|
|
|
(* Red node can't be a leaf and both children of a red node must be black *)
|
|
| RedNode: forall {n:nat},
|
|
rbtree Black n -> rbtree Black n -> rbtree Red n
|
|
|
|
| BlackNode: forall {n:nat} {c1 c2:colour},
|
|
(* If both children have black depth [n], regardless of their colour, then
|
|
this node, which is black, would have black depth [n+1].
|
|
And [n] has to be same for both branches, by definition of rb tree. *)
|
|
rbtree c1 n -> rbtree c2 n -> rbtree Black (S n).
|
|
|
|
|
|
Fixpoint depth {c:colour} {n:nat}
|
|
(f: nat -> nat -> nat) (* a 'combining' function *)
|
|
(t: rbtree c n): nat :=
|
|
match t with
|
|
| Leaf => 0
|
|
| RedNode t1 t2 => S (f (depth f t1) (depth f t2))
|
|
| BlackNode t1 t2 => S (f (depth f t1) (depth f t2))
|
|
end.
|
|
|
|
Example eg1 := Leaf.
|
|
Example rLeaf := RedNode Leaf Leaf. (* red leaf *)
|
|
Example bLeaf := BlackNode Leaf Leaf. (* black leaf *)
|
|
Check bLeaf.
|
|
(* bLeaf : rbtree Black 1 *)
|
|
Check rLeaf.
|
|
(* bLeaf : rbtree Red 0 *)
|
|
Check BlackNode bLeaf bLeaf.
|
|
(* BlackNode bLeaf bLeaf : rbtree Black 2 *)
|
|
|
|
(* Left tree has d=2, right tree has d=1 *)
|
|
Fail Check BlackNode bLeaf rLeaf.
|
|
(*
|
|
B
|
|
R
|
|
B
|
|
|
|
|
|
B
|
|
|
|
|
|
B
|
|
B
|
|
B
|
|
*)
|
|
|
|
Require Import Arith.
|
|
Check Nat.min_dec.
|
|
Print Nat.Private_Dec.min_dec.
|
|
|
|
(*
|
|
Lemma min_dec (n m:nat): {min n m = n} + {min n m = m}.
|
|
Proof.
|
|
induction n.
|
|
- simpl; now left.
|
|
- induction m.
|
|
+ right; now simpl.
|
|
*)
|