Binary Search Tree

March 5, 2010

Trees are represented by four-slot vectors with the key in slot 0, value in slot 1, left child in slot 2, and right child in slot 3. You might want to define the access functions as macros, so they can be inlined for speed, but we won’t bother:

(define (tree k v l r) (vector k v l r))
(define (key t) (vector-ref t 0))
(define (val t) (vector-ref t 1))
(define (lkid t) (vector-ref t 2))
(define (rkid t) (vector-ref t 3))
(define nil (vector 'nil 'nil 'nil 'nil))
(define (nil? t) (eq? t nil))
(define (nil! k) (vector-set! nil 0 k))
(define (leaf-or-nil? t) (eq? (lkid t) (rkid t)))
(define (leaf? t) (and (nil? (lkid t)) (nil? (rkid t))))

As nodes are dynamically inserted into and deleted from the tree, it is sometimes necessary to restructure the tree. The restructurings, known as rotations, come in two varieties, left and right, as shown in the image at right. In both trees shown above, all the nodes in sub-tree A have keys less than x, all the nodes in sub-tree B have keys between x and y, and all the nodes in sub-tree C have keys greater than y. Transforming the tree so that the root moves from x to y is called a left rotation, and transforming the tree so that the root moves from y to x is called a right rotation; in both cases the root node moves down the tree toward the leaves. Functions that perform rotations take a node and return a newly-allocated node with the children rotated as desired:

(define (rot-left t)
  (let ((l (tree (key t) (val t) (lkid t) (lkid (rkid t)))))
    (tree (key (rkid t)) (val (rkid t)) l (rkid (rkid t)))))

(define (rot-right t)
  (let ((r (tree (key t) (val t) (rkid (lkid t)) (rkid t))))
    (tree (key (lkid t)) (val (lkid t)) (lkid (lkid t)) r)))

Starting at the root, lookup compares the key being sought to the current key, branching either left or right depending on the outcome of the comparison. Lookup terminates with failure if it reaches a nil node, and terminates with success if the compare returns equal:

(define (lookup lt? t k)
  (cond ((nil? t) #f)
        ((lt? k (key t)) (lookup lt? (lkid t) k))
        ((lt? (key t) k) (lookup lt? (rkid t) k))
        (else (cons k (val t)))))

Insert traverses to the insertion point, using the same comparisons as lookup, where a new node is written:

(define (insert lt? t k v)
  (cond ((nil? t) (tree k v nil nil))
        ((lt? k (key t)) (tree (key t) (val t) (insert lt? (lkid t) k v) (rkid t)))
        ((lt? (key t) k) (tree (key t) (val t) (lkid t) (insert lt? (rkid t) k v)))
        (else (tree k v (lkid t) (rkid t)))))

Delete begins by setting the desired key in the nil node as a sentinel, then searches, rebuilding nodes as it proceeds, until the key being deleted is found. Then delete calls an auxiliary procedure, deroot, that rotates the current node down until it becomes a leaf, where it is clipped off. To minimize imbalance, the first rotation is chosen at random, then rotations are alternated left and right:

(define (deroot t left?)
  (cond ((leaf-or-nil? t) nil)
        (left? (let ((t (rot-left t)))
                 (tree (key t) (val t) (deroot (lkid t) #f) (rkid t))))
        (else (let ((t (rot-right t)))
                (tree (key t) (val t) (lkid t) (deroot (rkid t) #t))))))

(define (delete lt? t k)
  (nil! k)
  (cond ((lt? k (key t))
          (tree (key t) (val t) (delete lt? (lkid t) k) (rkid t)))
        ((lt? (key t) k)
          (tree (key t) (val t) (lkid t) (delete lt? (rkid t) k)))
        (else (deroot t (zero? (randint 2))))))

To form a list, a tree is flattened in-order:

(define (enlist t)
  (cond ((nil? t) '())
        ((leaf? t) (list (cons (key t) (val t))))
        (else (append (enlist (lkid t))
                      (list (cons (key t) (val t)))
                      (enlist (rkid t))))))

All these operations are purely functional; insert and delete return a newly-allocated tree, leaving the original unchanged, but sharing those nodes they use in common. Here are some examples:

> (define t (insert < nil 4 4))
> (set! t (insert < t 1 1))
> (set! t (insert < t 3 3))
> (set! t (insert < t 5 5))
> (set! t (insert < t 2 2))
> (enlist t)
((1 . 1) (2 . 2) (3 . 3) (4 . 4) (5 . 5))
> (lookup < t 3)
(3 . 3)
> (lookup < t 9)
#f
> (set! t (delete < t 4))
> (set! t (delete < t 2))
> (set! t (delete < t 3))
> (set! t (delete < t 5))
> (set! t (delete < t 1))
> (enlist t)
()

We use randint from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/5TkexKqB.

About these ads

Pages: 1 2

8 Responses to “Binary Search Tree”

  1. [...] Praxis – Binary Search Tree By Remco Niemeijer In today’s Programming Praxis exercise we have to implement a Binary Search Tree. Let’s get started, [...]

  2. Remco Niemeijer said

    My Haskell solution (see http://bonsaicode.wordpress.com/2010/03/05/programming-praxis-binary-search-tree/ for a version with comments):

    import Control.Monad
    import System.Random
    
    data BTree k v = Node k v (BTree k v) (BTree k v) | Empty
    
    find :: (k -> k -> Ordering) -> k -> BTree k v -> Maybe v
    find _   _ Empty          = Nothing
    find cmp k (Node k' v' l r) = case cmp k k' of EQ -> Just v'
                                                   LT -> find cmp k l
                                                   GT -> find cmp k r
    
    insert :: (k -> k -> Ordering) -> k -> v -> BTree k v -> BTree k v
    insert _   k v Empty            = Node k v Empty Empty
    insert cmp k v (Node k' v' l r) = case cmp k k' of
        EQ -> Node k v l r
        LT -> Node k' v' (insert cmp k v l) r
        GT -> Node k' v' l (insert cmp k v r)
    
    delete :: (k -> k -> Ordering) -> k -> BTree k v -> IO (BTree k v)
    delete _   _ Empty              = return Empty
    delete cmp k t@(Node k' v' l r) = case cmp k k' of
        EQ -> fmap (flip deroot t . (== 0)) $ randomRIO (0,1 :: Int)
        LT -> fmap (flip (Node k' v') r) $ delete cmp k l
        GT -> fmap (      Node k' v'  l) $ delete cmp k r
    
    deroot :: Bool -> BTree k v -> BTree k v
    deroot _    Empty              = Empty
    deroot _    (Node _ _ l Empty) = l
    deroot _    (Node _ _ Empty r) = r
    deroot True (Node k v l (Node rk rv rl rr)) =
        Node rk rv (deroot False $ Node k v l rl) rr
    deroot _    (Node k v (Node lk lv ll lr) r) =
        Node lk lv ll (deroot True $ Node k v lr r)
    
    toList :: BTree k v -> [(k, v)]
    toList Empty          = []
    toList (Node k v l r) = toList l ++ (k, v) : toList r
    
  3. Bill B said

    I got rid of my Java solution and re-did it in Ruby http://codingjunkie.net/?p=295

  4. Vikas Tandi said

    My implementation in c

    http://codepad.org/jnMTN32g

  5. Robert said

    # – A presorted list of numbers to search through.
    # – The item to search for in the list.

    proc binSrch {lst x} {
    set len [llength $lst]
    if {$len == 0} {
    return -1
    } else {
    set pivotIndex [expr {$len / 2}]
    set pivotValue [lindex $lst $pivotIndex]
    if {$pivotValue == $x} {
    return $pivotIndex
    } elseif {$pivotValue -1 ? $recursive + $pivotIndex + 1 : -1}]
    } elseif {$pivotValue > $x} {
    set recursive [binSrch [lrange $lst 0 $pivotIndex-1] $x]
    return [expr {$recursive > -1 ? $recursive : -1}]
    }
    }
    }

  6. [...] binary search and merge sort are good examples. Slowly, you learn more complicated things like creating and modifying a binary search tree. However, after learning these things, you eventually get a job building applications and you [...]

  7. [...] binary search and merge sort are good examples. Slowly, you learn more complicated things like creating and modifying a binary search tree. However, after learning these things, you eventually get a job building applications and you [...]

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 609 other followers

%d bloggers like this: