------------------------------------------------------------------------------
MC logo
Binary Tree Operations
[^] CSc 404 Assignment 2
------------------------------------------------------------------------------
[CSc 404 Assignment 1] [CSc 404 Assignment 2] [CSc 404 Assignment 3] [CSc 404 Assignment 4] [CSc 404 Assignment 5] [CSc 404 Assignment 6]
[Binary Tree Operations] [A2 Key]
bintree.lsp
;; 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))
            )
        )
    )
)