khogali
khogali

Reputation: 1

LISP function for building a binary search tree is not working and I don't understand why

(defun leftorright (element tree)
  (cond ((null (car tree))
         (setf tree
               (cons element (cons (cons NIL NIL) (cons NIL  NIL)))))
        ((>= element (car tree))
         (if (null (caddr tree))
             (setf (cddr tree)
                   (cons element (cons (cons NIL NIL) (cons NIL NIL))))
            (leftorright element (cddr tree))))
        ((< element (car tree))
         (if (null (caaddr tree))
             (setf (cadr tree)
                   (cons element (cons (cons NIL NIL) (cons NIL NIL))))
             (leftorright element (cadr tree))))))

(setf tree (cons NIL NIL))
(print tree)
(leftorright 8 tree)
(leftorright 3 tree)
(leftorright 6 tree)
(leftorright 4 tree)
(leftorright 7 tree)
(print tree)

Upvotes: 0

Views: 100

Answers (1)

Gwang-Jin Kim
Gwang-Jin Kim

Reputation: 9865

(defun leftorright (element tree)
  (cond ((null (car tree))
         (setf tree
               (cons element (cons (cons NIL NIL) (cons NIL  NIL)))))
        ((>= element (car tree))
         (if (null (caddr tree))
             (setf (cddr tree)
                   (cons element (cons (cons NIL NIL) (cons NIL NIL))))
            (leftorright element (cddr tree))))
        ((< element (car tree))
         (if (null (caaddr tree))
             (setf (cadr tree)
                   (cons element (cons (cons NIL NIL) (cons NIL NIL))))
             (leftorright element (cadr tree))))))

So looking at

(setf tree (cons NIL NIL))
(print tree)

You think of the tree structure as something with 2 slots - a left and a right one. leftorright is actually an inser function which takes an element and fits the element into either left or right slot of a tree.

(null (car tree)) considers the case that the tree is empty. In that case you want to set tree (cons element (cons (cons NIL NIL) (cons NIL NIL))). Let's take 'element as value for element just to see the returned structure: (ELEMENT (NIL) NIL) Here is already some problem. Why not (element nil nil)? OR: (element (nil) (nil))? In the next cond clauses, you distinguish between the cases that element is >= (car tree) (the current value?) and < than (car tree). Then, in the next step you distinguish the case that the first subtree (caddr tree) is null - thus empty. In that case you again build (element (nil) nil). But you assign it to some subparts of tree. (caddr tree) or (cadr tree). If they are not empty you delegate to leftorright to handle those subtreeparts.

So as many commentators point our, your (setf tree ...) expressions are problematic - because they are mutating tree - obviously you come from some non-lisp language (which we lispers call blubb language) and try to think in the blubb way - meaning imperatively.

The lisp-way for such tree functions is always to recursively construct a tree and return the entire tree.

Recursion means to break down the cases into the very primitive and simple cases - and just to think-through one step.

So what is the most primitive case of tree? - If we assume that it is actually a list - probably of the length 3 (current-value left right).

The most primitive tree is the empty tree. (null tree).

So we start with

(defun insert (element tree)
  (cond ((null tree) (cons element (cons nil (cons nil nil))))
        ...))

However, cons cons cons is not as nice as once a list. So let's do:

(defun insert (element tree)
  (cond ((null tree) (list element nil nil))
         ...))

And we use list for constructing a tree.

If the tree is not empty, it contains 3 slots - the first for the element (current-value) and the seconds and third slots are for sub-trees (either an empty-tree - '() - or another 3-slot-list - a real tree.

For the next element which gets inserted to any non-empty tree - the criterion is the current value. Any element >= than the current value gets inserted as a tree into the right slot. Otherwise/else/< into the left slot.

(defun insert (element tree)
  (cond ((null tree)
         (list element
               nil
               nil))
        ((>= element (car tree))
         (list (car tree) (cadr tree) (insert element (caddr tree))))
        (t
         (list (car tree) (insert element (cadr tree)) (caddr tree)))))

and that is actually what you wanted. Let's use it:

(defparameter *tree* nil) ;; generate an empty tree

Now let's insert - but now we assign the result anew to *tree* using setf.

(setf *tree* (insert 8 *tree*))
(setf *tree* (insert 3 *tree*))
(setf *tree* (insert 6 *tree*))
(setf *tree* (insert 4 *tree*))
(setf *tree* (insert 7 *tree*))

;; let's see how now *tree* looks like:
*tree*
;; => (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)

Let's improve the function

We are lazy, we don't want to write so often setf and we want to give in order the numbers to be inserted.

First, we change the order of the arguments:

(defun insert (tree element)
  (cond ((null tree)
         (list element
               nil
               nil))
        ((>= element (car tree))
         (list (car tree) (cadr tree) (insert (caddr tree) element)))
        (t
         (list (car tree) (insert (cadr tree) element) (caddr tree)))))

And then, we make this function variadic - means it can take as many arguments as we want (namely the sequence of the elements):

(defun insert* (tree &rest elements)
  (let ((tree tree))
    (loop for e in elements
          do (setf tree (insert tree e))
          finally (return tree))))

Now we can do:

(insert* '() 8 3 6 4 7)
;;=> (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)

The nice thing is, we used a local (let ((tree tree)) ...) and we loop over the elements and do (setf tree ...) meaning we mutate the local tree only. So the global variable given for tree is unaffected. Unless we setf the new result to the global tree's variable. Like this:

(defparameter *tree* '())
(setf *tree* (insert* *tree* 8 3 6 4 7))
*tree*
;;=> (8 (3 NIL (6 (4 NIL NIL) (7 NIL NIL))) NIL)

setf is necessary to change the *tree* value. Look:

(defparameter *tree* '())
(insert* *tree* 8 3 6 4 7)
*tree*
;;=> NIL  ;; original *tree* value is not altered by `insert*` function!

Destructive insert!

I also tried a destructive insert!. However, perhaps things could be improved. I am open for suggestions.

(defun %insert! (tree element &optional (acc '()))
  "Generate setf expression for `insert!` macro!"
  (cond ((null tree)
         (nreverse (cons (list element nil nil) acc)))
        ((>= element (car tree))
         (%insert! (third tree) element (cons 'third acc)))
        (t
         (%insert! (second tree) element (cons 'second acc)))))

(defun butlast-last (l &optional (acc '()))
  (cond ((or (null l) (null (cdr l))) (values (nreverse acc) (car l)))
        (t (butlast-last (cdr l) (cons (car l) acc)))))

(defun %insert!-to-setf (%insert!-expression tree)
  (multiple-value-bind (seq expr) (butlast-last %insert!-expression)
    (append (cons 'setf (list (reduce (lambda (res e) (cons e (list res))) seq :initial-value tree)))
            (list (cons 'quote (list expr))))))

(defmacro insert! (tree element)
  (eval `(%insert!-to-setf (%insert! ,tree ,element) ',tree)))

The usage of eval in the macro already signals something is very bad in this code. See the last section of this answer to see how a better insert! and insert*! can be written!

Destructive insert! and insert*! as pure functions

Finally, I figured out how to do destructive insert! and insert*! as pure functions.

(defun insert! (tree element)
  (let ((e (list element nil nil)))
    (cond ((null tree)
           (setf tree e))
          (t
           (labels ((%insert! (itree)
                      (cond ((>= element (first itree))
                             (if (null (third itree))
                                 (setf (third itree) e)
                                 (%insert! (third itree))))
                            (t
                             (if (null (second itree))
                                 (setf (second itree) e)
                                 (%insert! (second itree)))))))
             (%insert! tree))))
    tree))

(defun insert*! (tree &rest elements)
  (loop for e in elements
        do (setf tree (insert! tree e))
        finally (return tree)))



(defparameter *t* '())
(setf *t* (insert! *t* 3))
(setf *t* (insert! *t* 8))
(setf *t* (insert! *t* 7))
(setf *t* (insert! *t* 5))

(insert*! '() 3 8 7 5)

And finally make out of them imperative macros

Imperative in that way that they are mutating the tree argument. And you don't need to assign the results to a new value. I think these macros are what you actually wanted to program! BUT destructive insert! and insert*! as pure functions is more lispier than the macros which are following now.

(defun %insert! (tree element)
  (let ((e (list element nil nil)))
    (cond ((null tree)
           (setf tree e))
          (t
           (labels ((%%insert! (itree)
                      (cond ((>= element (first itree))
                             (if (null (third itree))
                                 (setf (third itree) e)
                                 (%%insert! (third itree))))
                            (t
                             (if (null (second itree))
                                 (setf (second itree) e)
                                 (%%insert! (second itree)))))))
             (%%insert! tree))))
    tree))

(defun %insert*! (tree &rest elements)
  (loop for e in elements
        do (setf tree (%insert! tree e))
        finally (return tree)))

(defmacro insert! (tree element)
  `(setf ,tree (%insert! ,tree ,element)))

(defmacro insert*! (tree &rest elements)
  `(setf ,tree (%insert*! ,tree ,@elements)))



(defparameter *t* '())
(insert! *t* 3)
(insert! *t* 8)
(insert! *t* 7)
(insert! *t* 5)

(defparameter *t* '())
(insert*! *t* 3 8 7 5)

Upvotes: 2

Related Questions