(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)
(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)
Related
I'm writing a macro to generate codes used by another macro in Common Lisp. But I'm new at this and have difficulty in constructing a macro that takes in a list (bar1 bar2 ... barn) and produces the following codes by a loop.
`(foo
,#bar1
,#bar2
...
,#barn)
I wonder whether this can be achieved not involving implement-dependent words such as SB-IMPL::UNQUOTE-SPLICE in sbcl.
Maybe I didn't give a clear description about my problem. In fact I want to write a macro gen-case such that
(gen-case
(simple-array simple-vector)
('(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0))
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
objname body)
produces something like
`(case (car (type-of ,objname))
(simple-array
,#(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector
,#(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))
In general cases, the lists taken in by gen-case may contain more than two items.
I have tried
``(case (car (type-of ,,objname))
,',#(#|Some codes that produce target codes|#))
but the target codes are inserted to the quote block and thus throw an exception in the macro who calls the macro gen-case. Moreover, I have no way to insert ,# to the target codes as a straightforward insertion will cause a "comma not inside a backquote" exception.
The codes generated are part of another macro
(defmacro DSI-Layer ((obj-name tag-name) &body body)
"Data Structure Independent Layer."
(let ((temp))
(defun code-gen (c)
(if (atom c) c
(if (eq (car c) tag-name)
(let ((args (cadr c)) (codes (code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code temp))
(cons (code-gen (car c)) (code-gen (cdr c))))))
`(case (car (type-of ,obj-name))
(simple-array
,#(progn
(setf temp
'(dotimes ($1 $5)
(when (and (= (aref $4 $2 $1) 1) (zerop (aref $3 $1)))
$0)))
(code-gen body)))
(simple-vector
,#(progn
(setf temp
'(dolist ($1 (aref $4 $2))
(when (zerop (aref $3 $1))
$0)))
(code-gen body))))))
and I've set up a read-macro
(defvar *arg* (make-symbol "ARG"))
(set-macro-character #\$
#'(lambda (stream char)
(declare (ignore char))
(list *arg* (read stream t nil t))))
The intention of DSI-Layer is to add a piece of code to determine the type of input parameters. For example, the codes
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(DSI-Layer (G next-vertex)
(do nil ((null queue) nil)
(setf v (pop queue)) (push v vl)
(next-vertex (i v visited G n)
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))
vl))
will be converted to
(defun BFS (G v)
(let* ((n (car (array-dimensions G)))
(visited (make-array n :initial-element 0))
(queue (list v))
(vl nil))
(incf (aref visited v))
(case (car (type-of G))
(simple-array
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dotimes (i n)
(when (and (= (aref G v i) 1) (zerop (aref visited i)))
(setf queue (nconc queue (list i)))
(incf (aref visited i))))))
(simple-vector
(do nil ((null queue) nil)
(setf v (pop queue))
(push v vl)
(dolist (i (aref G v))
(when (zerop (aref visited i))
(setf queue (nconc queue (list i)))
(incf (aref visited i)))))))))
Now I just wonder that whether the DSI-Layer can be generated from another macro gen-case by passing the type names and corresponding code templates to it or not.
By the way, I don't think the specific meaning of generated codes matters in my problem. They are just treated as data.
Don't be tempted to use internal details of backquote. If you have the lists you want to append in distinct variables, simply append them:
`(foo
,#(append b1 b2 ... bn))
If you have a list of them in some single variable (for instance if they've come from an &rest or &body argument) then do something like
`(foo
,#(loop for b in bs
appending b))
I see your problem - you need it not for a function call
but for a macro-call with case.
One cannot use dynamically macros - in a safe way.
One has to use eval but it is not safe for scoping.
#tfb as well as me answered in this question for type-case
lengthily.
previous answer (wrong for this case)
No need for a macro.
`(foo
,#bar1
,#bar2
...
,#barn)
with evaluation of its result
by pure functions would be:
(apply foo (loop for bar in '(bar1 bar2 ... barn)
nconc bar))
nconc or nconcing instead of collect fuses lists together and is very useful in loop. - Ah I see my previous answerer used append btw appending - nconc nconcing however is the "destructive" form of "append". Since the local variable bar is destructed here which we don't need outside of the loop form, using the "destructive" form is safe here - and comes with a performance advantage (less elements are copied than when using append). That is why I wired my brain always to use nconc instead of append inside a loop.
Of course, if you want to get the code construct, one could do
`(foo ,#(loop for bar in list-of-lists
nconc bar))
Try it out:
`(foo ,#(loop for bar in '((1 2 3) (a b c) (:a :b :c)) nconc bar))
;; => (FOO 1 2 3 A B C :A :B :C)
The answers of all of you inspired me, and I came up with a solution to my problem. The macro
(defmacro Layer-Generator (obj-name tag-name callback body)
(let ((temp (gensym)) (code-gen (gensym)))
`(let ((,temp))
(defun ,code-gen (c)
(if (atom c) c
(if (eq (car c) ,tag-name)
(let ((args (cadr c)) (codes (,code-gen (cddr c))) (flag nil))
(defun gen-code (c)
(if (atom c) c
(if (eq (car c) *arg*)
(let ((n (cadr c)))
(if (zerop n) (progn (setf flag t) codes)
(nth (1- n) args)))
(let ((h (gen-code (car c))))
(if flag
(progn
(setf flag nil)
(append h (gen-code (cdr c))))
(cons h (gen-code (cdr c))))))))
(gen-code ,temp))
(cons (,code-gen (car c)) (,code-gen (cdr c))))))
(list 'case `(car (type-of ,,obj-name))
,#(let ((codes nil))
(dolist (item callback)
(push
`(cons ',(car item)
(progn
(setf ,temp ,(cadr item))
(,code-gen ,body)))
codes))
(nreverse codes))))))
produces codes which are not the same as DSI-Layer but produce codes coincident with what the latter produces. Because the codes
`(case (car (type-of ,obj-name))
(tag1
,#(#|codes1|#))
(tag2
,#(#|codes2|#))
...)
are equivalent to
(list 'case `(car (type-of ,obj-name))
(cons 'tag1 (#|codes1|#))
(cons 'tag2 (#|codes2|#))
...)
And now we can use a loop to generate it just as what the Layer-Generator does.
I have problem with macros in my lisp interpreter writtein in JavaScript. the problem is in this code:
(define log (. console "log"))
(define (alist->object alist)
"(alist->object alist)
Function convert alist pairs to JavaScript object."
(if (pair? alist)
((. alist "toObject"))))
(define (klist->alist klist)
"(klist->alist klist)
Function convert klist in form (:foo 10 :bar 20) into alist
in form ((foo . 10) (bar . 20))."
(let iter ((klist klist) (result '()))
(if (null? klist)
result
(if (and (pair? klist) (pair? (cdr klist)) (key? (car klist)))
(begin
(log ":::" (cadr klist))
(log "data" (. (cadr klist) "data"))
(iter (cddr klist) (cons (cons (key->string (car klist)) (cadr klist)) result)))))))
(define (make-empty-object)
(alist->object '()))
(define empty-object (make-empty-object))
(define klist->object (pipe klist->alist alist->object))
;; main function that give problems
(define (make-tags expr)
(log "make-tags" expr)
`(h ,(key->string (car expr))
,(klist->object (cadr expr))
,(if (not (null? (cddr expr)))
(if (and (pair? (caddr expr)) (let ((s (caaddr expr))) (and (symbol? s) (eq? s 'list))))
`(list->array (list ,#(map make-tags (cdaddr expr))))
(caddr expr)))))
(define-macro (with-tags expr)
(make-tags expr))
I call this macro using this code:
(define (view state actions)
(with-tags (:div ()
(list (:h1 () (value (cdr (assoc 'count (. state "counter")))))
(:button (:onclick (lambda () (--> actions (down 1)))) "-")
(:button (:onclick (lambda () (--> actions (up 1)))) "+")))))
which should expand to almost the same code:
(define (view state actions)
(h "div" (make-empty-object)
(list->array (list
(h "h1" (make-empty-object) (value (cdr (assoc 'count (. state "counter")))))
(h "button" (klist->object `(:onclick ,(lambda () (--> actions (down 1))))) "-")
(h "button" (klist->object `(:onclick ,(lambda () (--> actions (up 1))))) "+")))))
This function works. I have problem with expanded code using my macro that call the main function, don't know how LIPS should behave when it find:
(:onclick (lambda () (--> actions (down 1))))
inside code and you try to process it like this:
,(klist->object (cadr expr))
Right now my lisp works that lambda is marked as data (have data flag set to true this is a hack to prevent of recursive evaluation of some code from macros) and klist->object function get lambda code as list, instead of function.
How this should work in Scheme or Common Lisp? Should klist->object get function object (lambda get evaluated) or list structure with lambda as first symbol? If second then how I sould write my function and macro to evaluate lambda should I use eval (kind of hack to me).
Sorry don't know how to test this, with more bug free LISP.
EDIT:
I've tried to apply the hint from #jkiiski in guile (because in my lisp it was not working)
;; -*- sheme -*-
(define nil '())
(define (key? symbol)
"(key? symbol)
Function check if symbol is key symbol, have colon as first character."
(and (symbol? symbol) (eq? ":" (substring (symbol->string symbol) 0 1))))
(define (key->string symbol)
"(key->string symbol)
If symbol is key it convert that to string - remove colon."
(if (key? symbol)
(substring (symbol->string symbol) 1)))
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
(define (klist->alist klist)
"(klist->alist klist)
Function convert klist in form (:foo 10 :bar 20) into alist
in form ((foo . 10) (bar . 20))."
(pair-map (lambda (first second)
(if (key? first)
(cons (key->string first) second))) klist))
(define (h props . rest)
(display props)
(display rest)
(cons (cons 'props props) (cons (cons 'rest rest) nil)))
(define (make-tags expr)
`(h ,(key->string (car expr))
(klist->alist (list ,#(cadr expr)))
,(if (not (null? (cddr expr)))
(if (and (pair? (caddr expr)) (let ((s (caaddr expr))) (and (symbol? s) (eq? s 'list))))
`(list->array (list ,#(map make-tags (cdaddr expr))))
(caddr expr)))))
(define-macro (with-tags expr)
(make-tags expr))
(define state '((count . 10)))
(define xxx (with-tags (:div ()
(list (:h1 () (cdr (assoc 'count state)))
(:button (:onclick (lambda () (display "down"))) "-")
(:button (:onclick (lambda () (display "up"))) "+")))))
but got error:
ERROR: Unbound variable: :onclick
I've found solution for my lisp, Here is code:
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
(define (make-tags expr)
(log "make-tags" expr)
`(h ,(key->string (car expr))
(alist->object (quasiquote
;; create alist with unquote for values and keys as strings
,#(pair-map (lambda (car cdr)
(cons (cons (key->string car) (list 'unquote cdr))))
(cadr expr))))
,(if (not (null? (cddr expr)))
(if (and (pair? (caddr expr)) (let ((s (caaddr expr))) (and (symbol? s) (eq? s 'list))))
`(list->array (list ,#(map make-tags (cdaddr expr))))
(caddr expr)))))
So in my code I'm writing some kind of meta macro I'm writing quasiquote as list that will get evaluated the same as if I use in my original code:
(klist->object `(:onclick ,(lambda () (--> actions (down 1)))))
I'm using alist->object and new function pair-map, so I can unquote the value and convert key symbol to string.
is this how it should be implemented in scheme? not sure If I need to fix my lisp or macros are working correctly there.
I am new to LISP apparently... I am writing a function that takes a list and returns that list with all the duplicates removed, so (myPurge '(p a c e p c))->(a e p c)
This is my (edited)code:
(defun myPurge (L)
(if (eq L nil) ;if empty return nil
nil
(if(eq (car L)(car(cdr L)) ) ;if I find a match call function on
;rest of list
(myPurge (cdr L))
;else return that term and than call on
(progn ;rest of list
(car L)
(myPurge(cdr L)) ))))
*BUTTTTTTTT, when I call this function I get NIL!
*:
Why am i getting NIL instead of it returning car L ?
******Thank you all, this is my finished code that I ended up using( it uses another function 'myMember' I defined earlier.******
(defun myPurge (L)
(if (eq L nil)
nil
(if(myMember(car L)(cdr L))
(myPurge(cdr L))
(cons (car L)(myPurge(cdr L))))))))
****here is myMember*****it returns true if X is a member of L
(defun myMember (X L)
(if(eq L nil)
nil
(if(eq X(car L))
t
(myMember X(cdr L)) )) )
After reformatting your code looks like this:
(defun myPurge (L)
(if (eq L nil)
nil
(if (eq (car L) (car (cdr L)))
(myPurge (cdr L))
(car L)
(myPurge (cdr L)))))
As you can see, the last if is called with 4 arguments. But if only takes 3 arguments (condition, then-part, else-part).
Your code:
(defun myPurge (L)
(if (eq L nil) ;if empty return nil
nil
(if(eq (car L)(car(cdr L)) ) ;if I find a match call function on rest
;of list
(myPurge (cdr L))
;else return that term and than call on
(progn ;rest of list
(car L)
(myPurge(cdr L)) ))))
Correctly indented/formatted/named:
(defun my-purge (list)
(if (null list)
nil
(if (eql (first list) (second list))
(myPurge (rest list))
(progn
(first list)
(my-purge (rest list))))))
What looks strange? See the comment below.
(defun my-purge (list)
(if (null list)
nil
(if (eql (first list) (second list))
(myPurge (rest list))
(progn
(first list) ; <- what does this do?
(my-purge (rest list))))))
Bonus: you can get rid of the nested IFs:
(defun my-purge (list)
(cond ((null list)
nil)
((eql (first list) (second list))
(myPurge (rest list)))
(t
(first list)
(my-purge (rest list)))))
I'm working on a problem in a book where I have a binary tree and I need to check if the sum of all the atoms on the left and right subtree are equal and if they're not, return nil. I managed to do it in two functions but when I try to do it in one I get an error because it tries to add a number to nil.
The code is
(defun foo (list)
(cond ((null list) 0)
((atom list) list)
((/= (foo (cadr list))
(foo (caddr list))) nil)
( T (+ (foo (car list))
(foo (cdr list))))))
edit: the problem was two fold.
1) with the previous structure it would try to evaluate (cdr '(number)) so it would return null when it hit a list that looked like '(a (b c) d) since it would try to access (cdr '(d))
2) i used /= which only works if both arguments are numbers
The code that worked:
(defun foo (list)
(cond ((null list) 0)
((atom list) list)
((null (cdr list)) (car list))
((null (equal(foo (cadr list)) (foo (caddr list)))) nil)
(T (+ (car list)
(foo (cadr list))
(foo (caddr list))))))
After having defined how you represent a binary tree, I mean the right subtree could be the cdr or the cadr, I would separate the two problems:
(defun sum-of-subtree (tree)
(cond ((null tree) 0)
((atom tree) tree)
(t (+ (sum-of-subtree (car tree))
(sum-of-subtree (cdr tree))))))
(defun foo (tree)
(cond ((null tree) t) ;or whatever you want
((atom tree) t)
((= (sum-of-subtree (car tree))
(sum-of-subtree (cdr tree))) t)
(t nil)))
Like that, you will not be confusing the value of the sum of the subtree with the comparison. Other languages have stronger typing, which avoids mixing the purposes of different functions
Note: I'm assuming your binary trees are lists of (val left-sub right-sub), which seems to match your code.
I'm not sure that there's a clean way to do that with recursion and a single function, since the recursive process (summing the left and right subtrees) is different from the value your function needs to return (whether or not the left and right subtrees are equal).
However, if you absolutely have to solve it with one function, you could cheat a little. I see two options:
Option 1
Local function
(defun foo (list)
(labels ((sum-subtrees (list)
(cond
((null list) 0)
((atom list) list)
(t (+ (car list)
(sum-subtrees (cadr list))
(sum-subtrees (caddr list)))))))
(= (sum-subtrees (cadr list))
(sum-subtrees (caddr list)))))
This works by defining a local function to handle the recursive bit- #'sum-subtrees- and then just relies on that to compute the final output.
Option 2
Multiple value return
(defun foo (list)
(cond
((null list) (values t 0))
((atom list) (values t list))
(t (let ((left-sub (nth-value 1 (foo (cadr list))))
(right-sub (nth-value 1 (foo (caddr list)))))
(values (= left-sub right-sub)
(+ (car list)
left-sub
right-sub))))))
This solution exploits how common lisp functions can return multiple values. Basically, the function returns both the original condition (= left-subtree right-subtree) and the sum of the tree. Any other code which is expecting just a single value will get the first return value (the condition), so any code that would use this function should not notice the extra return value, but the data is there if you ask for it.
The way we return multiple values is with the values function. In this code, for example, we return (values t 0) in the case of list being nil to indicate that its "left and right subtrees" are equal and its sum is 0, and
(values (= left-sub right-sub)
(+ (car list)
left-sub
right-sub))
to produce the recursive return value.
There are a few ways to get access to the extra return values, but the one used here is #'nth-value, which returns the nth value returned instead of the first. That's why, when we make the recursive call to compute the size of the subtree, we use (nth-value 1 (foo <subtree>)).
NOTE: Please never actually use that solution for this- multiple value return is very useful and powerful, but in this case it is more confusing than it's really worth.
The code that worked:
(defun foo (list)
(cond ((null list) 0)
((atom list) list)
((null (cdr list)) (car list))
((null (equal(foo (cadr list)) (foo (caddr list)))) nil)
(T (+ (car list)
(foo (cadr list))
(foo (caddr list))))))
I ran over an example of a problem which should determine the list of all non-numeric atoms at any level in a non-linear list.
(Defun Lis(L)
(Cond
((Null L) Nil)
((Not (Numberp (Car L))) (Cons (Car L) (Lis (Cdr L))))
((Atom (Car L)) (Lis (Cdr L)))
(T (Append (Lis (Car L)) (Lis (Cdr L))))
))
I took an example, (Lis '(1 A ((B) 6) (2 (C 3)) D 4)) which should return (A B C D)
Now I don't understand how can the list be created when the 3rd element of the list is evaluated ((B) 6).It will enter on the 2nd branch and do the cons?But that isn't constructing the new list with ((B) 6)?When will it enter on the last branch? I'm a little confused of how this algorithm works,can somebody make it clear for me?
The code works fine if you "invert" the 2 middle tests:
(defun lis(L)
(cond
((null L) nil)
((numberp (car L)) (lis (cdr L)))
((atom (car L)) (cons (car L) (lis (cdr L))))
(t (append (lis (car L)) (lis (cdr L))))))
because (not (numberp (car L))) is also true for lists so in the initial version the code never recurses down into a sublist.
I would write it as:
(defun tree-keep-if (predicate tree)
"Returns the list of all non-numeric atoms at any level in a cons tree."
(mapcan (lambda (item)
(cond ((consp item) (tree-keep-if predicate item))
((funcall predicate item) (list item))
((atom item) nil)))
tree))
Using it:
CL-USER > (tree-keep-if (complement #'numberp) '(1 A ((B) 6) (2 (C 3)) D 4))
(A B C D)
A more sophisticated version might remove the recursion to not be limited by stack size.