I know this is a newbie question I apologize in advance. I'm writing a recursive function which returns the number of 'o in a given list
(defun garde-o (liste)
(cond
((not liste) 0)
((equal (car liste) 'o) (+ 1 (garde-o(cdr liste))) )
((garde-o(cdr liste)) )
)
)
Instead of returning the number of occurence I would like to return the given list with only the 'o.
Like that:
(garde-o '(a o x & w o o))
should return => (o o o)
I don't want to use pop,push,set... just I can't find of to return this.
Notice that given the number of occurrences, for example 10, you can simply do
(make-list 10 :initial-element 'o)
or equivalently
(loop repeat 10 collect 'o)
To count the 'o in your list, you can do
(count 'o '(a b c o p o a z))
Thus, a simple solution for your function would be
(defun garde-o (a)
(make-list (count 'o a) :initial-element 'o))
However, you can do this recursively too
(defun garde-o (a)
(cond ((null a) nil)
((eq (car a) 'o) (cons 'o (garde-o (cdr a))))
(t (garde-o (cdr a)))))
and non-recursively
(defun garde-o (a)
(loop for x in a when (eq x 'o) collect x))
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
So I have to count the occurrence of a word(or character, to be more specific) in a list in lisp. For example, the input:
(freq 'c '(a c c c c (c c c e)))
should produce a count of 7, since there are 7 c's in the list argument. The code I have is the following but it does not work. I can count the 4 c's that are base elements and the 3 c's that are in the sublist, but I dont know how to add them together. Also, I'm using only primitive data types.
(defun freq (a L)
(cond
((null L) 0)
((listp (car L)) ( (freq a (car L))) ((freq a (cdr L))))
((eq a (car L))(+ 1 (freq a (cdr L))))
(t ((freq a (cdr L))))))
If it's a character then it's should be written with this prefix -> #\
and the sequence would be a string so there is no need recursion here.
(count #\c "(a c c c c (c c c e))") => 7
What you're dealing with in your example is symbol (with a single quote) through a list which contains other symbols or cons. So if you need to count all the same symbol you could write something like that :
(defparameter *nb* 0)
(defun look-deeper (test seq)
(loop for i in seq do
(compare test i)))
(defun compare (test item)
(let ((type (type-of item)))
(case type
(symbol (when (eql test item) (incf *nb*)))
(cons (look-deeper test item)))))
(look-deeper 'c '(a c c c c (c c c e))) => NIL
*nb* => 7
Or something better..
(defun count-occurences (obj lst)
(let ((acc 0))
(labels ((test (obj-2)
(eq obj obj-2)))
(dolist (x lst)
(if (consp x)
(let ((sample (remove-if-not #'test x)))
(if sample
(incf acc (length sample))))
(if (eq x obj)
(incf acc 1)))))
acc))
We could create a function that takes an obj to test and a lst as the argument and create a local accumulator to keep track of how many times the obj occurs in the list. Then we could create a local function that tests to see if the obj we pass to it is eq to the obj passed as an argument to the global function (also note that if you are working with strings you might want to use string-equal or equal because eq will not work since they are not the same object, but eq will work with symbols which you used in your example). We can then iterate through the list, and if the element in the list is a cons we can use remove-if-not to remove any element that doesn't pass our test (is not eq to the obj), and based on the length of the list increment our accumulator accordingly. If it is not a cons and is eq to our obj we will also increment the accumulator, then we can return the value of our accumulator.
And if we test it:
CL-USER> (count-occurences 'c '(a c c c c (c c c)))
7
Your logic is actually correct, there are just some small mis-parenthesis problems in your code. The only change you need for your code to work is to change you listp and t clauses from
((listp (car L)) ( (freq a (car L))) ((freq a (cdr L))))
into
((listp (car L)) (+ (freq a (car L)) (freq a (cdr L))))
and from
(t ((freq a (cdr L))))
into
(t (freq a (cdr L)))
Then evaluating your function works just as you expect:
(defun freq (a L)
(cond
((null L) 0)
((listp (car L)) (+ (freq a (car L)) (freq a (cdr L))))
((eq a (car L))(+ 1 (freq a (cdr L))))
(t (freq a (cdr L)))))
(freq 'c '((a (c f c)) c c c (c c (d c f (c 8 c) c) e))) ; => 11 (4 bits, #xB, #o13, #b1011)
I'm trying to write a recursive palindrome function. The code works using two function as follows:
(set str(a b c d))
(defun reverseString (l)
(cond
( (null l) nil)
(T (append (reverseString (cdr l)) (list (car l))))
)
)
(defun palindrome (l)
(cond
( (null l) nil)
(T (append l(reverseString (cdr l)) (list (car l))))
)
)
However, I'm trying to combine it into a single function:
(defun palindrome (l)
(cond
( (null l)
nil
)
(T
(append str(append (palindrome (cdr l)) (list (car l))) )
)
)
)
This returns (A B C D A B C D A B C D A B C D D C B A)
Where I want it to return (a b c d d c b a) and then eventually (a b c d c b a) **not repeating the last character when it reverses.
I know there are easier ways to do this we predefined functions, but I'm trying to challenge myself a bit. However I'm stuck here, and help would be greatly appreciated.
Here is a recursive, single function palindrome:
(defun palindrome(l)
(cond ((null l) nil)
(t (append (list (car l)) (palindrome (cdr l)) (list (car l))))))
The recursion is structured in this way: make a palindrome of the rest of the list, and put at the beginning and at the end the first element of the list.
If you want to have the central element only once, here is an alternative version:
(defun palindrome(l)
(cond ((null l) nil)
((null (cdr l)) (list (car l)))
(t (append (list (car l)) (palindrome (cdr l)) (list (car l))))))
that is, you have to add a new case for the termination of the recursive function: terminate also when there is only one element, and return that element.
i have a function in scheme, this function calls another function many times, and every time this function appends return value of another function to result value.
but finally i want to get a result such that '(a b c), however i get a result such that '((a) (b) (c)) how can i fix this problem? i have searched but i couldn't find good solution.
my little code like that not all of them.
(append res (func x))
(append res (func y))
(append res (func z))
my code like this
(define (check a )
'(1)
)
(define bos '())
(define (func a)
(let loop1([a a] [res '()])
(cond
[(eq? a '()) res]
[else (let ([ x (check (car a))])
(loop1 (cdr a) (append res (list x)))
)]
)
))
Try this:
(define (func a)
(let loop1 ([a a] [res '()])
(cond
[(eq? a '()) res]
[else
(let ([ x (check (car a))])
(loop1 (cdr a) (append res x)))])))
Notice that the only change I made (besides improving the formatting) was substituting (list x) with x. That will do the trick! Alternatively, but less portable - you can use append* instead of append:
(append* res (list x))
As a side comment, you should use (null? a) for testing if the list is empty. Now if we test the procedure using the sample code in the question, we'll get:
(func '(a b c))
=> '(1 1 1)
It seems that instead of
(loop1 (cdr a) (cdr b) c (append res (list x)))
you want
(loop1 (cdr a) (cdr b) c (append res x))
Basically the trick is to use cons instead of list. Imagine (list 1 2 3 4) which is the same as (cons 1 (cons 2 (cons 3 (cons 4 '())))). Do you see how each part is (cons this-iteration-element (recurse-further)) like this:
(define (make-list n)
(if (zero? n)
'()
(cons n (make-list (sub1 n)))))
(make-list 10) ; ==> (10 9 8 7 6 5 4 3 2 1)
Usually when you can choose direction you can always make it tail recursive with an accumulator:
(define (make-list n)
(let loop ((x 1) (acc '()))
(if (> x n)
acc
(loop (add1 x) (cons x acc))))) ; build up in reverse!
(make-list 10) ; ==> (10 9 8 7 6 5 4 3 2 1)
Now this is a generic answer. Applied to your working code:
(define (func a)
(let loop1 ([a a] [res '()])
(cond
[(eq? a '()) (reverse res)]
[else
(let ([x (check (car a))])
(loop1 (cdr a) (cons (car x) res)))])))
(func '(a b c)) ; ==> (1 1 1)
append replaces the cons so why not put the car og your result to the rest of the list. Since you want the result in order I reverse the result in the base case. (can't really tell from the result, but I guessed since you ise append)
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.