Julienne wrote a beautiful review article that show us not only the algorithm of
red black tree, but how it is designed like so. He also implemented an elegant
C program that can balance the tree in bottom-up or top-down ways. My previous
function (kid root dir dir) was inspired from his implementation.
Kazu reorganized several red black tree insertion algorithms, including Chris
Okasaki’s purely functional way. He also introduced a left-leaning insertion
algorithm that reduces one pattern matching compare to Okasaki’s one. The
programs are elegantly written in Haskell.
Orinal red black tree algorithm
In 1979, Guibas and Sedgewick published the original imperative red black trees:
Leo J. Guibas and Robert Sedgewick.
"A dichromatic framework for balanced trees",
In Proceedings of the 19th Annual Symposium on Computer Science,
pp8-21,
IEEE Computer Society,
1978
The original one has eight unbalanced cases to deal with, while two are
reduced in “Introduction to Algorithms”. The algorithm was derived from
symmetric binary B-tree (2-3-4 tree) which was suggested by Rudof Bayer. All
paths from the root to a leaf in a SBB-tree contains the same number of nodes,
thus make it a perfectly balanced tree. However, it is not a binary search tree.
So Rober Sedgewick and Leonidas Guibas came up with a mnemonic abstraction that
can use red-nodes and black-nodes of a binary tree to simulate SBB-Tree. This is
how the algorithm is formed. To know the details, see
Julienne’s guide.
Julienne modified the original bottom up algorithm to a no parent pointers
style:
structjsw_node*jsw_single(structjsw_node*root,intdir){structjsw_node*save=root->link[!dir];root->link[!dir]=save->link[dir];save->link[dir]=root;root->red=1;// Note that there's color changing here!save->red=0;returnsave;}structjsw_node*jsw_double(structjsw_node*root,intdir){root->link[!dir]=jsw_single(root->link[!dir],!dir);returnjsw_single(root,dir);}structjsw_node*jsw_insert_r(structjsw_node*root,intdata){if(root==NULL)root=make_node(data);elseif(data!=root->data){intdir=root->data<data;root->link[dir]=jsw_insert_r(root->link[dir],data);if(is_red(root->link[dir])){if(is_red(root->link[!dir])){/* Case 1 Color flip */root->red=1;root->link[0]->red=0;root->link[1]->red=0;}else{/* Cases 2 & 3 */if(is_red(root->link[dir]->link[dir]))root=jsw_single(root,!dir);elseif(is_red(root->link[dir]->link[!dir]))root=jsw_double(root,!dir);}}}returnroot;}intjsw_insert(structjsw_tree*tree,intdata){tree->root=jsw_insert_r(tree->root,data);tree->root->red=0;return1;}
Implementation in Lisp
Julienne’s bottom-up algorithm can be easily to be re-written in purely
functional style. The ugly part is the color flipping and assign new branches to
nodes.
(defunrotate-s(nodedir)(mtree-letdirnode((ayb)xc)((x-r(to-rx))(y-b(to-by)))(mtree-expanddir(ay-b(bx-rc)))))(defunrotate-d(nodedir)(mtree-letdirnode(axb)((a-new(rotate-sa(notdir))))(rotate-s(mtree-expanddir(a-newxb))dir)));; Color flipping utilities (defunto-r(x)(make-rb:data(rb-datax):redT))(defunto-b(x)(make-rb:data(rb-datax):rednil))(defuncolor-flip(rootdir)(mtree-letdirroot((ayb)x(czd))((x-r(to-rx))(y-b(to-by))(z-b(to-bz)))(mtree-expanddir((ay-bb)x-r(cz-bd)))))(defunrb-insert-case-rest(rootdir)(cond((is-red(kidrootdirdir))(rotate-sroot(notdir)))((is-red(kidrootdir(notdir)))(rotate-droot(notdir)))(Troot)))(defunrb-insert-r(rootdata)(declare(typefixnumdata))(cond((nullroot)`(nil,(make-rb:datadata)nil))((=data(node-dataroot))root)(T(let((dir(>data(node-dataroot))))(mtree-letdirroot(axb)((b(rb-insert-rbdata))(root(mtree-expanddir(axb))))(if(is-redb)(if(is-reda)(color-fliprootdir); case 1(rb-insert-case-restrootdir)); case 2 and 3root))))))(defparameter*tree*nil)(defunrb-insert(data)(declare(typefixnumdata))(let*((ret(rb-insert-r*tree*data))(a(carret));; Set the root node to be black(x-b(to-b(cadrret)))(b(caddrret)))(setf*tree*(listax-bb))*tree*))
When the cases in function are separated, it is easy to tell how the program is being called: