Red Black Trees

Red Black Trees are an example of a self balancing tree that allows for more bias than an AVL tree does. Constructing these trees from sorted data can be done in amortized linear time via consing.

1data Color = R | B
2data RBTree a = Tip | Node Color (RBTree a) a (RBTree a)

We need to make sure that:

If there are no Node Rs then the tree is perfectly balanced, otherwise, there can be at most the same number of Node Rs as Node Bs, which means branches can be up to twice as big as the least red path.

We also need two helper functions:

1-- This function turns a red node black
2blacken :: RBTree a -> RBTree a
3blacken (Node R lt x rt) = Node B lt x rt
4blacken = id
5
6-- This function turns a black node red and its children black
7balance :: Colour -> RBTree a -> a -> RBTree a
8balance B (Node R (Node R a x b) y c) z d = Node R (Node B a x b) y (Node B c z d)
9balance B (Node R a x (Node R b y c)) z d = Node R (Node B a x b) y (Node B c z d)
10balance B a x (Node R (Node R b y c) z d) = Node R (Node B a x b) y (Node B c z d)
11balance B a x (Node R b y (Node R c z d)) = Node R (Node B a x b) y (Node B c z d)
12balance c lt x rt = Node c lt x rt
1instance Poset RBTree where
2  empty = Tip
3
4  singleton :: a -> RBTree a
5  singleton x = Node B Tip x Tip
6
7  member :: Ord a => a -> RBTree a -> Bool -- O(log n)
8  member x Tip = False
9  member x (Node _ lt y rt) = case compare x y of
10    EQ -> True
11    LT -> member x lt
12    GT -> member x rt
13
14  insert :: Ord a => a -> RBTree a -> RBTree a -- O(log n)
15  insert = blacken . insert'
16    where insert' x Tip = Node _ Tip x Tip
17          insert' x t@(Node c lt y rt) = case compare x y of
18            EQ -> t
19            LT -> balance c (insert x lt) y rt
20            GT -> balance c lt y (insert x rt)

RBTrees favour insertion over membership. The evil operation would be deletion. If we remove a black node, we need to rebalance the whole tree. Instead, we can define a different deletion:

1  delete :: Ord a => a -> RBTree a -> RBTree a
2  delete x = fromOrdList . List.delete x . toList

toList creates a sorted list, and deletion does not change the ordering, so we can use fromOrdList to construct the tree. Before we create fromOrdList, we can clean up the rest of the functions:

1toList :: RBTree a -> [a]
2toList = Seq.toList . go
3  where go :: RBTree a -> Seq.DList a
4        go Tip = Seq.nil
5        go (Node _ lt x rt) = go lt `Seq.append` Seq.cons x $ go rt
6
7minValue :: RBTree a -> a
8minValue (Node _ Tip x _) = x
9minValue (Node _ lt _ _) = minValue lt
10
11maxValue :: RBTree a -> a
12maxValue (Node _ _ x Tip) = x
13maxValue (Node _ _ _ rt) = maxValue rt

When we construct a tree from a sorted list, we notice that when we represent the tree as a list of half trees (generated by taking all the subtrees where the roots are on the left-hand spine), we can see that when the red nodes appear, they are next to a black rooted partial-tree of the same size. Thus we can define the following counting system, where we can count our way through the list of elements and in end up with a final "number" which can be turned into a tree:

1data Digit a = One a (RbTree a) | Two a (RBTree a) a (RBTree a)
2
3cons :: a -> [Digit a] -> [Digit a]
4cons x ds = inc x Tip ds
5  where inc :: a -> RBTree a -> [Digit a] -> [Digit a]
6        inc x t [] = [One x t]
7        inc x t (One y t' : ds) = Two x t y t' : ds
8        inc x t (Two y1 t1 y2 t2 : ds) = One x t : inc y1 (Node B t1 y2 t2) ds

Now that we've turned the sorted list into a numerical structure involving a list of digits of one or two red-black trees of a perfect shape with all black-nodes, we need to collapse the list into a final tree:

1fromOrdList :: [a] -> RBTree a
2fromOrdList = foldl glue Tip . foldr cons []
3  where glue :: RBTree a -> Digit a -> RBTree a
4        glue t (One x t') = Node B t x t'
5        glue t (Two x1 t1 x2 t2) = Node B (Node R t x1 t1) x2 t2
Back to Home