# Red black tree sort/Phix

Library: Phix/online

With extra validation. You can run this online here. The output will of course be different every time you open (or F5 reload) that, and not quite match that below.

```--
-- demo\rosetta\Red_Black_Tree.exw
-- ===============================
--
with javascript_semantics
constant SENTINEL=1
sequence rbtree = {} -- node indices are 1(""),6,11,16,21,etc.
constant PARENT = 0, COLOUR = 1, VALUE = 2, LEFT = 3, RIGHT = 4
--(also uses the builtin constants BLACK = 0 and RED = 4)
integer root = SENTINEL,
freelist = NULL

function new_node(object key, integer colour=RED)
integer res = freelist
if res then
freelist = rbtree[freelist]
else
res = length(rbtree)+1
rbtree &= repeat(0,5)
end if
rbtree[res+PARENT] = NULL
rbtree[res+COLOUR] = colour
rbtree[res+VALUE] = key
rbtree[res+LEFT] = SENTINEL
rbtree[res+RIGHT] = SENTINEL
return res
end function
assert(new_node(0,BLACK)=SENTINEL)

procedure release_node(integer n)
assert(n!=SENTINEL)
rbtree[n] = freelist
freelist = n
end procedure

procedure rotate(integer x, d)
--
--      x                        y
--     / \                      / \
--    y   c     == right ==>   a   x
--   / \        <== left ==       / \
--  a   b                        b   c
--
-- (param x is the top node, for d=LEFT
--  swap x and y in the above diagram.)
--
assert(x!=NULL and x!=SENTINEL)
assert(d=LEFT or d=RIGHT)
integer e = LEFT+RIGHT-d,
y = rbtree[x+e],
b = rbtree[y+d],
p = rbtree[x+PARENT],
q = iff(x=rbtree[p+RIGHT]?RIGHT:LEFT)
rbtree[x+e] = b
if b != SENTINEL then
rbtree[b+PARENT] = x
end if
rbtree[y+PARENT] = p
if p == NULL then
root = y
else
rbtree[p+q] = y
end if
rbtree[y+d] = x
rbtree[x+PARENT] = y
end procedure

procedure fix_up_insertion(integer k)
integer p = rbtree[k+PARENT]
while rbtree[p+COLOUR] == RED do
integer gp = rbtree[p+PARENT],
d = iff(p=rbtree[gp+RIGHT]?LEFT:RIGHT),
rd = LEFT+RIGHT-d,
uncle = rbtree[gp+d]
if uncle!=SENTINEL and rbtree[uncle+COLOUR] == RED then
rbtree[uncle+COLOUR] = BLACK
rbtree[p+COLOUR] = BLACK
rbtree[gp+COLOUR] = RED
k = gp  // repeat with grandparent
else
if k == rbtree[p+d] then
k = p
rotate(k,rd)
p = rbtree[k+PARENT]
end if
rbtree[p+COLOUR] = BLACK
rbtree[gp+COLOUR] = RED
rotate(gp,d)
end if
if k == root then exit end if
p = rbtree[k+PARENT]
end while
rbtree[root+COLOUR] = BLACK
end procedure

procedure insert_node(object key)
integer node = new_node(key),
y = NULL, x = root, d
// y := (sentinel) position for new node
// (nb as-is this allows duplicates, it
//  may want to be more like delete_node)
while x!=SENTINEL do
y = x
d = iff(key<rbtree[x+VALUE]?LEFT:RIGHT)
x = rbtree[x+d]
end while

rbtree[node+PARENT] = y
if y == NULL then
root = node
else
assert(rbtree[y+d] = SENTINEL)
rbtree[y+d] = node
end if

if y == NULL then
rbtree[node+COLOUR] = BLACK
elsif rbtree[y+PARENT] != NULL then
fix_up_insertion(node)
end if
end procedure

procedure fix_up_deletion(integer x)
-- (Don't think I could adequately comment this even if I tried,
--  but it is basically the same as several of the other entries.
--  This routine needs that sentinal and is why we can't use NULL)
while x!=root and rbtree[x+COLOUR] == BLACK do
integer parent = rbtree[x+PARENT],
d = iff(x=rbtree[parent+LEFT]?RIGHT:LEFT),
rd = RIGHT+LEFT-d,
sibling = rbtree[parent+d]
if rbtree[sibling+COLOUR] == RED then
rbtree[sibling+COLOUR] = BLACK
rbtree[parent+COLOUR] = RED
rotate(parent,rd)
sibling = rbtree[parent+d]
end if
if rbtree[rbtree[sibling+LEFT]+COLOUR] == BLACK
and rbtree[rbtree[sibling+RIGHT]+COLOUR] == BLACK then
rbtree[sibling+COLOUR] = RED
x = parent
else
if rbtree[rbtree[sibling+d]+COLOUR] == BLACK then
rbtree[rbtree[sibling+rd]+COLOUR] = BLACK
rbtree[sibling+COLOUR] = RED
rotate(sibling,d)
sibling = rbtree[parent+d]
end if
rbtree[sibling+COLOUR] = rbtree[parent+COLOUR]
rbtree[parent+COLOUR] = BLACK
rbtree[rbtree[sibling+d]+COLOUR] = BLACK
rotate(parent,rd)
x = root
end if
end while
rbtree[x+COLOUR] = BLACK
end procedure

procedure rb_transplant(integer u, v)
integer p = rbtree[u+PARENT]
if p=NULL then
root = v
elsif u=rbtree[p+LEFT] then
rbtree[p+LEFT] = v
else
rbtree[p+RIGHT] = v
end if
rbtree[v+PARENT] = p
end procedure

function find_node(integer node, object key)
while node != SENTINEL do
integer c = compare(key,rbtree[node+VALUE])
if c == 0 then exit end if -- found!
node = rbtree[node+iff(c=-1?LEFT:RIGHT)]
end while
return node
end function

procedure delete_node(object key)
integer z = find_node(root,key)
if z == SENTINEL then
printf(1,"Key %d not present in Tree !!\n",key)
return
end if

integer y = z, x,
y_original_color = rbtree[y+COLOUR]
if rbtree[z+LEFT] == SENTINEL then
x = rbtree[z+RIGHT]
rb_transplant(z, x)
elsif rbtree[z+RIGHT] == SENTINEL then
x = rbtree[z+LEFT]
rb_transplant(z, x)
else // z has both child nodes
-- y := minimum/leftmost in right subtree:
y = rbtree[z+RIGHT]
while rbtree[y+LEFT] != SENTINEL do
y = rbtree[y+LEFT]
end while
y_original_color = rbtree[y+COLOUR]
x = rbtree[y+RIGHT]
if rbtree[y+PARENT] == z then
rbtree[x+PARENT] = y
else
rb_transplant(y, x)
integer r = rbtree[z+RIGHT]
rbtree[y+RIGHT] = r
rbtree[r+PARENT] = y
end if
rb_transplant(z, y)
integer l = rbtree[z+LEFT]
rbtree[y+LEFT] = l
rbtree[l+PARENT] = y
rbtree[y+COLOUR] = rbtree[z+COLOUR]
end if
if y_original_color == BLACK then
fix_up_deletion(x)
end if
release_node(z)
end procedure

procedure visualise_tree(integer tree=root, string prefix="+---")
if tree=SENTINEL then
printf(1,"<empty>\n")
else
string colour = iff(rbtree[tree+COLOUR]=RED?"RED":"BLACK")
integer v = rbtree[tree+VALUE],
left = rbtree[tree+LEFT],
right = rbtree[tree+RIGHT]
integer g = prefix[-4]
if left!=SENTINEL then
string g4 = prefix[-4..-1]
prefix[-4..-1] = iff(g='L' or g='+'?"    ":"|   ")
visualise_tree(left,prefix&"L---")
prefix[-4..-1] = g4
end if
string plus = iff(left!=SENTINEL or right!=SENTINEL?"+":"")
printf(1,"%s%s %v (%s)\n",{prefix,plus,v,colour})
if right!=SENTINEL then
prefix[-4..-1] = iff(g='L'?"|   ":"    ")
visualise_tree(right,prefix&"R---")
end if
end if
end procedure

function isBalanced(integer node)
if node != SENTINEL then
integer {lok, lmxh, lmnh} = isBalanced(rbtree[node+LEFT]),
{rok, rmxh, rmnh} = isBalanced(rbtree[node+RIGHT]),
maxh = max(lmxh, rmxh) + 1,
minh = min(lmnh, rmnh) + 1;
if lok and rok and maxh <= 2*minh then
return {true,maxh,minh}
end if
end if
return {node==SENTINEL,0,0}
end function

function BlackHeight(integer node)
if node == SENTINEL then return 1 end if
integer leftBlackHeight = BlackHeight(rbtree[node+LEFT]),
rightBlackHeight = BlackHeight(rbtree[node+RIGHT])
if leftBlackHeight != 0
and rightBlackHeight != 0
and leftBlackHeight == rightBlackHeight then
return rightBlackHeight + (rbtree[node+COLOUR]=BLACK)
end if
return 0
end function

procedure validate_tree()
string why = iff(not isBalanced(root)[1]?"balance":
iff(BlackHeight(root)=0?"height":""))
if length(why) then
visualise_tree()
crash("invalid(%s)",{why})
end if
end procedure

printf(1,"State of the tree after inserting 30 keys:\n")
for x in shuffle(tagset(30)) do
insert_node(x)
validate_tree()
end for
visualise_tree()

printf(1,"\nState of the tree after deleting 15 keys:\n")
for x in shuffle(tagset(30))[1..15] do
delete_node(x)
validate_tree()
end for
visualise_tree()
```
Output:
```State of the tree after inserting 30 keys:
L--- 1 (RED)
L---+ 2 (BLACK)
L---+ 3 (BLACK)
|   |   L--- 4 (RED)
|   R---+ 5 (BLACK)
L---+ 6 (RED)
|   |       L--- 7 (RED)
|   |   L---+ 8 (BLACK)
|   R---+ 9 (BLACK)
|       |   L---+ 10 (BLACK)
|       |   |   R--- 11 (RED)
|       R---+ 12 (RED)
|           R---+ 13 (BLACK)
|               R--- 14 (RED)
+---+ 15 (BLACK)
|               L--- 16 (RED)
|           L---+ 17 (BLACK)
|           |   R--- 18 (RED)
|       L---+ 19 (RED)
|       |   R--- 20 (BLACK)
|   L---+ 21 (BLACK)
|   |   |   L--- 22 (RED)
|   |   R---+ 23 (BLACK)
|   |       R--- 24 (RED)
R---+ 25 (RED)
|       L--- 26 (RED)
|   L---+ 27 (BLACK)
|   |   R--- 28 (RED)
R---+ 29 (BLACK)
R--- 30 (BLACK)

State of the tree after deleting 15 keys:
L--- 3 (BLACK)
L---+ 6 (BLACK)
|   |       L--- 7 (RED)
|   |   L---+ 8 (BLACK)
|   R---+ 10 (RED)
|       R--- 11 (BLACK)
+---+ 17 (BLACK)
|       L--- 19 (BLACK)
|   L---+ 20 (BLACK)
|   |   R--- 24 (BLACK)
R---+ 25 (RED)
|       L--- 26 (RED)
|   L---+ 27 (BLACK)
R---+ 29 (BLACK)
R--- 30 (BLACK)
```