Binary Tree Operations
;; This file implements operations on binary search trees built inside
;; lisp lists. This is effectively a bag of integers, though it could
;; be adapted to a different key type. The following primary
;; methods are implemented in this file:
;;
;; (btree-insert item tree)
;; Insert the item into the tree, and return the updated tree.
;;
;; (btree-insert-all list tree)
;; Inserts each member of list into tree and returns the result.
;;
;; (btree-delete item tree)
;; Remove the item from the tree, if it exists, and return the updated
;; tree. If the tree does not contain the item, return the tree unchanged.
;;
;; (btree-print tree)
;; This prints the tree and returns nil.
;;
;; Several implementation and helper methods are defined. See below.
;;
;; The representation of a binary tree is as follows:
;; nil represents the empty tree.
;; (value left right) a list of size three represents a tree with value at
;; the root, and left and right being the left and
;; right subtrees. Left and right are also binary trees.
;;
;; 15 (15 (7 (2 nil nil) (10 nil nil))
;; / \ (22 nil (30 nil nil)))
;; 7 22
;; / \ \
;; 2 10 30
;; Utilities for accessing root node fields. These are for readability.
;; Extract the parts of a node.
(define (rootvalue tree) (car tree)) ; (VALUE left right)
(define (leftsub tree) (cadr tree)) ; (value LEFT right)
(define (rightsub tree) (caddr tree)) ; (value left RIGHT)
;; Create a tree by making a new root node from a root item and subtrees.
(define (mktree value leftsub rightsub) (list value leftsub rightsub))
(define (empty? tree) (null? tree))
;; This just sets an alias for <. It can be re-defined to adapt the
;; the tree methods to a different content type. (This is rather crude,
;; but Tomslsp lacks templates or abstract types or anything like that
;; which could make it smoother.)
(define (smaller? x y) (< x y))
;; Print the tree in a semi-readable form, sidways with root on the left.
;; (It's better than seeing all those parens!) Lie on your left side to
;; look at it.
(define (btree-print tree)
(begin
; Recursive partner does all the work.
(btree-print-r "" tree)
)
)
;; Does the work for printing.
(define (btree-print-r pref tree)
(if (not (empty? tree)) (begin
(btree-print-r (string-append pref " ") (rightsub tree))
(sprint pref)
(print (rootvalue tree))
(sprint "\n")
(btree-print-r (string-append pref " ") (leftsub tree))
))
)
;; (btree-insert item tree)
(define (btree-insert item tree)
(cond
((empty? tree) ; If empty, create a one-node tree.
(mktree item nil nil))
((smaller? item (rootvalue tree))
; If item should go to the left, build a new tree with the
; item inserted there.
(mktree (rootvalue tree)
(btree-insert item (leftsub tree)) (rightsub tree)))
(#t
; If item should go to the right, likewise.
(mktree (rootvalue tree)
(leftsub tree) (btree-insert item (rightsub tree))))
)
)
;; Insert each item in the list into the tree.
(define (btree-insert-all list tree)
(if (null? list)
tree
(btree-insert-all (cdr list) (btree-insert (car list) tree))
)
)
;; Move the minimum member of the tree to its root. If the root is already
;; the minimum element, the tree is returned unchanged.
(define (btree-min-to-root tree)
(if (empty? (leftsub tree))
; No left subtree. Root is already the minimum.
tree
; Move the min of the left subtree to its root, then rotate
; its root up, and ours down to the right. That will leave
; us with no left subtree, meaning the root is our min. This
; moving around is the same as the right rotation for AVL trees.
(let
((left-w/-min-at-root (btree-min-to-root (leftsub tree))))
(mktree (rootvalue left-w/-min-at-root) nil
(mktree (rootvalue tree)
(rightsub left-w/-min-at-root)
(rightsub tree)
)
)
)
)
)
;; Delete the root node from the binary tree. Assumes the tree is not empty.
(define (btree-delete-root tree)
(cond
; If one sub-tree is empty, return the other.
((empty? (leftsub tree)) (rightsub tree))
((empty? (rightsub tree)) (leftsub tree))
; Massage the right subtree so it has no left subtree (its root is
; its minimum). Then move its root in place of ours.
(#t
(let
((right-w/-min-at-root (btree-min-to-root (rightsub tree))))
(mktree (rootvalue right-w/-min-at-root)
(leftsub tree) (rightsub right-w/-min-at-root))
)
)
)
)
;; Delete a node. If not present, return the tree unchanged.
(define (btree-delete item tree)
(cond
; Not there. We're done.
((empty? tree) tree)
; Found it. Use the helper to delete it.
((= (rootvalue tree) item) (btree-delete-root tree))
; Remove from the appropriate subtree, and rebuild the result.
((smaller? item (rootvalue tree))
(mktree (rootvalue tree)
(btree-delete item (leftsub tree))
(rightsub tree)
)
)
(#t
(mktree (rootvalue tree)
(leftsub tree)
(btree-delete item (rightsub tree))
)
)
)
)