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.
Programming Praxis 
[…] 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, […]
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 rMy solution in Java is here http://codingjunkie.net/?p=268
I got rid of my Java solution and re-did it in Ruby http://codingjunkie.net/?p=295
My implementation in c
http://codepad.org/jnMTN32g
# – 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}]
}
}
}
[…] 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 […]
[…] 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 […]
[…] ordenamiento por mezcla son buenos ejemplos. Lentamente, aprendes cosas más complicadas del tipo crear y editar un árbol de búsquedas dictómicas. Sin embargo, tras aprender estas cosas, al final consigues un puesto de trabajo desarrollando […]