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