Deleting a node even from regular binary tree is a little bit more complicated than insertion. Deleting a node from Red and Black tree is also a little bit more complicated than insertion.

I updated the legend to include Double black node:

Double Black nodes appear when a Black node with Empty children becomes Empty. Thus it acquires extra black property from it’s children making the node Double Black.

As an example here is a tree that is the result of the sample insertions from the previous post:

Deleting node 7 would result in following steps:

Value 7 is deleted, and value 12 is bubbled up to the node that used to hold 7.

In order to preserve black height property it is not possible to throw away Empty nodes. Since Empty nodes are considered to be Black nodes, they get merged into double black node with the node that held value 12.

To get rid of the double black node, and preserve black height property – perform node rotation, and recoloring. This produces the final tree.

The book that I am using for implementation of the Red and Black tree covers only 3 node restructuring cases for deletion. After implementing those, I found that there is another case that was not mentioned by the book.

Case 1 happens when parent node is Red, it has one child that has Double Black property, and another child that is a Black node with at least one Red child.

In this case the black height of the tree to left of node with value 3 is the same as to the right of it. Even though the node to the right is a Double Black node.

The mirror case needs to be handled as well, when Double Black node is a left child.

Case 2 happens when parent node is Red, and it has one child with Double Black property and another child is Black node child. Then parent node becomes black, and Black node child becomes Red node, and Double Black node child becomes a Black node.

On the other hand if parent node is a Black node, then Double Black property bubbles up to the parent node.

Case 3 needs node restructuring, which after restructuring could be handled as Case 1 or Case 2.

When I was doing some testing I found out that there is one case that was not handled. And the case is not mentioned in the book.

Not mentioned case :

Naming of functions that handle Double Black node cases might be not the best. For example fixLeftChildRedParent – means that Right Child has a Double Black property and it’s parent is a Red node, and we need to do some fixes to the Left Child. Ether recolor some nodes, or rearrange them. Thus removing Double Black property from the Right Child.

let fixLeftChildRedParent pV lc rc =

```
```
match lc with

//case 1 begins

| Empty -> failwith "leftChild is empty when fixing double black"

| Node(Black(lcV), (Node(Red(lclcV), lclclc, lclcrc) as lclc), lcrc) ->
let newRc, newLc = Node(Black(pV), lcrc, rc), Node(Black(lclcV), lclclc, lclcrc)

false, Node(Red(lcV), newLc, newRc)

| Node(Black(lcV), lclc, (Node(Red(lcrcV), lcrclc, lcrcrc) as lcrc)) ->

let newRc, newLc = Node(Black(pV), lcrcrc, rc), Node(Black(lcV), lclc, lcrclc)

false, Node(Red(lcrcV), newLc, newRc)

//case 1 ends

//case 2 begins

| Node(Black(lcV), lclc, lcrc) when isConsideredBlack lclc && isConsideredBlack lcrc ->

let newRc, newLc = rc, Node(Red(lcV), lclc, lcrc)

false, Node(Black(pV), newLc, newRc)

//case 2 ends

| _ -> failwith (sprintf "wrong node combination in fixLeftChildRedParent. LeftChild is %A" lc)

let fixRightChildRedParent pV lc rc =

```
```
match rc with

//case 1 begins

| Empty -> failwith "rightChild is empty when fixing double black"

| Node(Black(rcV), (Node(Red(rclcV), rclclc, rclcrc) as rclc), rcrc) ->
let newLc, newRc = Node(Black(pV), lc, rclclc), Node(Black(rcV), rclcrc, rcrc)

false, Node(Red(rclcV), newLc, newRc)

| Node(Black(rcV), rclc, (Node(Red(rcrcV), rcrclc, rcrcrc) as rcrc)) ->

let newLc, newRc = Node(Black(pV), lc, rclc), Node(Black(rcrcV), rcrclc, rcrcrc)

false, Node(Red(rcV), newLc, newRc)

//case 1 ends

//case 2 begins

| Node(Black(rcV), rclc, rcrc) when isConsideredBlack rclc && isConsideredBlack rcrc ->

let newLc, newRc = lc, Node(Red(rcV), rclc, rcrc)

false, Node(Black(pV), newLc, newRc)

//case 2 ends

| _ -> failwith (sprintf "wrong node combination in fixRightChildRedParent. RightChild is %A" rc)

//lc -> leftChild

//rc -> rightChild

//p -> parent

//pV -> parentValue

let rec fixDoubleBlack parent child =

```
```
match parent with

| Node(Red(pV), lc, rc) -> if rc = child
then fixLeftChildRedParent pV lc rc

else fixRightChildRedParent pV lc rc

| Node(Black(pV), lc, rc) -> if rc = child

then fixLeftChildBlackParent pV lc rc

else fixRightChildBlackParent pV lc rc

| Empty -> failwith "parent node cannot be empty when fixing double black"

and fixLeftChildBlackParent pV lc rc =

match lc with

| Empty -> failwith "leftChild is empty when fixing double black with black parent"
//This cases were not mentioned in the book, but the do occur.

| Node(Black(lcV), Node(Red(lclcV), lclclc, lclcrc), lcrc) ->

let newLc = Node(Black(lclcV), lclclc, lclcrc)

let newRc = Node(Black(pV), lcrc, rc)

false, Node(Black(lcV), newLc, newRc)

| Node(Black(lcV), lclc, Node(Red(lcrcV), lcrclc, lcrcrc)) ->

let newLc = Node(Black(lcV), lclc, lcrclc)

let newRc = Node(Black(pV), lcrcrc, rc)

false, Node(Black(lcrcV), newLc, newRc)

//end of not mentioned cases

//case 2 begins

| Node(Black(lcV), lclc, lcrc) when isConsideredBlack lclc && isConsideredBlack lcrc->

let newRc, newLc = rc, Node(Red(lcV), lclc, lcrc)

true, Node(Black(pV), newLc, newRc)

//case 2 ends

//case 3 begins

| Node(Red(lcV), lclc, lcrc) ->

let newLc, newDoubleBlackRc = lclc, Node(Red(pV), lcrc, rc)

let isStillDoubleBlack, newRc = fixDoubleBlack newDoubleBlackRc rc

assert(false = isStillDoubleBlack)

false, Node(Black(lcV), newLc, newRc)

//case 3 ends

| _ -> failwith (sprintf "wrong node combination in fixLeftChildBlackParent. LeftChild is %A" lc)

and fixRightChildBlackParent pV lc rc =

match rc with

| Empty -> failwith "rightChild is empty when fixing double black with black parent"
//not mentioned cases begin

| Node(Black(rcV), Node(Red(rclcV), rclclc, rclcrc), rcrc) ->

let newLc = Node(Black(pV), lc, rclclc)

let newRc = Node(Black(rcV), rclcrc, rcrc)

false, Node(Black(rclcV), newLc, newRc)

| Node(Black(rcV), rclc, Node(Red(rcrcV), rcrclc, rcrcrc)) ->

let newLc = Node(Black(pV), lc, rclc)

let newRc = Node(Black(rcrcV), rcrclc, rcrcrc)

false, Node(Black(rcV), newLc, newRc)

//not mentioned cases end

//case 2 begins

| Node(Black(rcV), rclc, rcrc) when isConsideredBlack rclc && isConsideredBlack rcrc ->

let newLc, newRc = lc, Node(Red(rcV), rclc, rcrc)

true, Node(Black(pV), newLc, newRc)

//case 2 ends

//case 3 begins

| Node(Red(rcV), rclc, rcrc) ->

let newRc, newDoubleBlackLc = rcrc, Node(Red(pV), lc, rclc)

let isStillDoubleBlack, newLc = fixDoubleBlack newDoubleBlackLc lc

assert(false = isStillDoubleBlack)

false, Node(Black(rcV), newLc, newRc)

//case 3 ends

| _ -> failwith (sprintf "wrong node combination in fixRightChildBlackParent. RightChild is :%A" rc)

(*Deletion is a little bit more complicated than insertion. When inserting, the node is added as a leaf, and then

there are maybe some node rotations have to performed in order to keep the tree balanced. But the node that we

inserting is always added as a leaf. Now when we do deletion we can delete a node from anywhwere in the tree.

So that creates an extra complication, since now when we find the node that we want to delete, we need to go

down the tree from that node, and bubble all the values up, when we start bubbling values up we might need

to fix double black node. Fix could ether get rid of double black node completely, or propogate it to the parent

node. In that case we have to perform fix in the parent node. That in turn could also propogate double black node

to it's parent ... *)

//returns tuple (bool, Node).

//bool value in the tuple is true if the node has double black property

//false otherwise

//bb -> double black

```
```let fixDoubleBlackIfNeeded bb parent child =

if bb

then fixDoubleBlack parent child

else false, parent

This is kind of similar to deletion in regular binary tree. When deleting a value from the node, it could happen that the node is not a leaf node. Therefore that whole needs to be patched up. So use a value from a leaf node to patch the whole in the tree. Then rearrange leaf nodes to keep the tree balanced.

The way leaf node is picked is -> from the node that is being deleted, go once down the right child, and then go down left from the right child until the Empty node is reached. The parent of the Empty node is the leaf node that is used in fixing the hole.

let bubbleUp node =

```
```

```
//go right one node, then go down left as far as possible -> that's the child that should replace the deleted node
```

//if that child had a child on the right, then move that child one up.

//then start going up the tree fixing double black until we get to the start.

//Replace the node at the start with the left most child node
//special cases -> node does not have right child, but it has one left child, then use the left child to

//use it instead of the node

let rec bbUp node cont =

match node with

| Empty -> failwith "Node cannot be empty when bbUp"

| Node(n, lc, rc) ->
match lc with

| Empty -> failwith (sprintf "Left child is Empty when bbUp. Node %A" n)

| Node(Red(_), Empty, Node(Red(_), _, _)) -> failwith "Error, parent and child are both Red nodes"

| Node(Black(_), Empty, Node(Black(_), _, _)) -> failwith "Erorr black height property does not hold"

| Node(Red(lcV), Empty, Empty) -> cont (lcV, (false, Node(n, Empty, rc)))

| Node(Black(lcV), Empty, Empty) -> cont (lcV, fixDoubleBlackIfNeeded true (Node(n, Empty, rc)) Empty)

| Node(Black(lcV), Empty, Node(Red(lcrcV), Empty, Empty)) ->

cont (lcV, (false, Node(n, Node(Black(lcrcV), Empty, Empty), rc)))

| lc -> cont (bbUp lc (fun (v, (bb, newLc)) -> v, fixDoubleBlackIfNeeded bb (Node(n, newLc, rc)) newLc))

//handle special cases first

match node with

| Empty -> failwith "node cannot be empty when bubbling up"

//if right child is empty, and there is non empty left child. Then left child has to be Red with Empty children,

//otherwise Black height property is violated

| Node(Black(_), Empty, Empty) -> (true, Empty)

| Node(Red(_), Empty, Empty) -> (false, Empty)

//if right child is empty and left child is not empty - it has to be red node with no children,

//otherwise Black height property will not hold

| Node(Black(_), Node(Red(lcV), Empty, Empty), Empty) -> false, Node(Black(lcV), Empty, Empty)

| Node(Black(_), Node(Black(_), Empty, Empty), Empty) -> failwith (sprintf "black height propery is violated %A" node)

//another special case, when the node that we are deleting has right non empty child, but the child

//does not have any childred. So it is not possible to go down the left branch.

| Node(n, lc, Node(rcn, Empty, Empty)) ->

match n, rcn with

| Black(_), Black(rcV) -> fixDoubleBlackIfNeeded true (Node(Black(rcV), lc, Empty)) Empty

| Black(_), Red(rcV) -> false, Node(Black(rcV), lc, Empty)

| Red(_), Black(rcV) -> fixDoubleBlackIfNeeded true (Node(Red(rcV), lc, Empty)) Empty

| Red(_), Red(rcV) -> false, Node(Red(rcV), lc, Empty)

//another case is when right child does not have a left child, but it has a right child.

//In That case right child can only be Red otherwise Black height property would not hold

| Node(n, lc, Node(Black(rcV), Empty, Node(Red(rcrcV), Empty, Empty))) ->

match n with

| Black(_) -> false, Node(Black(rcV), lc, Node(Black(rcrcV), Empty, Empty))

| Red(_) -> false, Node(Red(rcV), lc, Node(Black(rcrcV), Empty, Empty))

| Node(_, _, Node(Black(_), Empty, Node(Black(_), Empty, Empty))) -> failwith(sprintf "black height property is violated %A" node)

| Node(n, lc, rc) ->

let v, (nbb, newRc) = bbUp rc (fun (v, (bb, n)) -> v, (bb, n))
let newNode =

match n with

| Black(_) -> Node(Black(v), lc, newRc)

| Red(_) -> Node(Red(v), lc, newRc)

fixDoubleBlackIfNeeded nbb newNode newRc

//bb -> double black

let remove tree value =

```
```
//when we get here, we will never bubbleUp when parent node is empty. Since the only case when parent node is

//empty, is when the root node has the value that we are deleting and it has no children.

//This case was already handled before we get here.

let rec removeValue parent remValue cont =
match parent with

| Empty -> Empty

| Node(Red(v) as t, lc, rc) | Node(Black(v) as t, lc, rc)->
match compare remValue v with

| 0 -> cont(bubbleUp parent)

| 1 -> removeValue rc remValue (fun (bb, nrc) -> cont(fixDoubleBlackIfNeeded bb (Node(t, lc, nrc)) nrc))

| -1 -> removeValue lc remValue (fun (bb, nlc) -> cont(fixDoubleBlackIfNeeded bb (Node(t, nlc, rc)) nlc))

| weirdValue -> failwith (sprintf "Node comparison returned wrong result %d" weirdValue)

match tree with

| Node(Black(v), Empty, Empty) when (compare v value = 0) -> (true, Empty)

| Node(Red(_), _, _) -> failwith "Root node is not black !!"

| _ -> match removeValue tree value (fun (b, n) -> n) with

| Empty -> (false, tree)

| newTree -> (true, newTree)

(*

let b0, r0 = insert Empty 4

let b1, r1 = insert r0 7

let b2, r2 = insert r1 12

let b3, r3 = insert r2 15

let b4, r4 = insert r3 3

let b5, r5 = insert r4 5

let b6, r6 = insert r5 14

let b7, r7 = insert r6 18

let b8, r8 = insert r7 16

let b9, r9 = insert r8 17

let b10, r10 = remove r9 3

(*Expected tree:

Node

(Black 14,

Node

(Red 7,Node (Black 4,Empty,Node (Red 5,Empty,Empty)),

Node (Black 12,Empty,Empty)),

Node

(Red 16,Node (Black 15,Empty,Empty),

Node (Black 18,Node (Red 17,Empty,Empty),Empty)))

*)

let b11, r11 = remove r10 12

(*Expected tree:

Node

(Black 14,

Node (Red 5,Node (Black 4,Empty,Empty),Node (Black 7,Empty,Empty)),

Node

(Red 16,Node (Black 15,Empty,Empty),

Node (Black 18,Node (Red 17,Empty,Empty),Empty)))

*)

let b12, r12 = remove r11 17

(*Expected tree:

Node

(Black 14,

Node (Red 5,Node (Black 4,Empty,Empty),Node (Black 7,Empty,Empty)),

Node (Red 16,Node (Black 15,Empty,Empty),Node (Black 18,Empty,Empty)))

*)

let b13, r13 = remove r12 18

(*Expected tree:

Node

(Black 14,

Node (Red 5,Node (Black 4,Empty,Empty),Node (Black 7,Empty,Empty)),

Node (Black 16,Node (Red 15,Empty,Empty),Empty))

*)

let b14, r14 = remove r13 15

(*Expected tree:

Node

(Black 14,

Node (Red 5,Node (Black 4,Empty,Empty),Node (Black 7,Empty,Empty)),

Node (Black 16,Empty,Empty))

*)

let b15, r15 = remove r14 16

(*Expected tree:

Node

(Black 5,Node (Black 4,Empty,Empty),

Node (Black 14,Node (Red 7,Empty,Empty),Empty))

*)

*)