Binary search tree (Scheme)
This is an implementation of a persistent binary tree. Its persistence is a desirable property: updates are not destructive, and earlier versions of the tree are preserved.
Our binary tree will use a comparison predicate provided by us, so as to be generic in the elements it can contain.
We will represent a binary tree as a three-element list: the node's value, its left child and its right child.The empty list represents a null pointer (an empty child).
First, binary search. We check to see if the current subtree:
1) Is empty, which means the value we are searching for is not in the subtree;
2)The node value in the current subtree is equal to what we're searching for, in which case we return true;
3) The node value is greater than or equal to what we're searching for, so we recursively search its left child;
4) The value can only be in the right child, so we recursively search that.
(define (tree-search tree value tree-<=) (cond ((null? tree) #f) ((equal? value (car tree)) #t) ((tree-<= value (car tree)) (tree-search (cadr tree) value tree-<=)) (else (tree-search (caddr tree) value tree-<=))))
Now, insertion. It is very easy: we just move down the tree using our comparison predicate and insert a new node when we find an empty child.
(define (tree-insert tree value tree-<=) (cond ((null? tree) (list value '() '())) ((tree-<= value (car tree)) (list (car tree) (tree-insert (cadr tree) value tree-<=) (caddr tree))) (else (list (car tree) (cadr tree) (tree-insert (caddr tree) value tree-<=)))))
Now node deletion, which is not as trivial as insertion or search.
1) Deleting a node that has no children is simple: replace it with the null list.
2) Deleting a node with one child is simple also: replace the node with its only child.
3) Deleting a node with two children is more involved: we have to find either the node's in-order predecessor (the rightmost node of the left subtree) or the in-order successor (the leftmost node of the right subtree). We replace the node's value with the in-order predecessor's value and delete the in-order predecessor (which can only have at most 1 child, as its right child is empty by definition).
So the first problem we have to solve is, given a subtree, find its rightmost node, delete it, and return both its value and the new subtree (with the rightmost node deleted). We will return these (the value and the modified tree) in a cons pair.
Deletion of the rightmost node is simple: given that it has no right child, the node is simply substituted for the node's left child.
We use a bit of imperative code to be able to return both the node's value AND the modified subtree in only 1 tree traversal (we might use a functional zipper datastructure too). This is the only thorny part of the problem: how to access a value found at the end of a recursion without destroying the structure the recursion builds. This is the only use of imperative code in this program.
Notice we have to evaluate updated-tree before consing it with value to avoid undefined behaviour. We use the last let to ensure that value has been set before it is consed with updated-tree.
(define (replace-in-order-predecessor tree) (let ((value '())) (define (del-rightmost atree) (cond ((null? (caddr atree)) (begin (set! value (car atree)) (cadr atree))) (else (list (car atree) (cadr atree) (del-rightmost (caddr atree)))))) (let ((updated-tree (del-rightmost tree))) (cons value updated-tree))))
Now we make a function that, given a subtree, deletes its root node. It takes into account the three cases we described: no children, one child and two children:
(define (tree-delete-node tree) (let ((lchild (cadr tree)) (rchild (caddr tree))) (cond ((and (null? lchild) (null? rchild)) '()) ((null? lchild) rchild) ((null? rchild) lchild) (else (let* ((value-lsubtree (replace-in-order-predecessor lchild)) (new-value (car value-lsubtree)) (new-left-subtree (cdr value-lsubtree))) (list new-value new-left-subtree rchild))))))
Now comes the main delete procedure: it is given a value, and it finds and deletes the first node it finds with that value, using the tree-delete-node function. It gives an error if it can't find the value it's supposed to delete.
(define (tree-delete tree value tree-<=) (cond ((null? tree) (error "tree-delete: value not in tree")) ((equal? (car tree) value) (tree-delete-node tree)) ((tree-<= value (car tree)) (list (car tree) (tree-delete (cadr tree) value tree-<=) (caddr tree))) (else (list (car tree) (cadr tree) (tree-delete (caddr tree) value tree-<=)))))
And that's it. Now, let's build a list->tree function and a tree-flattening function in order to implement binary tree sort for testing our tree implementation:
(define (list->tree alist lt-pred) (define (helper blist tree) (if (null? blist) tree (helper (cdr blist) (tree-insert tree (car blist) lt-pred)))) (helper alist '())) (define (tree-fringe tree) (if (null? tree) '() (append (tree-fringe (cadr tree)) (list (car tree)) (tree-fringe (caddr tree))))) (define (tree-sort alist tree-<) (tree-fringe (list->tree alist tree-<) tree-<))
And let's hit the repl with a test case:
> (tree-sort '(2 43 7 8 5 4 23 4556 6 7 4 3 2) <) (2 2 3 4 4 5 6 7 7 8 23 43 4556)
To illustrate the persistence of the structure:
> (define tree1 (list->tree '(3 2 1 4 5) <)) > tree1 (3 (2 (1 () ()) ()) (4 () (5 () ()))) > (tree-delete tree1 4 <) (3 (2 (1 () ()) ()) (5 () ())) > tree1 (3 (2 (1 () ()) ()) (4 () (5 () ())))