To complete an exercise, I need to check if an element is in a list or not. I know that there is the function member in lisp, but our instructor is very strict and doesn't let us use things that haven't yet been covered in the course.
What would be a way to check if an atom is in a list by using only cond, nil, car, not, cdr, +, equal, defun?
Edit:
After Doseke's comment; here is an attempt:
(defun presence (list item)
(cond
((atom list) nil)
((equal (car list) item) t)
((consp list) (presence (cdr list) item))
(t nil)
)
)
edit: I changed the title to make it match with my actual question
Since you are limited in used features, it could be something like this, i guess:
(defun member-2 (x xs)
(cond ((not xs) nil)
((equal x (car xs)) xs)
(t (member-2 x (cdr xs)))))
Related
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 am supposed to find the path from the root to a given node in LISP. Preferably using a purely functional approach.
The binary tree representation uses sublists, e.g.:
(A (B) (C (D) (E))) - A is the root, B the left child of A, C the right child of A, D the left child of C and E the right child of C.
It seems to me that there should be some way to avoid the duplication of the following function calls:
(get-path (cadr l) x)
(get-path (caddr l) x)
I am new to LISP and I don't know and can't seem to find a solution for this, but I think there must be a -purely- functional way to do it. Maybe using lambdas? Not sure how, though. Am I using a wrong approach? Any kind of help is highly appreciated.
;;; l is the list with the binary tree
;;; x is the node we are looking for
(defun get-path(l x)
(cond
;; nothing to search for anymore
((null l) nil)
;; found the node we were looking for
;; in this case we return a list containing only x
((equal (car l) x) (list x))
;; the node was found on the left branch
((not(equal (get-path (cadr l) x) nil))
(cons (car l) (get-path (cadr l) x)))
;; the node was found on the right branch
((not(equal (get-path (caddr l) x) nil))
(cons (car l) (get-path (caddr l) x)))))
What about this?
(defun root-path (tree element)
(when tree
(cons (first tree)
(unless (eql (first tree) element)
(or (root-path (second tree) element)
(root-path (third tree) element)
(return-from root-path nil))))))
You should even define meaningfully named functions, like tree-value left-subtree and right-subtree, but this is maybe overkill here.
In the above, note that when (resp. unless) is used for its nil value when the condition fails (resp. succeed). You can translate with cond or if expressions if you prefer. The only repetition here is the double (first tree) value, which might be optimized away by the compiler or manually with a surrounding let binding.
Edit
The original code was not working. The solution is to use Joshua's answer, but I won't copy paste it here, so I added the return-from expression. While it works, your teacher and/or coworker will probably not like this approach ;-)
Tests
(mapcar (lambda (n) (root-path '(A (B) (C (D) (E))) n))
'(a b c d e f))
=> ((a) (a b) (a c) (a c d) (a c e) nil)
I'd combine the final two cond clauses. You want to check the left side and see if there's a path there, and if there is, take it, and if there's not, check the right side. Then, whichever one of those yielded a path (if either did), you want to append to that. That could look like this. First, a couple of functions for convenience:
(defun element (tree)
(first tree))
(defun left (tree)
(second tree))
(defun right (tree)
(third tree))
Now, the real meat of the solution:
(defun get-path (element tree)
(cond
;; A null tree is empty and doesn't match anything.
((null tree) '())
;; If the element of this tree is the element, then we have a
;; partial path of length 1: (ELEMENT).
((eql element (element tree)) (list element))
;; Othweise, let PATH be the path on the left or the path on the
;; right, whichever exists.
(t (let ((path (or (get-path element (left tree))
(get-path element (right tree)))))
;; If there's no path on either side, then return NIL.
;; Otherwise, prepend the current element onto the path that
;; exists.
(if (null path) '()
(list* (element tree) path))))))
Note that list* does the same thing as cons, but it makes it clearer that you're working with lists, not just cons cells. You could use cons just as well.
We can confirm that this works as expected:
(defparameter *tree* '(A (B) (C (D) (E))))
(get-path 'c *tree*) ;;=> (A C)
(get-path 'd *tree*) ;;=> (A C D)
(get-path 'f *tree*) ;;=> NIL
Use labels for interior (local) functions:
(defun get-path(l x)
(labels ((prepend-path (elt)
(cons (car l) (get-path elt x))))
(cond
;; nothing to search for anymore
((null l) nil)
;; found the node we were looking for
;; in this case we return a list containing only x
((equal (car l) x) (list x))
;; the node was found on the left branch
((not(equal (get-path (cadr l) x) nil))
(prepend-path (cadr l)))
;; the node was found on the right branch
((not(equal (get-path (caddr l) x) nil))
(prepend-path (caddr l))))))
Alternatively, you could use flet instead of labels because you don't have interior functions that refer to each other. Personally, I use labels and hardly ever use flet for that reason (plus the overhead of re-indenting the function.)
What you can do is replicate the anaphoric conda and ifa macros from TXR Lisp in Common Lisp. (Source code here; good luck!)enter link description here
Then you can write it like this, referring to the get-path expressions using the anaphoric it variable.
(conda
;; nothing to search for anymore
((null l) nil)
;; found the node we were looking for
;; in this case we return a list containing only x
((equal (car l) x) (list x))
;; the node was found on the left branch
((not (equal (get-path (cadr l) x) nil)) (cons (car l) it))
;; the node was found on the right branch
((not (equal (get-path (caddr l) x) nil)) (cons (car l) it)))
conda is clever about expressions of the form (not x) and (null x) (also (false x) in TXR Lisp). If the test expression is one of these, then it recurses into the x do ferret out the "anaphoric it".
Note that it binds to places not just to values. Not only is the target of it not evaluated more than once, if the target is a place, then it refers to that place:
(ifa (< x 10)
(inc it)) ;; increments x.
This aspect of ifa is achieved with the help of the placelet macro, which doesn't exist in Common Lisp. A quick and dirty substitute would be to use symbol-macrolet. The only problem is that that a symbol macro denoting a place allows multiple evaluation of the place whereas placelet evaluates a place once. The resulting lexical symbol then denotes the storage location, rather than the overall expression.
ifa was designed to either wipe the floor with Paul Graham's aif, or else to complement it; conda is trivially based on ifa.
By the way, do not write expressions like
(not (equal whatever nil))
in Lisp! Firstly, equal equality is not particularly meaningful if you are comparing with nil; only nil is equal to nil, and that is according to eq equality, so you might as well have:
(not (eq whatever nil))
Secondly, for something not to be eq to nil means that the something is true. That is to say:
(if (not (eq foo nil)) do-this) ---same-as--> (if foo do-this)
!
If we refactor your code to get rid of this stuff, then it's better if we have the Paul Graham Style anaphoric if aif (and an acond based on it). That is to say:
(ifa (not (equal (get-path whatever) nil))) (list it))
becomes:
(aif (get-path whatever) (list it))
where the it trivially to the value of the entire test expression, rather than a somewhat cleverly selected constituent of that expression.
Under ifa, this is expressed slightly more verbosely using:
(ifa (true (get-path whatever)) (list it))
Where true can be defined as
(defun true (x) (identity x)).
Without this extra wrapping, ifa will bind it to whatever.
I have been writing this code and researching ways to recursively run through a function and get it to return a list with the word "the" eliminated.
I am new to Common Lisp and I have been introduced to basic functions such as setq, cons, cond, equal, car and cdr.
When I run through the code, I keep getting the last element in the list and if there is a the after it, it follows.
Can anyone tell me what I'm doing wrong and lead me in the right direction?
The allowed Common Lisp constructs are: COND, EQUAL (or EQUALP), CONS, CAR and CDR, and some basic primitive building blocks of Common Lisp.
I can not use any predefined functions to do the actual elimination.
This is what it should look like..
Sample Run:
(filter-out-the '(There are the boy and THE girl and The Rose))
Returns:
(THERE ARE BOY AND GIRL AND ROSE)
This is my code:
(defun list_member (x L)
(cond ((null L) nil)
((equal x (car L))
(list_member x (cdr L)))
(T (cons (car l) (list_member x (cdr L))))))
(defun filter-out-the (L)
(setq x '(the))
(cond ((null L) nil)
((list_member (car x) (cdr L )) (filter-out-the (cdr L)))
(T (cons (car L) (filter-out-the (cdr L))))))
The function is just your first function, with better naming:
(defun my-remove (item list)
(cond ((null list) nil)
((equal item (first list))
(my-remove item (rest list)))
(T (cons (first list)
(my-remove item (rest list))))))
You can just call it:
CL-USER 36 > (my-remove 'the '(there are the boy and the girl and the rose))
(THERE ARE BOY AND GIRL AND ROSE)
(pred 'r '(p q r)) -> q
Here's my idea-
- I have tried finding the function that returns the length of a specific element, but due to my lack of syntactical knowledge, I am unable to use the function.
- By using the length function as my helper function, I am trying to find the predecessor of an element in the list.
I hope that gives you guys some idea to start with or if you guys have a better idea, please let me know and also please show the coding too..
Thank you!
Based on your current attempt, here's a corrected version (with corrected indentation, as a bonus :-)):
(defun pred (x l)
(cond ((null (cdr l)) (car l))
((eq (cadr l) x) (car l))
(t (pred x (cdr l)))))
Are you sure you want to return the last element of the list if your expected element isn't found? It seems...strange, I'd have thought nil is a better return value.
Update: the OP wanted to implement both successor and predecessor functions. Here's how I'd implement them, in Scheme. (Sorry, not doing your homework for you, but if you know how to translate Scheme into Common Lisp, your life would be easier.)
(define (succ x lst)
(cond ((memv x lst) => (lambda (mem)
(and (pair? (cdr mem))
(cadr mem))))
(else #f)))
(define (pred x lst)
(let loop ((prev #f)
(rest lst))
(cond ((null? rest) #f)
((eqv? (car rest) x) prev)
(else (loop (car rest) (cdr rest))))))
and while memv is built-in to Scheme, you could implement it yourself quite simply:
(define (memv x lst)
(let loop ((rest lst))
(cond ((null? rest) #f)
((eqv? (car rest) x) rest)
(else (loop (cdr rest))))))
In particular, note the similarity between memv and pred.
You don't particularly need a length function to do this.
The obvious classical approach would be that if the cadr of the list equals the element you want, return the car of the list. Otherwise, return the search function on the cdr of the list. Other than that, you just need to deal with the boundary conditions (e.g., list that's empty or contains only one item).
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.