;; 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)) ) ) ) )