I'm trying to build a binary tree is lisp. The function should do this
(buildBST ‘(6 9 2 1 7)) -> (6 (2 (1) ()) (9 (7) ()))
The code we have so far will keep returning the error
> 7 nil arguments should be of type real
Here's our code
(defun buildBst (lis)
(cond
((null lis) 0)
((atom lis) lis)
(t (if ( >(car lis)(car(cdr lis)))
(buildBst( cdr lis))
(buildBst(cdr lis))))))
The best approach would be to make an insert function:
(defun tree-insert-element (tree element)
(cond ((tree-null-p tree)
(make-tree element nil nil))
((< (tree-value tree) element)
(make-tree (tree-value tree)
(tree-left tree)
(tree-insert-element (tree-right tree) element)))
(t
(make-tree (tree-value tree)
(tree-insert-element (tree-left tree) element)
(tree-right tree)))))
Thus when you want to insert a whole bunch you can do this:
(defun tree-insert-list (tree list)
(reduce #'tree-insert-element list :initial-value tree))
Of course, you'll need to define the functions the insert function uses as I really don't care how you choose to model a tree. From the look of the expected result I guess make-tree might just wrap list*, but thats not the only way to make a tree!
Related
(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)
i have the following code:
(defun TREE-CONTAINS (N TREE)
(cond (( = (car TREE) nil) nil)
(( = (car TREE) N) t)
(t TREE-CONTAINS (N (cdr TREE)))
)
)
which accepts a number N and a list TREE and checks to see if N exists in the list TREE. pretty simple, but for some reason i keep getting this error when i call my function
(TREE-CONTAINS 3 '((1 2 3) 7 8))
*** - +: (1 2 3) is not a number
is there an issue with the code? i'm very new to Lisp so maybe i'm just not seeing something very obvious.. thanks in advance!
Syntax errors
Your code contains several syntax errors that are flagged as compiler warnings:
CL-USER> (defun TREE-CONTAINS (N TREE)
(cond (( = (car TREE) nil) nil)
(( = (car TREE) N) t)
(t TREE-CONTAINS (N (cdr TREE)))
)
)
;Compiler warnings :
; In TREE-CONTAINS: Undeclared free variable TREE-CONTAINS
; In TREE-CONTAINS: Undefined function N
TREE-CONTAINS
The reason is that parentheses in Common Lisp have a meaning different from that of other programming languages: they are not used to specify the order of application of the operators (like in 3 * (2 + 4) which is different from 3 * 2 + 4), but are integral part of the syntax to specify the different parts of a “statement”, like in cond or in function application (like (function-name arg1 arg2 ... argn)). So the syntax error in this case is in the last line, in which you should call the function TREE-CONTAINS with arguments N and (cdr TREE) as:
CL-USER> (defun TREE-CONTAINS (N TREE)
(cond (( = (car TREE) nil) nil)
(( = (car TREE) N) t)
(t (TREE-CONTAINS N (cdr TREE)))
)
)
TREE-CONTAINS
Semantic errors
If you try this function, however, you will find an error:
CL-USER> (TREE-CONTAINS 2 '(1 2 3))
The value NIL is not of the expected type NUMBER.
The reason is that you have used = to compare a number ((car TREE)) with the value nil, while = can be used only to compare numbers. Use eq or eql instead for the general case:
CL-USER> (defun TREE-CONTAINS (N TREE)
(cond (( eql (car TREE) nil) nil)
(( = (car TREE) N) t)
(t (TREE-CONTAINS N (cdr TREE)))
)
)
TREE-CONTAINS
CL-USER> (TREE-CONTAINS 2 '(1 2 3))
T
There is also another problem: you should check if the list is empty, not if the first element is nil. In other words, the first condition should be:
(cond ((eq TREE nil) nil)
or better:
(cond ((null TREE) nil)
Stylistic notes
A list is a particular case of tree: if you use the term tree the program should be more complex, taking into account cases in which the elements can be sublists.
Use lowercase identifier, since everything is translated to upper-case
Put the close parentheses at the end of the expression, not on a new line.
So your function could be something like:
(defun list-contains (n list)
(cond ((null list) nil)
((= (car list) n) t)
(t (list-contains n (cdr list)))))
Check membership for a tree and not a list
If, on the other hand, you want to check for a generic tree, i.e. a list which can contain sublists, like in (tree-contains 3 '((1 2 3) 7 8)), in your recursion you should consider tha case in which an element of the list is itself a list, and then perform a double recursion. Here is a possible solution:
CL-USER> (list-contains 2 '(1 (2 3) 4))
The value (2 3) is not of the expected type NUMBER.
CL-USER> (defun tree-contains (n tree)
(cond ((null tree) nil)
((listp (car tree)) (or (tree-contains n (car tree))
(tree-contains n (cdr tree))))
((= (car tree) n) t)
(t (tree-contains n (cdr tree)))))
TREE-CONTAINS
CL-USER> (tree-contains 2 '(1 (2 3) 4))
T
In addition to the accepted answer, here is an alternative way of writing the same predicate, without cond:
(defun list-contains-p (number list)
(and (consp list)
(or (= number (first list))
(list-contains-p number (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))))))
This question already has answers here:
How to recursively reverse a list using only basic operations?
(3 answers)
Closed 8 years ago.
I am having trouble with some lisp code. This function is just supposed to reverse a basic list.
I can only use primitives, which are defined as
" defun, cond, cons, car, cdr, null, eq, listp, atom, symbolp, +, -‐ , <, >"
In the example of passing (1 2 3 4) I get back (((4 3) 2) 1)
(defun reverse2 (l)
(cond
((eq nil (cdr l)) (car l) )
(t (cons(reverse2 (cdr l)) (cons (car l) nil)))))
Please let me know how to improve this. This is NOT for homework, I'm just working on this as an exercise for my final tomorrow.
To implement a reverse function, you need to use an accumulator. Here is how you might implement this (in this case, tail is the accumulator):
(defun revappend (list tail)
(cond ((null list) tail)
(t (revappend (cdr list) (cons (car list) tail)))))
Then, implement reverse in terms of revappend:
(defun reverse (list)
(revappend list nil))
If you would want to use simple recursion, then you would have to append the first item to the end of the list. Note that this is not a good implementation of a list reverse operation. Why?
(defun reverse2 (l)
(cond ((endp l) l)
(t (append (reverse2 (rest l))
(list (first l))))))
REVERSE
CL-USER> (reverse2 '(a b c d))
(D C B A)
Instead of using an auxillary function you can use an optional argument:
(defun reverse (list &optional tail)
(cond ((null list) tail)
(t (reverse (cdr list)
(cons (car list) tail)))))
How can I remove nested parentheses recursively in Common LISP Such as
(unnest '(a b c (d e) ((f) g))) => (a b c d e f g)
(unnest '(a b)) => (a b)
(unnest '(() ((((a)))) ())) => (a)
Thanks
Here's what I'd do:
(ql:quickload "alexandria")
(alexandria:flatten list)
That works mainly because I have Quicklisp installed already.
(defun flatten (l)
(cond ((null l) nil)
((atom l) (list l))
(t (loop for a in l appending (flatten a)))))
I realize this is an old thread, but it is one of the first that comes up when I google lisp flatten. The solution I discovered is similar to those discussed above, but the formatting is slightly different. I will explain it as if you are new to lisp, as I was when I first googled this question, so it's likely that others will be too.
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
For those new to lisp, this is a brief summary.
The following line declares a function called flatten with argument L.
(defun flatten (L)
The line below checks for an empty list.
(if (null L)
The next line returns nil because cons ATOM nil declares a list with one entry (ATOM). This is the base case of the recursion and lets the function know when to stop. The line after this checks to see if the first item in the list is an atom instead of another list.
(if (atom (first L))
Then, if it is, it uses recursion to create a flattened list of this atom combined with the rest of the flattened list that the function will generate. cons combines an atom with another list.
(cons (first L) (flatten (rest L)))
If it's not an atom, then we have to flatten on it, because it is another list that may have further lists inside of it.
(append (flatten (first L)) (flatten (rest L))))))
The append function will append the first list to the start of the second list.
Also note that every time you use a function in lisp, you have to surround it with parenthesis. This confused me at first.
You could define it like this for example:
(defun unnest (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
(defun flatten (l)
(cond ((null l) nil)
((atom (car l)) (cons (car l) (flatten (cdr l))))
(t (append (flatten (car l)) (flatten (cdr l))))))
Lisp has the function remove to remove things. Here I use a version REMOVE-IF that removes every item for which a predicate is true. I test if the thing is a parenthesis and remove it if true.
If you want to remove parentheses, see this function:
(defun unnest (thing)
(read-from-string
(concatenate
'string
"("
(remove-if (lambda (c)
(member c '(#\( #\))))
(princ-to-string thing))
")")))
Note, though, as Svante mentions, one does not usually 'remove' parentheses.
Most of the answers have already mentioned a recursive solution to the Flatten problem. Using Common Lisp Object System's multiple dispatching you could solve the problem recursively by defining 3 methods for 3 possible scenarios:
(defmethod flatten ((tree null))
"Tree is empty list."
())
(defmethod flatten ((tree list))
"Tree is a list."
(append (flatten (car tree))
(flatten (cdr tree))))
(defmethod flatten (tree)
"Tree is something else (atom?)."
(list tree))
(flatten '(2 ((8) 2 (9 (d (s (((((a))))))))))) ; => (2 8 2 9 D S A)
Just leaving this here as I visited this question with the need of only flattening one level and later figure out for myself that (apply 'concatenate 'list ((1 2) (3 4) (5 6 7))) is a cleaner solution in that case.
This is a accumulator based approach. The local function %flatten keeps an accumulator of the tail (the right part of the list that's already been flattened). When the part remaining to be flattened (the left part of the list) is empty, it returns the tail. When the part to be flattened is a non-list, it returns that part prefixed onto the tail. When the part to be flattened is a list, it flattens the rest of the list (with the current tail), then uses that result as the tail for flattening the first part of the list.
(defun flatten (list)
(labels ((%flatten (list tail)
(cond
((null list) tail)
((atom list) (list* list tail))
(t (%flatten (first list)
(%flatten (rest list)
tail))))))
(%flatten list '())))
CL-USER> (flatten '((1 2) (3 4) ((5) 6) 7))
(1 2 3 4 5 6 7)
I know this question is really old but I noticed that nobody used the push/nreverse idiom, so I am uploading that here.
the function reverse-atomize takes out each "atom" and puts it into the output of the next call. At the end it produces a flattened list that is backwards, which is resolved with the nreverse function in the atomize function.
(defun reverse-atomize (tree output)
"Auxillary function for atomize"
(if (null tree)
output
(if (atom (car tree))
(reverse-atomize (cdr tree) (push (car tree) output))
(reverse-atomize (cdr tree) (nconc (reverse-atomize (car tree)
nil)
output)))))
(defun atomize (tree)
"Flattens a list into only the atoms in it"
(nreverse (reverse-atomize tree nil)))
So calling atomize '((a b) (c) d) looks like this:
(A B C D)
And if you were to call reverse-atomize with reverse-atomize '((a b) (c) d) this would occur:
(D C B A)
People like using functions like push, nreverse, and nconc because they use less RAM than their respective cons, reverse, and append functions. That being said the double recursive nature of reverse-atomize does come with it's own RAMifications.
This popular question only has recursive solutions (not counting Rainer's answer).
Let's have a loop version:
(defun flatten (tree &aux todo flat)
(check-type tree list)
(loop
(shiftf todo tree nil)
(unless todo (return flat))
(dolist (elt todo)
(if (listp elt)
(dolist (e elt)
(push e tree))
(push elt flat))))))
(defun unnest (somewhat)
(cond
((null somewhat) nil)
((atom somewhat) (list somewhat))
(t
(append (unnest (car somewhat)) (unnest (cdr somewhat))))))
I couldn't resist adding my two cents. While the CL spec does not require tail call optimization (TCO), many (most?) implementations have that feature.
So here's a tail recursive version that collects the leaf nodes of a tree into a flat list (which is one version of "removing parentheses"):
(defun flatten (tree &key (include-nil t))
(check-type tree list)
(labels ((%flatten (lst accum)
(if (null lst)
(nreverse accum)
(let ((elem (first lst)))
(if (atom elem)
(%flatten (cdr lst) (if (or elem include-nil)
(cons elem accum)
accum))
(%flatten (append elem (cdr lst)) accum))))))
(%flatten tree nil)))
It preserves null leaf nodes by default, with the option to remove them. It also preserves the left-to-right order of the tree's leaf nodes.
Note from Google lisp style guide about TCO:
You should favor iteration over recursion.
...most serious implementations (including SBCL and CCL) do implement proper tail calls, but with restrictions:
The (DECLARE (OPTIMIZE ...)) settings must favor SPEED enough and not favor DEBUG too much, for some compiler-dependent meanings of "enough" and "too much".
And this from SBCL docs:
... disabling tail-recursion optimization ... happens when the debug optimization quality is greater than 2.