**RED-BLACK TREE**

A red-black tree is an implementation of a self balancing binary search tree. Wiki can tell you about the technical background of the red-black tree

http://en.wikipedia.org/wiki/Red-black_tree

The nodes in this particular red-black tree contain a key (Integer) and a value (String). You can change the type of both key and value to something else. If you want to do so you'll have to change the source code here and their (important: if you change the type of the key you'll have to supply your own compare function. It is used to determine whether two keys are equal and if not which of the two keys is the bigger one).

Four operations can be performed on the tree:

-->add a node to the tree (key,value);

-->delete a node from the tree;

-->find a node in the tree (key);

-->delete the entire tree;

-->draw the entire tree (graphically).

Insertion and deletion of a node both start out as if these operations are performed on a 'regular' binary search tree. This means walking the tree up to the insertion/deletion point and performing the insert/delete operation.

After insertion/deletion the tree gets rebalanced. This rebalancing assures the tree meets the requirements of a red-black tree.

There requirements are

- A node is either red or black.

- The root is black.

- All leaves are black.

- Both children of every red node are black.

- Every simple path from a given node to any of its

descendant leaves contains the same number of black nodes.

As an example of a red-black tree here is a picture of a red-black tree after inserting the keys 0 To 20 (picture: output of NodeQueue.PrintTree routine)

At the end of the code you'll find an example of using the tree.

The example starts out by inserting values inserted into a tree. Before each insertion the program outputs the key about to be inserted to the console and waits for a key-press. After the key-press it adds a (key,value) pair to the tree and draws the resulting tree.

After adding values to the tree the program continues by deleting all the values from the tree (one by one). Again the program first prints the key that is about to be deleted from the tree, it waits for a key press and after the key-press

it deletes a node from the tree and draws the resulting tree.

The routine that does the printing of the tree (NodeQueue.PrintTree) is a bit of a hack. Drawing a binary tree in a way that makes the tree look good is something

better done using some sophisticated layout algorithm (like the graphviz library uses). I've just tried to get a useful result (visually) for smaller trees with small keys/values so you can see the tree balancing 'in action'.

When used to draw bigger trees you'll find the layout degrades and (many) nodes will not show up on the screen as nodes drop of at the bottom of the screen.

Two more things.

You can find the smallest key in the tree by going left at the

root and continuing to go left until a node is found that has the sentinel as it´s left child.

You can find the largest key in the tree by going right at the root and continuing to go right until a node is found that has the sentinel as it´s right child.

Code: Select all

```
#define NULL Cast(Any Ptr,0)
Enum nodecolor
BLACK = 0
RED = 1
End Enum
Type RBNode
Dim left As RBNode Ptr
Dim right As RBNode Ptr
Dim parent As RBNode Ptr
Dim color As nodecolor
Dim key As Integer
Dim value As String
Dim nonzero As Integer
Declare Constructor(ByVal key As Integer = 0,value As String = "",ByVal clr As nodecolor = RED)
Declare Destructor()
End Type
Constructor RBNode(ByVal key As Integer,value As String,ByVal clr As nodecolor = RED)
This.key = key
This.value = value
This.left = NULL
This.right = NULL
This.parent = NULL
This.color = clr
This.nonzero = 1
End Constructor
Destructor RBNode()
End Destructor
Function integer_compare(ByVal key1 As Integer, ByVal key2 As Integer) As Integer
If (key1 = key2) Then
Return 0
ElseIf (key1 < key2) Then
Return -1
ElseIf (key1 > key2) Then
Return 1
End If
End Function
Type RBTree
Dim sentinel As RBNode Ptr
Dim root As RBNode Ptr
Dim count As Integer
Dim Compare As Function(ByVal key1 As Integer, ByVal key2 As Integer) As Integer
Declare Constructor(ByVal cmp As Function(ByVal key1 As Integer,ByVal key2 As Integer) As Integer)
Declare Sub rotateLeft(ByVal x As RBNode Ptr)
Declare Sub rotateRight(ByVal x As RBNode Ptr)
Declare Sub insertFixup(ByVal x As RBNode Ptr)
Declare Function insertNode(ByVal key As Integer,value As String) As RBNode Ptr
Declare Sub deleteFixup(ByVal x As RBNode Ptr)
Declare Sub deleteNode(ByVal z As RBNode Ptr)
Declare Function findNode(ByVal key As Integer) As RBNode Ptr
Declare Destructor()
End Type
Constructor RBTree(ByVal cmp As Function(ByVal key1 As Integer,ByVal key2 As Integer) As Integer)
This.sentinel = New RBNode(0,"",BLACK)
This.sentinel->left = sentinel
This.sentinel->right = sentinel
This.root = This.sentinel
This.count = 0
This.Compare = cmp
End Constructor
Destructor RBTree()
'The tree is transformed into a tree in which
'left children are always leaves. This is done by rotation.
'After rotating any left child is a leaf (not a tree)
'so a left child can simply be deleted.
'Usually a stack is used to keep track of what nodes have
'been removed. By using rotation there is no need for a stack.
Dim parent As RBNode Ptr
Dim child As RBNode Ptr
If (This.root <> This.sentinel AndAlso This.root <> NULL) Then
parent = This.root
While (parent <> This.sentinel)
If (parent->left = This.sentinel) Then
child = parent->right
Delete parent
parent = 0
Else
'rotate
child = parent->left
parent->left = child->right
child->right = parent
End If
parent = child
Wend
Else
If (This.sentinel <> 0) Then
Delete This.sentinel
This.sentinel = 0
End If
End If
End Destructor
Sub RBTree.rotateLeft(ByVal x As RBNode Ptr)
'rotate node x to right
Var y = x->right
'establish x->right link
x->right = y->left
If (y->left <> This.sentinel) Then
y->left->parent = x
End If
'establish y->parent link
If (y <> This.sentinel) Then
y->parent = x->parent
End If
If (x->parent) Then
If (x = x->parent->left) Then
x->parent->left = y
Else
x->parent->right = y
End If
Else
This.root = y
End If
'link x and y
y->left = x
If (x <> This.sentinel) Then
x->parent = y
End If
End Sub
Sub RBTree.rotateRight(ByVal x As RBNode Ptr)
'rotate node x to right
Var y = x->left
' establish x->left link
x->left = y->right
If (y->right <> This.sentinel) Then
y->right->parent = x
End If
' establish y->parent link
If (y <> This.sentinel) Then
y->parent = x->parent
End If
If (x->parent) Then
If (x = x->parent->right) Then
x->parent->right = y
Else
x->parent->left = y
End If
Else
This.root = y
End If
'link x and y
y->right = x
If (x <> This.sentinel) Then
x->parent = y
End If
End Sub
Sub RBTree.insertFixup(ByVal x As RBNode Ptr)
'maintain tree balance after inserting node x
'check Red-Black properties
While (x <> This.Root AndAlso x->parent->color = RED)
'we have a violation
If ( x->parent = x->parent->parent->left) Then
Var y = x->parent->parent->right
If ( y->color = RED) Then
'uncle is RED
x->parent->color = BLACK
y->color = BLACK
x->parent->parent->color = RED
x = x->parent->parent
Else
'uncle is BLACK
If ( x = x->parent->right) Then
'make x a left child
x = x->parent
This.rotateLeft(x)
End If
'recolor and rotate
x->parent->color = BLACK
x->parent->parent->color = RED
This.rotateRight(x->parent->parent)
End If
Else
' mirror image of above code
Var y = x->parent->parent->left
If ( y->color = RED) Then
' uncle is RED
x->parent->color = BLACK
y->color = BLACK
x->parent->parent->color = RED
x = x->parent->parent
Else
' uncle is BLACK
If ( x = x->parent->left) Then
x = x->parent
This.rotateRight(x)
End If
x->parent->color = BLACK
x->parent->parent->color = RED
This.rotateLeft(x->parent->parent)
End If
End If
Wend
This.root->color = BLACK
End Sub
Function RBTree.insertNode(ByVal key As Integer,value As String) As RBNode Ptr
'Insert a node in the RBTree
'find where node belongs
Dim current As RBNode Ptr = This.root
Dim parent As RBNode Ptr
While (current <> This.sentinel)
Var rc = This.Compare(key, current->key)
If (rc = 0) Then
Return current
End If
parent = current
If (rc < 0) Then
current = current->left
Else
current = current->right
End If
Wend
' setup new node
Dim x As RBNode Ptr = New RBNode(key, value)
x->left = This.sentinel
x->right = This.sentinel
x->parent = parent
This.count = This.count + 1
' insert node in tree
If (parent) Then
If (This.Compare(key, parent->key) < 0) Then
parent->left = x
Else
parent->right = x
End If
Else
This.root = x
End If
This.insertFixup(x)
Return x
End Function
Sub RBTree.deleteFixup(ByVal x As RBNode Ptr)
'maintain tree balance after deleting node x
Dim w As RBNode Ptr
While (x <> This.root AndAlso x->color = BLACK)
If ( x = x->parent->left) Then
w = x->parent->right
If (w->color = RED) Then
w->color = BLACK
x->parent->color = RED
This.rotateLeft(x->parent)
w = x->parent->right
End If
If ( w->left->color = BLACK and w->right->color = BLACK) Then
w->color = RED
x = x->parent
Else
If ( w->right->color = BLACK) Then
w->left->color = BLACK
w->color = RED
This.rotateRight(w)
w = x->parent->right
End If
w->color = x->parent->color
x->parent->color = BLACK
w->right->color = BLACK
This.rotateLeft(x->parent)
x = This.root
End If
Else
w = x->parent->left
If ( w->color = RED) Then
w->color = BLACK
x->parent->color = RED
This.rotateRight(x->parent)
w = x->parent->left
End If
If ( w->right->color = BLACK and w->left->color = BLACK) Then
w->color = RED
x = x->parent
Else
If ( w->left->color = BLACK) Then
w->right->color = BLACK
w->color = RED
This.rotateLeft(w)
w = x->parent->left
End If
w->color = x->parent->color
x->parent->color = BLACK
w->left->color = BLACK
This.rotateRight(x->parent)
x = This.root
End If
End If
Wend
x->color = BLACK
End Sub
Sub RBTree.deleteNode(ByVal z As RBNode Ptr)
'delete node z from tree
Dim y As RBNode Ptr
Dim x As RBNode Ptr
If ( 0 = z OrElse z = This.sentinel) Then
Return
End If
If (z->left = This.sentinel OrElse z->right = This.sentinel) Then
'y has a This.sentinel node as a child
y = z
Else
'find tree successor with a This.sentinel node as a child
y = z->right
While (y->left <> This.sentinel)
y = y->left
Wend
End If
'x is y's only child
If ( y->left <> This.sentinel) Then
x = y->left
Else
x = y->right
End If
'remove y from the parent chain
x->parent = y->parent
If ( y->parent) Then
If ( y = y->parent->left) Then
y->parent->left = x
Else
y->parent->right = x
End If
Else
This.root = x
End If
If (y <> z) Then
z->key = y->key
z->value = y->value
End If
If ( y->color = BLACK) Then
This.deleteFixup(x)
End If
Delete y
This.count = This.count - 1
End Sub
Function RBtree.findNode(ByVal key As Integer) As RBNode Ptr
'find node with key equal to key
Var current = This.root
While (current <> This.sentinel)
Var rc = This.Compare(key, current->key)
If ( rc = 0) Then
Return current
Else
If ( rc < 0) Then
current = current->left
Else
current = current->right
End If
End If
Wend
Return 0
End Function
Type GraphicsNode
Dim node As RBNode Ptr
Dim lvl As UByte
Dim nxt As GraphicsNode Ptr
Dim prev As GraphicsNode Ptr
Dim x As UInteger
Dim y As UInteger
End Type
Type NodeQueue
Dim startx As Integer
Dim starty As Integer
Dim first As GraphicsNode Ptr
Dim last As GraphicsNode Ptr
Dim levels(2 To 11) As Integer => {100,50,25,12,10,10,10,10,10}
Dim count As Integer
Declare Constructor
Declare Destructor
Declare Function Enqueue(ByRef item As GraphicsNode Ptr) As Integer
Declare Function Dequeue(ByRef item As GraphicsNode Ptr) As GraphicsNode Ptr
Declare Sub PrintNode(ByVal item As GraphicsNode Ptr,ByVal x As Integer,ByVal y As Integer)
Declare Sub PrintTree(ByVal tree As RBTree Ptr)
End Type
Constructor NodeQueue()
''Draw first node in the middle of the screen
'(just below the top of the screen)
This.startx = 350
This.starty = 100
This.first = NULL
This.last = NULL
This.count = 1
'800x600, 32 bits color
Screen 19,32
Color ,RGB(255,255,155)
CLS
End Constructor
Destructor NodeQueue()
End Destructor
Function NodeQueue.Enqueue(ByRef item As GraphicsNode Ptr) As Integer
'Insertion into an empty que
If (This.first = NULL) Then
This.first = item
This.last = item
This.Count += 1
Return 0
Else
Var tmp = This.last
This.last = item
This.last->prev = tmp
tmp->nxt = This.last
This.last->nxt = NULL
This.Count += 1
Return 0
End If
Return -1
End Function
Function NodeQueue.Dequeue(ByRef item As GraphicsNode Ptr) As GraphicsNode Ptr
'Dequeueing from an empty queue or a queue with one node
If (This.last = This.first) Then
'Dequeueing from an empty queue
If (This.last = NULL) Then
This.Count -= 1
Return NULL
Else
'Dequeueing from a queue with one node
item->node = This.First->node
item->x = This.First->x
item->y = This.First->y
item->lvl = This.first->lvl
Delete This.first
This.first = NULL
This.last = NULL
This.Count -= 1
Return item
End If
Else
'Dequeueing from a queue with more than one node
Var tmp = This.Last
item->node = This.Last->node
item->x = This.Last->x
item->y = This.Last->y
item->lvl = This.Last->lvl
This.last = This.last->prev
This.last->nxt = NULL
Delete tmp
Return item
End If
Return NULL
End Function
Sub NodeQueue.PrintNode(ByVal item As GraphicsNode Ptr,ByVal x As Integer,ByVal y As Integer)
'Draw a black line from parent node to child node
Line (x,y)-(item->x,item->y),RGB(0,0,0)
'Draw node (either red or black)
If (item->node->color = RED) Then
Circle (item->x,item->y),5,RGB(255,0,0),,,,F
Else
Circle (item->x,item->y),5,RGB(0,0,0),,,,F
End If
Draw String (item->x,item->y - 40),Str(item->node->key),RGB(0,0,0)
Draw String (item->x-8,item->y - 25),"""" & item->node->value & """",RGB(0,0,0)
End Sub
Sub NodeQueue.PrintTree(ByVal tree As RBTree Ptr)
Dim item As GraphicsNode Ptr
Dim current As GraphicsNode Ptr = New GraphicsNode
Dim tmp As GraphicsNode Ptr
Dim lvl As Integer = 1
Dim x As Integer = This.startx
Dim y As Integer = This.starty
'check for empty tree
If (tree->root = tree->sentinel) Then
Return
End If
'Start with printing the root
current->node = tree->root
current->x = x
current->y = y
current->lvl = lvl
This.PrintNode(current,x,y)
While(1)
'Print left node (position it at left side of current node)
If (current->node->left <> tree->sentinel) Then
item = New GraphicsNode
item->lvl = lvl + 1
If (item->lvl <= 9) Then
item->x = x - This.levels(lvl+1)
Else
item->x = x - 10
End If
item->y = y + 50
item->node = current->node->left
This.PrintNode(item,x,y)
This.Enqueue(item)
End If
'Print right node (position it at right side of current node
If (current->node->right <> tree->sentinel) Then
item = New GraphicsNode
item->lvl = lvl + 1
If (item->lvl <= 9) Then
item->x = x + This.levels(lvl+1)
Else
item->x = x + 10
End If
item->y = y + 50
item->node = current->node->right
This.PrintNode(item,x,y)
This.Enqueue(item)
End If
'Continue drawing from first node in the queue
'Nodes in left tree will be drawn first as these are put in
'the queue first
Var tmp = This.Dequeue(current)
'If count smaller then entire tree has been drawn
If (This.count < 1) Then
Exit While
End If
x = current->x
y = current->y
lvl = current->lvl
Wend
End Sub
Dim x As Integer Ptr
Var tree = New RBTree(@integer_compare)
Open Cons For Output As #1
For i As Integer = 0 To 20
Print #1,"Insert ";i
tree->Insertnode(i,Str(i))
Sleep()
Dim print_tree As NodeQueue Ptr
print_tree = New NodeQueue
print_tree->PrintTree(tree)
Delete print_tree
Next i
Print #1,"Starting Deletion after keypress"
Var print_tree = New NodeQueue
print_tree->PrintTree(tree)
Sleep()
Delete print_tree
For i As Integer = 0 To 20
Print #1,"Delete";i
Var n = tree->FindNode(i)
If (n) Then
tree->Deletenode(n)
End If
Sleep()
Dim print_tree As NodeQueue Ptr
print_tree = New NodeQueue
print_tree->PrintTree(tree)
Delete print_tree
Next i
Print #1,"Ending program after keypress"
Sleep()
Close #1
Delete tree
```