8
\$\begingroup\$

Yes I'm very slowly making my way through Purely Functional Data Structures. So I went through the section on Red Black Trees. What he presents is amazingly concise, except for the fact that he didn't include the delete function. Searching around didn't turn up many functional delete methods, well only two so far. One in Haskell the other in Racket (a version of Scheme I think). The Haskell code seemed rather impenetrable to me so I went with trying to grok the Racket version from Matt Might. My scheme experience is pretty rusty, but my Haskell knowledge is nill.

The code below is what I came up with. You can see the complete implementation of RedBlackTree.fs here. I'm sure that there are still problems in this implementation since I haven't fully tested it yet. My main question for the more experienced guys is does what Matt has laid out here really make sense? And do you think the way I've tried to implement this in F# is going to work?

If you read Matt's blog you'll see a description of how he is approaching the problem. He adds two new colors (double black and negative black) to the tree temporarily during the delete. He also has this notion of a double black leaf, and that is where my main point of confusion lies. After a delete a double black leaf is sometimes left behind (when the element being deleted has no children). So it appears that the double black leaf isn't temporary. It's not clear to me based on his description if this is what was intended or I still have some problem in my logic.

Thanks for taking a look at this,

Derek

// BB = double-black
// NB = negative-black
type Color = R | B | BB | NB
type Tree<'e when 'e :> IComparable> =
    | L | BBL               // BBL = double-black leaf
    | T of Color * Tree<'e> * 'e * Tree<'e>

module RedBlackTree =
    let empty = L
...
let addBlack c =
    match c with
    | B -> BB
    | R -> B
    | NB -> R
    | BB -> failwith "BB Nodes should only be temporary"

let subBlack c =
    match c with
    | B -> R
    | R -> NB
    | BB -> B
    | NB -> failwith "NB Nodes should only be temporary"

let redden n =
    match n with
    | L | BBL -> n
    | T(_,l,v,r) -> T(R,l,v,r)

let blacken node =
    match node with
    | BBL        -> L
    | T(_,l,v,r) -> T(B,l,v,r)
    | _          -> node

let rec balanceNode clr tl e tr =
    match clr, tl, e, tr with
    | BB,T(R, T(R,a,x,b),y,c), z, d 
    | BB,T(R,a,x, T(R,b,y,c)), z, d 
    | BB,a,x, T(R, T(R,b,y,c),z,d)  
    | BB,a,x, T(R,b,y, T(R,c,z,d)) 
    | B,T(R, T(R,a,x,b),y,c), z, d 
    | B,T(R,a,x, T(R,b,y,c)), z, d 
    | B,a,x, T(R, T(R,b,y,c),z,d)  
    | B,a,x, T(R,b,y, T(R,c,z,d))  -> 
        T((subBlack clr), T(B,a,x,b), y, T(B,c,z,d))
    | BB,a,x,T(NB,T(B,b,y,c),z,(T(B,_,_,_) as d)) ->
        T(B,T(B,a,x,b),y, balanceNode B c z (redden d))
    | BB,T(NB,(T(B,_,_,_) as a),x,T(B,b,y,c)),z,d ->
        T(B, (balanceNode B (redden a) x b), y, T(B,c,z,d))
    | _,_,_,_ -> T(clr,tl,e,tr)

let bubble t =
    match t with
    | T(c,(T(lc,ll,lv,lr) as lt),v, (T(rc,rl,rv,rr) as rt)) ->
        if lc = BB || rc = BB then
            balanceNode (addBlack c) (T(subBlack lc,ll,lv,lr)) v (T(subBlack rc,rl,rv,rr))
        else
            t
    | _ -> t

let isLeaf node =
    match node with
    | L | BBL -> true
    | _       -> false

let rec getMax node =
    match node with
    | L | BBL -> None
    | T(c,l,v,r) -> 
        match (isLeaf l), (isLeaf r) with
        | false, true
        | true,true -> Some(v)
        | _,_       -> getMax r

let rec remove node =
    match node with
    | L | BBL -> node
    | T(nc, lchild, nv, rchild) ->
        match (isLeaf lchild),(isLeaf rchild) with
        | true,true ->
            match nc with
            | R -> L
            | B -> BBL
            | _ -> failwith "Illegal black node"
        | true,false ->
            match nc,rchild with
            | R,T(rc,rl,rv,rr) -> rchild
            | B,T(rc,rl,rv,rr)-> 
                match rc with
                | R -> T(B,rl,rv,rr)
                | B -> T(addBlack rc,rl,rv,rr)
                | _ -> failwith "Illegal black node"
            | _ -> failwith "Illegal black node"
        | false,true ->
            match nc,lchild with
            | R,T(lc,ll,lv,lr) -> lchild
            | B,T(lc,ll,lv,lr) -> 
                match lc with
                | R -> T(B,ll,lv,lr)
                | B -> T(addBlack lc,ll,lv,lr)
                | _ -> failwith "Illegal black node"
            | _ -> failwith "Illegal black node"
        | false,false ->
            let max = (getMax lchild).Value
            let t = removeMax lchild
            bubble (T(nc,t,max,rchild))

and removeMax node =
    match node with
    | T(c,l,v,r) -> 
        if isLeaf r then
            remove node
        else
            bubble (T(c,l,v, removeMax r))
    | _ -> node

let delete key node =
    let rec del (key : IComparable) node =
        match node with
        | T(c,l,v,r) ->
            match key.CompareTo v with
            | -1 -> bubble (T(c,(del key l),v,r))
            |  0 -> remove node
            |  _ -> bubble (T(c,l,v,(del key r)))
        | _ -> node

    blacken (del key node)
\$\endgroup\$

migrated from stackoverflow.com Jul 14 '11 at 19:33

This question came from our site for professional and enthusiast programmers.

  • 2
    \$\begingroup\$ The built-in Set type is implemented using Red-Black trees and includes a remove function, so you could look at the source for that. \$\endgroup\$ – petebu Jul 12 '11 at 11:31
  • \$\begingroup\$ Actually the Set.fs file isn't a red black tree. Probably an AVL tree which is close, but not quite the same. \$\endgroup\$ – Derek Ealy Jul 16 '11 at 17:04
4
\$\begingroup\$

Google for "left leaning red black trees"; they're Sedgewick's (substantial) simplification of RB trees and the paper includes all the code, including delete. By adding the constraint that all "three-nodes" lean left, the number of cases you need to consider is reduced dramatically.

Hope this helps.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.