I'm having trouble developing a recursive function that will see if two list's are equal to each other, including looking at the sub list's. So far I have:
(defun are-equal2 (X Y)
(cond
((null X) nil)
((and (listp (first X)) (listp (first Y)))
(are-equal2 (first X) (first Y))
)
((eq (first X) (first Y))
T
)
)
)
It seems to work sometimes. for example (are-equal2 '((A) B) '((A) B)) returns T and (are-equal2 '((A) B) '(A B)) returns nil. but (are-equal2 '(F (A G) B) '(F (T G) B)) returns T..... I think it might have to do with my last conditional. I'm not sure how to re-work it though.
Never mind lol. Did some tinkering waiting for a reply and got it. Did a bunch of nested if statements. Code:
(defun are-equal2 (X Y)
(if (and (listp (first X)) (listp (first Y)))
(are-equal2 (first X) (first Y))
(if (and (eq (first X) (first Y)))
(if (and (endp (rest X)) (endp (rest Y)))
T
(are-equal2 (rest X) (rest Y))
)
nil
)
)
)
I don't think you can get away with a tail-recursive version here.
I am afraid you will have to think of your arguments as trees, not sequences.
E.g.,
(defun are-equal (x y &key (test #'eql))
(or (funcall test x y)
(and (consp x)
(consp y)
(are-equal (car x) (car y))
(are-equal (cdr x) (cdr y)))))
This compares leaves using eql by default (cf. Rules about Test Functions), as opposed to eq in your example:
(are-equal '((1) a) '((1) a))
==> T
(are-equal '((1) a) '((1) b))
==> NIL
(are-equal '((1) a) '((2) a))
==> NIL
(are-equal '(("1") a) '(("1") a))
==> NIL
Related
The task is: for given list of elements and X element, remove an element after X if it is not equal to X. Example: (a 8 2 a a 5 a) X=a, expecting (a 2 a a a).
I have code that removes an element before X, so it gives me (a 8 a a a) instead. How do I fix it?
(defun purgatory (n w)
(cond ((null w) nil)
((and (eq (cadr w) n) (not (eq (car w) (cadr w)))) (purgatory n (cdr w)))
((cons (car w) (purgatory n (cdr w))))))
You can use the destructuring of for on clauses in loop:
(defun purgatory (list x)
(cons (first list)
(loop :for (a b) :on list
:unless (and (eql a x)
(not (eql b x)))
:collect b)))
I think you are on the right lines with a recursive algorithm. I think that the algorithm works better as a tail-optimised recursion. You take an in-list and an X, and build up an out-list. The output is reversed, and so reverse needs to be applied at the end, thus:
(defparameter my-list '(a 8 2 a a 5 a))
(defun remove-after (in-list X &optional (out-list '()) (last '()))
(if (null in-list)
(reverse out-list)
(if (and (eql last X) (not (eql (car in-list) X)))
(remove-after (cdr in-list) X out-list (car in-list))
(remove-after (cdr in-list) X (cons (car in-list) out-list) (car in-list))
)))
; (A 2 A A A)
As for the non-tail algorithm, I think this does it:
(defun purgatory (n w)
(cond ((null w) nil)
((and (eq (car w) n) (not (eq n (cadr w)))) (cons (car w) (purgatory n (cddr w))))
(t (cons (car w) (purgatory n (cdr w))))
))
; (A 2 A A A)
So, if the first element is n and the next is not n, then add n at the front of the algorithm, but skip cddr the next element. Otherwise, add the first element to the front of the algorithm, no skip cdr.
NB: since you've defined the problem in terms of X, I think this should be one of your parameters, not n
I have developed code to check through input to see if it is a palindrome or not but I am having difficulty figuring out how to print the output. I want the output to return "t" if the input is a palindrome and "nil" if not. Also a challenge that I wanted to give myself was to not use the reverse function so thats why my code is not as simple as it could be. Thanks in advance.
(defun palindromep(l)
(cond ((null l) nil (write nil))
(t (append (list (car l)) (palindromep (cdr l)) (list (car l) )))))
(palindromep '(a b b a))
(terpri)
(palindromep '(a b c b a))
(terpri)
(palindromep '(a b c))
(terpri)
(palindromep '(a (d e) (d e) a))
(terpri)
(palindromep '(a (d e) (e d) a))
Firstly, an empty list is a palindrome! If we reverse it, we get the same empty list.
Secondly, Lisp functions don't print their result values; they return these values.
In an interactive session, it is the listener which prints the resulting value(s) that emerge from the expression being evaluated. That expression itself doesn't have to print anything.
Therefore, we begin like this:
(defun palindromep (l)
(cond
((null l) t) ;; the empty list is a palindrome: yield true.
Note, by the way, that if we write this:
((null l) nil t) ;; the empty list is a palindrome: yield true.
that doesn't do anything. The extra nil expression is evaluated, producing nil, which is thrown away. The Lisp compiler will completely eliminate that.
What if the list is not a list at all, but an atom other than nil? Let's just go with that being a palindrome. A clarification of requirements is needed, though:
((atom l) t)
Now we know we are dealing with a non-empty list. If it has exactly one item, then it is a palindrome:
((null (cdr l)) t)
Now we know we are dealing with a list of two or more items. That is a palindrome if the first and last items are the same, and if the items in between them form a palindrome.
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
The whole thing:
(defun palindromep (l)
(cond
((null l) t)
((atom l) t)
((null (cdr l)) t)
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Code golfing: in the cond construct described by ANSI CL, a clause is permitted to have just one form. If that forms yields a true value, then that value is returned. Thus we can remove the t's:
(defun palindromep (l)
(cond
((null l)) ;; t removed
((atom l)) ;; likewise
((null (cdr l))) ;; likewise
(t (let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior))))))
Documentation about the functions ldiff and last can be found here.
Further golfing: if we have this pattern (cond (A) (B) ... (t Z)) we can just replace it by (or A B ... Z):
(defun palindromep (l)
(or (null l)
(atom l)
(let* ((first (car l))
(rest (cdr l))
(tail (last l))
(interior (ldiff rest tail)))
(and (eql first (car tail)) (palindromep interior)))))
cond is like a generalization of or that can specify an alternative result value for the each terminating true case.
To go on with code-golfing, since t or nil is expected, you can use only or and nil to express conditionals (and using short-circuitry of or and nil expressions).
Also it is good to be able to determine a :test keyword - since you want to control the crucial testing behavior.
To be able to use also inner lists, one could e.g. use equalp or even a custom comparison function.
(defun palindromep (l &key (test #'equalp))
(or (null l) (and (funcall test (car l) (car (last l)))
(palindromep (butlast (cdr l)) :test test))))
This evaluates
(palindromep '(a (d e) (d e) a))
as t but
(palindromep '(a (d e) (e d) a))
as nil.
Well, it is maybe a philosophical question, whether the latter should be t and the former nil.
To revert that behavior, we could write a custom testing function.
Like this:
(defun reverse* (l &optional (acc '()))
(cond ((null l) acc)
((atom (car l)) (reverse* (cdr l) (cons (car l) acc)))
(t (reverse* (cdr l) (cons (reverse* (car l) '()) acc)))))
(defun to-each-other-symmetric-p (a b)
(cond ((and (atom a) (atom b)) (equalp a b))
(t (equalp a (reverse* b)))))
Well, I use here some kind of a reverse*.
Then if one does:
(palindromep '(a (d e) (d e) a) :test #'to-each-other-symmetric-p) ;; NIL
;; and
(palindromep '(a (d e) (e d) a) :test #'to-each-other-symmetric-p) ;; T
Just to complete the other answers, I would like to point out that not using reverse will not only complicate your code enormously, but also make it far more inefficient. Just compare the above answers with the classic one:
(defun palindromep (l)
(equal l (reverse l)))
reverse is o(l), i.e. it takes time proportional to the length of the list l, and so does equal. So this function will run in o(l). You can't get faster than this.
I'm working my way through Paul Graham's "ANSI Common Lisp" (1996).
Chapter 3, exercises, qu. 2 asks for a function as stated in title of this post. I'm only using what has been taught in the book up to this point (obviously there's case construct that could clean up the if's but I'm not minding that at present).
As a first attempt I ended up writing interleave, which retains duplicates:
(defun interleave (x y)
(if (and (null x)
(null y))
nil
(if (null x)
(cons (car y)
(interleave (cdr y) x))
; where y is null, but also for any other case:
(cons (car x)
(interleave y (cdr x))))))
Following that, I had the idea to store a carry of elements which have been seen, and defer to a helper function, as below.
However, the below is obviously rather ugly and hard to understand.
I'm seeking some suggestions on directions I might take to achieve elegance.
Tips on approach & style might be just as useful at this point as providing the canonical solution. Should my number one impulse given code below be to extract another function? (or maybe I've gone in the wrong direction trying to store the carry in the first place?) Thank you fellow hackers!
(defun new-union (x y)
(new-union-helper x y '())) ; <- idea, add a carry to store what's been seen.
(defun new-union-helper (x y seen)
(if (and (null x)
(null y))
nil
(if (null x)
(if (not (member (car y) seen)) ; if first el of y hasn't yet been seen...
; cons it to the ultimate result & recur, while adding it to seen:
(cons (car y) (new-union-helper (cdr y) x (cons (car y) seen)))
; if it has been seen, just continue, (skip the duplicate):
(new-union-helper (cdr y) x seen))
(if (not (member (car x) seen))
(cons (car x) (new-union-helper y (cdr x) (cons (car x) seen)))
(new-union-helper (cdr x) y seen)))))
Update: I've attempted to replace the nested ifs with cond, having looked up cond in the index of the book. Sorry in advance, this is so ugly... but if anyone can tell me what I'm doing wrong here that would be greatly appreciated. This code works same as above, but it prints a nil as the last member of the resulting list (on some inputs), not sure why yet.
; attempt to use cond instead:
(defun new-union-helper (x y seen)
(cond ((and (null x) (null y))
nil)
((and (null x) (not (member (car y) seen)))
(cons (car y) (new-union-helper (cdr y) x (cons (car y) seen))))
((null x)
(new-union-helper (cdr y) x seen))
((not (member (car x) seen))
(cons (car x) (new-union-helper y (cdr x) (cons (car x) seen))))
(t
(new-union-helper (cdr x) y seen))))
Update 2: I've tried to adopt better indenting. The below does what I want it to do from informal tests. Any further tips on what I'm still doing wrong? (I realise I should maybe abandon this and pursue another path, but since this is a learning exercise I wanted to fix as many potential bad habits as possible, early, before continuing on a new path).
How does this rate on the ugliness stakes? :) Is it now readable to an experienced lisper?
; better (standard?) formatting
(defun new-union-helper (x y seen)
(cond ((and (null x)
(null y))
nil)
((and (null x)
(member (car y) seen)) ; replacing find with member stops duplicate nils
(new-union-helper (cdr y) x seen))
((null x)
(cons (car y)
(new-union-helper (cdr y) x
(cons (car y) seen))))
((member (car x) seen)
(new-union-helper (cdr x) y seen))
(t
(cons (car x)
(new-union-helper y (cdr x)
(cons (car x) seen))))))
(defun new-union (list1 list2 &aux (list3 (reverse list1)))
(loop for e in list2 do (pushnew e list3))
(reverse list3))
(defun new-union (list1 list2 &aux (list3 (reverse list1)))
(dolist (e list2 (reverse list3))
(pushnew e list3)))
Union takes two lists as arguments and will return a new list with the duplicates removed as you know. You want to retain the order of the original lists it appears. The specific question from the book if I recall is that if you have the lists:
(new-union '(a b c) '(b a d))
It should return:
(A B C D)
in order to maintain the proper order. So i'd imagine you need a function that takes two lists obviously, and something such as an accumulator so that you do not destructure the original lists. Union is a "non-destructuring" function. Since we are working with lists, you can use the dolist macro so that we can loop through both lists. That would lead us to the conclusion that the function below may work, as it will maintain the original structure of both lists, maintain the order of both lists, and remove duplicates:
(defun new-union(lst1 lst2)
(let((accum nil))
(dolist(x lst1)
(push x accum))
(dolist(y lst2)
(if(not(find y accum))
(push y accum)))
(nreverse accum))
We can push each element from the first list to our accumulator, and then we can iterate through the second list and ONLY push it to the list if it is not an element that has already been pushed to the accumulator. This way, we avoid duplicates, maintain the structure of both of the original lists, and maintain the proper order if we return the our accumulator with the reverse function. Let's test it in the REPL:
CL-USER> (new-union '(a b c) '(b a d))
(A B C D)
Here is a recursive implementation. It can be made faster with a few hacks. For example, a hash-table may be used to save elements that have been seen. In that case, find will be replaced with a hash-table lookup which is constant time.
(defun new-union (lst1 lst2)
"return xs U ys preserving order in originals"
(labels ((rec (xs ys acc)
(let ((x (car xs))
(xx (cdr xs))
(y (car ys))
(yy (cdr ys)))
(cond ((and (null xs) (null ys))
acc)
((null xs)
(or (and (find y acc) (rec xx yy acc))
(rec xx yy (cons y acc))))
((null ys)
(or (and (find x acc) (rec xx yy acc))
(rec xx yy (cons x acc))))
((and (find x acc) (find y acc))
(rec xx yy acc))
((and (find x acc) (not (find y acc)))
(rec xx yy (cons y acc)))
((and (not (find x acc)) (find y acc))
(rec xx yy (cons x acc)))
(t (rec xx yy (cons y (cons x acc))))))))
(nreverse (rec lst1 lst2 nil))))
I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.
Say, that I have a pre-defined function 'sum' elsewhere.
I want to sum two lists after I do (setq a '(4 3 4)) and (setq b '(6 10 9))
And I do (recurse a b).
However, I keep getting 'nil' as the return value. What am I doing wrong with this recursion?
Trace isn't being helpful at the moment.
(defun recurse (x y)
(cond
( (null x) nil) )
(t (sum (car x) (car y) ) (recurse (cdr x) (cdr y)) )
)
)
You need to cons up the results; otherwise they are thrown out.
(defun recurse (x y)
(cond
((null x) nil)
(t (cons (sum (car x) (car y))
(recurse (cdr x) (cdr y))))))