Reputation: 1
(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
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)
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!
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!
insert!
and insert*!
as pure functionsFinally, 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)
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