Some time later...
Here is a readable version of the code from
ANSI Common Lisp, using
DEFSTRUCT to create doubly-linked binary trees:
- Code: Select all
(defstruct node
(value nil)
(prev nil)
(next nil))
Adding a new node to the tree:
- Code: Select all
(defun tree-insert (object tree sort-function)
"Insert a node containing OBJECT in a binary TREE."
(if (null tree)
(make-node :value object)
(let ((value (node-value tree)))
(if (equal object value)
tree
(if (funcall sort-function object value)
(make-node
:value value
:prev (tree-insert object (node-prev tree) sort-function)
:next (node-next tree))
(make-node
:value value
:next (tree-insert object (node-next tree) sort-function)
:prev (node-prev tree)))))))
The trick is to define the precedence by a sort-function. If the tree contains only numbers, the sort-function would be #'< or #'>, like here:
- Code: Select all
(defvar *tree* nil
"Empty tree.")
(dolist (x '(5 8 4 2 1 9 6 7 3))
(setf *tree* (tree-insert x *tree* #'<)))
Finding nodes in the tree:
- Code: Select all
(defun tree-find (object tree sort-function)
"Find a node containing OBJECT in a binary TREE."
(if (null tree)
nil
(let ((value (node-value tree)))
(if (equal object value)
tree
(if (funcall sort-function object value)
(tree-find object (node-prev tree) sort-function)
(tree-find object (node-next tree) sort-function))))))
Here is how it works:
- Code: Select all
CL-USER> (tree-find 12 *tree* #'<)
NIL
CL-USER> (tree-find 4 *tree* #'<)
#S(NODE :VALUE 4 :PREV NIL :NEXT NIL)
The original code, including functions to remove elements and other stuff, can be found here:
Look for function names starting with "bst-..." (binary search tree).
But I still think that using
DEFCLASS and
MAKE-INSTANCE is the better idea.
- edgar