I am trying to write code in Lisp counting sublists beginning with number, recursively. I ve trying to use numberp but my code, when arrived to an atom, doesn't count the rest of the list.
With my code here,
(defun nombres (liste)
(cond
((atom liste) 0)((atom (car liste)) 0)
((and (numberp (caar liste)) (+ (nombres (cdr liste)) 1)))
(t (nombres (cdr liste))) ) )
I can get a count of sublists but when arrived to an atom , it doesn't count the rest.
[67]> (nombres '((a b d) (5 g) (7 m)))
2
[68]> (nombres '((a b d) (5 g) g (7 m)))
1
When I test the sublist with (listp (car list), it gives me nil.
[69]> (defun nombres (liste)
(cond
((atom liste) 0)((atom (car liste)) 0)
((listp (car liste))(and (numberp (caar liste)) (+ (nombres (cdr liste)) 1))) (t (nombres (cdr liste))) ) )
NOMBRES
[70]> (nombres '((a b d) (5 g) g (7 m) m))
NIL
I want to get something like :
(nombres '((a b d) a (5 g) (b) (7 m) j (8 h l g)))
3
Thanks for your help
You need to think about the cases you need to handle.
The end of the list => return the result
A sublist that has a number in front => add one to the result
Anything else => continue to the next element
These will quite easily translate to a COND:
(cond ((endp list) ...) ; 1
((and (listp (car list)) ; 2
(numberp (caar list)))
...)
(t ...) ; 3
Using an accumulator as an optional parameter, the counting is easy to fill in:
(defun count-sublists (list &optional (acc 0))
(cond ((endp list) acc)
((and (listp (car list))
(numberp (caar list)))
(count-sublists (cdr list) (1+ acc)))
(t (count-sublists (cdr list) acc))))
(count-sublists '((a b d) a (5 g) (b) (7 m) j (8 h l g)))
;=> 3
The standard Common Lisp function count-if is easier to use:
CL-USER > (count-if (lambda (item)
(and (consp item)
(numberp (first item))))
'((a b d) a (5 g) (b) (7 m) j (8 h l g)))
3
Related
I am a lisp newbie.
I'm trying to create a function in lisp that receives an unsorted list and the function has to sort de list and return a list with the longest sequence of numbers.
Example: (2 1 8 9 3 11 10 20 12 21)(1 2 3 8 9 10 11 12 20 21) -> return (8 9 10 11 12)
I don't want to use the sort function and I have created 2 functions (With some help) to sort, but now I have no idea how I could find and return the longest sequence of numbers.
I could go through the list but, how I can store the numbers and check if a list of consecutive numbers is longer than another?
This are my functions to sort
(defun sortOne (list)
(let ((ca1 (car list)) (cd1 (cdr list)))
(if (null cd1)
list
(let ((cd (sortOne cd1))) ; cd = sorted tail
(let ((ca2 (car cd)) (cd2 (cdr cd)))
(if (<= ca1 ca2)
(cons ca1 cd)
(cons ca2 (cons ca1 cd2))))))))
(defun sortAll (list)
(if (null list)
nil
(let ((s (sortOne list)))
(cons (car s) (sortAll (cdr s))))))
Hope someone can help me.
¡Thanks!
Tonight I managed to do it, but surely it is not the best solution, I would like to know how to use a lambda function or recursion to do it better.
(defun listilla (lista)
(setq lista (sort lista #'<))
(setq lista1 (list (car lista)))
(setq lista2 '())
(loop for i from 0 to (- (length lista) 2) do
(cond ((= (nth i lista) (- (nth (+ i 1) lista) 1))
(push (nth (+ i 1) lista) (cdr (last lista1))))
(t (push lista1 lista2)
(setq lista1 (list (nth (+ i 1) lista)))
)
)
)
(push lista1 lista2)
(setq masLargo (car lista2))
(loop for i from 1 to (- (length lista2) 2) do
(if (< (length (nth i lista2)) (length (nth (+ i 1) lista2)))
(setq masLargo (nth (+ i 1) lista2))
)
)
masLargo
)
(print (listilla '(23 15 6 5 78 4 77)))
(defun group-consecutives (l &optional (acc '()))
(cond ((null l) (nreverse acc))
((and acc (= 1 (- (car l) (caar acc)))) (consecutives (cdr l) (cons (cons (car l) (car acc)) (cdr acc))))
(t (consecutives (cdr l) (cons (list (car l)) (when acc (cons (nreverse (car acc)) (cdr acc))))))))
(defun longest-consecutive (l)
(car (sort (consecutives (sort l #'<)) #'> :key #'length)))
(longest-consecutive '(2 1 8 9 3 11 10 20 12 21))
;;=> (8 9 10 11 12)
Probably the second function is easier to understand like this:
(defun sort-increasing (l)
(sort l #'<))
(defun sort-groups-by-length (groups)
(sort groups #'> #'length))
(defun longest-consecutive (l)
(car (sort-groups-by-length (group-consecutives (sort-increasing l))))))))
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 finishing up a Scheme assignment and I'm having some trouble with the recursive cases for two functions.
The first function is a running-sums function which takes in a list and returns a list of the running sums i.e (summer '(1 2 3)) ---> (1 3 6) Now I believe I'm very close but can't quite figure out how to fix my case. Currently I have
(define (summer L)
(cond ((null? L) '())
((null? (cdr L)) '())
(else (cons (car L) (+ (car L) (cadr L))))))
I know I need to recursively call summer, but I'm confused on how to put the recursive call in there.
Secondly, I'm writing a function which counts the occurrences of an element in a list. This function works fine through using a helper function but it creates duplicate pairs.
(define (counts L)
(cond ((null? L) '())
(else (cons (cons (car L) (countEle L (car L))) (counts (cdr L))))))
(define (countEle L x)
(if (null? L) 0
(if (eq? x (car L)) (+ 1 (countEle (cdr L) x)) (countEle (cdr L) x))))
The expected output is:
(counts '(a b c c b b)) --> '((a 1) (b 3) ( c 2))
But it's currently returning '((a . 1) (b . 3) (c . 2) (c . 1) (b . 2) (b . 1)). So it's close; I'm just not sure how to handle checking if I've already counted the element.
Any help is appreciated, thank you!
To have a running sum, you need in some way to keep track of the last sum. So some procedure should have two arguments: the rest of the list to sum (which may be the whole list) and the sum so far.
(define (running-sum L)
(define (rs l s)
...)
(rs L 0))
For the second procedure you want to do something like
(define (count-elems L)
(define (remove-elem e L) ...)
(define (count-single e L) ...)
(if (null? L)
'()
(let ((this-element (car L)))
(cons (list this-element (count-single this-element L))
(count-elems (remove-elem this-element (cdr L)))))))
Be sure to remove the elements you've counted before continuing! I think you can fill in the rest.
To your first problem:
The mistake in your procedure is, that there is no recursive call of "summer". Have a look at the last line.
(else (cons (car L) (+ (car L) (cadr L))))))
Here is the complete solution:
(define (summer LL)
(define (loop sum LL)
(if (null? LL)
'()
(cons (+ sum (car LL)) (loop (+ sum (car ll)) (cdr LL)))))
(loop 0 LL))
This is what my wason-deck produces:
((15 . D) (35 . H) (3 . B) (19 . K) (L . 15) (A . 16) (T . 23) (R . 53)
(N . 13) (M . 7) (I . 52) (35 . Q) (S . 19) (Y . 29) (45 . G) (44 . W)
(11 . V) (J . 25) (21 . F) (39 . Z) (25 . X) (50 . E) (5 . P) (33 . C)
(O . 34))
this being a list of pairs representing a Wason deck. (See this, Example 6). In the deck there should be all the letters of the alphabet matched with even or odd numbers depending on whether a vowel or consonant respectively. I randomly shuffle and flip the cards as you can see. Then I (optionally) randomly pollute the deck by occasionally breaking the vowel:even, consonant:odd rule. Here's the code I've come up with:
(defun wason-deck (&optional (p 0))
"This `consolst` and `vowlist` building is unnecessary, but a good exercise"
(let* ((alphab '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(consonents '(b c d f g h j k l m n p q r s t v w x y z))
(consolst (remove 'NIL (mapcar (lambda (x) (find x consonents)) alphab)))
(vowlst (remove 'NIL (mapcar (lambda (x) (find x '(a e i o))) alphab)))
(wdeck '()))
(labels ((make-consodeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (evenp num)
(1+ num)
num)))) consolst))
(make-voweldeck ()
(mapcar (lambda (x) (let ((num (random 54)))
(cons x (if (oddp num)
(1+ num)
num)))) vowlst))
(swap (slst el1 el2)
(let ((tmp (elt slst el1)))
(setf (elt slst el1) (elt slst el2))
(setf (elt slst el2) tmp)))
(shuffle (slst)
(loop for i in (reverse (range (length slst) :min 1))
do (let ((j (random (+ i 1))))
(swap slst i j)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append (make-consodeck) (make-voweldeck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck)))))
It works, but what I fear is not really knowing what I'm doing, i.e., I've misused labels as well as done a setf in the code. If some of the more senior people could tell me whether this is totally off in the wrong direction or not.
Addendum:
This is what I've got after the suggestions from below:
(defun wason-deck3 (&optional (p 0))
(let* ((consonents '(b c d f g h j k l m n p q r s t v w x y z))
(vowels '(a e i o u))
(conso-deck (mapcar (lambda (x)
(cons x (1+ (* 2 (random 27)))))
consonents))
(vowel-deck (mapcar (lambda (x)
(cons x (* 2 (random 27))))
vowels))
(wdeck '()))
(labels
((shuffle (slst)
(loop :for i :from (1- (length slst)) :downto 1
:do (rotatef (nth i slst)
(nth (random (1+ i)) slst)))
slst)
(flip (flst)
(mapcar (lambda (x) (let ((num (random 2)))
(if (zerop num)
(cons (cdr x) (car x))
x))) flst)))
(setf wdeck (flip (shuffle (append conso-deck vowel-deck)))))
(if (zerop p) wdeck
(mapcar (lambda (x) (let ((num (random 6)))
(cond ((and (zerop num) (numberp (car x))) (cons (1+ (car x)) (cdr x)))
((and (zerop num) (numberp (cdr x))) (cons (car x) (1+ (cdr x))))
(t x)))) wdeck))))
Please add any new suggestions.
Using labels is totally OK, and your code is not entirely unreasonable.
A few pointers:
I'd represent characters as characters: '(#\a #\b #\c …)
I'd take my list exercises elsewhere, or at least use set-difference.
When you create a function for just one call, you might as well just save the result:
(let ((consonant-deck (mapcar (lambda (c)
(cons c (1+ (* 2 (random 27)))))
consonants))
(vowel-deck (mapcar (lambda (c)
(cons c (* 2 (random 27))))
vowels)))
…)
For swapping, there is rotatef: (rotatef (nth i list) (nth j list)). Such things are rather expensive on lists, so I'd prefer to use a vector for this. Then it comes in handy that a string is just a vector of characters…
Loop can do counting for you, you don't need to create lists:
(loop :for i :from (1- (length list)) :downto 1
:do (rotatef (nth i list)
(nth (random (1+ i)) list)))
(Using keywords as loop keywords is optional, but indentation should be like this.)
If you put the labels around the let, you can immediately bind wdeck, so that you do not need to setf it afterwards.
You do not need this function for the exercise that you linked to.
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)