I am trying to delete all occurrences of an element from a list, from any levels of the list. I am required to use a map function though. I am using Common Lisp. For example I'd want to be able to do:
(fdelete '(1 2 3 4 (3)) 3) => (1 2 4)
What I've tried so far:
This function will do what's needed, sort of. It will replace all occurences of the given element with NIL, so it's not exactly what I want.
(defun fdelete (l e)
(cond
((null l) 0)
((equal l e) nil)
((atom l) l)
(t (mapcar (lambda(l) (fdelete l e )) l ))
)
)
This will do
(fdelete '(1 2 3 4 (3)) 3) => (1 2 NIL 4 (NIL))
My second try is with the mapcap function, since this one won't return a list the same size as the input list.
This will do what's needed, but it will 'destroy' my initial list, as in, it will bring all sublists 'to surface'.
(defun fdelete (l e)
(cond
((null l) 0)
((equal l e) nil)
((atom l) (list l))
(t(mapcan(lambda(x) (fdelete x e ))l ))
)
)
So this indeed does (fdelete '(1 2 3 4 (3)) 3) => (1 2 4)
but it will also do it wrong if I for example try this:
(fdelete '(1 2 3 (4) (3)) 3)) => (1 2 4)
I'd want it to do (fdelete '(1 2 3 (4) (3)) 3)) => (1 2 (4))
I hope my question is well formed and detailed enough, and I am providing working examples. Can someone give me a few hints on how to solve this problem?
Using mapcan is the correct choice since you can wrap in list to get a value or use nil to get item removed. For the list element, if it doesn't already match what to delete, you should check the result of the recursion and wrap it if it's not the empty list.
The solution would look something like:
(defun remove-deep (item list)
(mapcan (lambda (cur)
(cond ((equal item cur) '())
...))
list))
(remove-deep 3 '(1 nil 2 3 (3) (3 4)))
; ==> (1 nil 2 (4))
To apply the principle of least surprise I have renamed the function since delete is the destructive version of remove. Also I kept the argument order of the standard functions:
Related
I was trying to make a recursive function to split a list into two lists according the number of elements one wants.
Ex:
(split 3 '(1 3 5 7 9)) ((1 3 5) (7 9))
(split 7 '(1 3 5 7 9)) ((1 3 5 7 9) NIL)
(split 0 '(1 3 5 7 9)) (NIL (1 3 5 7 9))
My code is like this:
(defun split (e L)
(cond ((eql e 0) '(() L))
((> e 0) (cons (car L) (car (split (- e 1) (cdr L))))))))
I don't find a way to join the first list elements and return the second list.
Tail recursive solution
(defun split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((>= 0 n) (list (reverse acc-l) l))
(t (split (1- n) (cdr l) (cons (car l) acc-l)))))
Improved version
(in this version, it is ensured that acc-l is at the beginning '()):
(defun split (n l)
(labels ((inner-split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((= 0 n) (list (reverse acc-l) l))
(t (inner-split (1- n) (cdr l) (cons (car l) acc-l))))))
(inner-split n l)))
Test it:
(split 3 '(1 2 3 4 5 6 7))
;; returns: ((1 2 3) (4 5 6 7))
(split 0 '(1 2 3 4 5 6 7))
;; returns: (NIL (1 2 3 4 5 6 7))
(split 7 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split 9 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split -3 '(1 2 3 4 5 6 7))
;; returns (NIL (1 2 3 4 5 6 7))
In the improved version, the recursive function is placed one level deeper (kind of encapsulation) by using labels (kind of let which allows definition of local functions but in a way that they are allowed to call themselves - so it allows recursive local functions).
How I came to the solution:
Somehow it is clear, that the first list in the result must result from consing one element after another from the beginning of l in successive order. However, consing adds an element to an existing list at its beginning and not its end.
So, successively consing the car of the list will lead to a reversed order.
Thus, it is clear that in the last step, when the first list is returned, it hast to be reversed. The second list is simply (cdr l) of the last step so can be added to the result in the last step, when the result is returned.
So I thought, it is good to accumulate the first list into (acc-l) - the accumulator is mostly the last element in the argument list of tail-recursive functions, the components of the first list. I called it acc-l - accumulator-list.
When writing a recursive function, one begins the cond part with the trivial cases. If the inputs are a number and a list, the most trivial cases - and the last steps of the recursion, are the cases, when
the list is empty (equal l '()) ---> (null l)
and the number is zero ----> (= n 0) - actually (zerop n). But later I changed it to (>= n 0) to catch also the cases that a negative number is given as input.
(Thus very often recursive cond parts have null or zerop in their conditions.)
When the list l is empty, then the two lists have to be returned - while the second list is an empty list and the first list is - unintuitively - the reversed acc-l.
You have to build them with (list ) since the list arguments get evaluated shortly before return (in contrast to quote = '(...) where the result cannot be evaluated to sth in the last step.)
When n is zero (and later: when n is negative) then nothing is to do than to return l as the second list and what have been accumulated for the first list until now - but in reverse order.
In all other cases (t ...), the car of the list l is consed to the list which was accumulated until now (for the first list): (cons (car l) acc-l) and this I give as the accumulator list (acc-l) to split and the rest of the list as the new list in this call (cdr l) and (1- n). This decrementation in the recursive call is very typical for recursive function definitions.
By that, we have covered all possibilities for one step in the recursion.
And that makes recursion so powerful: conquer all possibilities in ONE step - and then you have defined how to handle nearly infinitely many cases.
Non-tail-recursive solution
(inspired by Dan Robertson's solution - Thank you Dan! Especially his solution with destructuring-bind I liked.)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (destructuring-bind (left right) (split (1- n) (cdr l))
(list (cons (car l) left) right)))))
And a solution with only very elementary functions (only null, list, >=, let, t, cons, car, cdr, cadr)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (let ((res (split (1- n) (cdr l))))
(let ((left-list (car res))
(right-list (cadr res)))
(list (cons (car l) left-list) right-list))))))
Remember: split returns a list of two lists.
(defun split (e L)
(cond ((eql e 0)
'(() L)) ; you want to call the function LIST
; so that the value of L is in the list,
; and not the symbol L itself
((> e 0)
; now you want to return a list of two lists.
; thus it probably is a good idea to call the function LIST
; the first sublist is made of the first element of L
; and the first sublist of the result of SPLIT
; the second sublist is made of the second sublist
; of the result of SPLIT
(cons (car L)
(car (split (- e 1)
(cdr L)))))))
Well let’s try to derive the recursion we should be doing.
(split 0 l) = (list () l)
So that’s our base case. Now we know
(split 1 (cons a b)) = (list (list a) b)
But we think a bit and we’re building up the first argument on the left and the way to build up lists that way is with CONS so we write down
(split 1 (cons a b)) = (list (cons a ()) b)
And then we think a bit and we think about what (split 0 l) is and we can write down for n>=1:
(split n+1 (cons a b)) = (list (cons a l1) l2) where (split n b) = (list l1 l2)
So let’s write that down in Lisp:
(defun split (n list)
(ecase (signum n)
(0 (list nil list))
(1 (if (cdr list)
(destructuring-bind (left right) (split (1- n) (cdr list))
(list (cons (car list) left) right))
(list nil nil)))))
The most idiomatic solution would be something like:
(defun split (n list)
(etypecase n
((eql 0) (list nil list))
(unsigned-integer
(loop repeat n for (x . r) on list
collect x into left
finally (return (list left r))))))
my task is to count all element within a list, which have duplicates, eg
( 2 2 (3 3) 4 (3)) will result in 2 (because only 2 and 3 have duplicates)
Searchdeep - just returns a nill if WHAT isn't find in list WHERE
Count2 - go through the single elements and sub-lists
If it finds atom he will use SEARCHDEEP to figure out does it have duplicates, then list OUT will be checked (to make sure if this atom was not already counted (e.g. like ( 3 3 3), which should return 1, not 2)
, increase counter and add atom to the OUT list.
However, i don't understand why, but it constantly returns only 1. I think it is some kind of logical mistake or wrong use of function.
My code is:
(SETQ OUT NIL)
(SETQ X (LIST 2 -3 (LIST 4 3 0 2) (LIST 4 -4) (LIST 2 (LIST 2 0 2))-5))
(SETQ count 0)
(DEFUN SEARCHDEEP (WHAT WHERE) (COND
((NULL WHERE) NIL)
(T (OR
(COND
((ATOM (CAR WHERE)) (EQUAL WHAT (CAR WHERE)))
(T (SEARCHDEEP WHAT (CAR WHERE)))
)
(SEARCHDEEP WHAT (CDR WHERE))
)
)
)
)
(DEFUN Count2 ( input)
(print input)
(COND
((NULL input) NIL)
(T
(or
(COND
((ATOM (CAR input))
(COND
(
(and ;if
(SEARCHDEEP (CAR INPUT) (CDR INPUT))
(NOT (SEARCHDEEP (CAR INPUT) OUT))
)
(and ;do
(Setq Count (+ count 1))
(SETQ OUT (append OUT (LIST (CAR INPUT))))
(Count2 (CDR input))
)
)
(t (Count2 (CDR input)))
)
)
(T (Count2 (CAR input)))
)
(Count2 (CDR input))
)
)
)
)
(Count2 x)
(print count)
First, your code has some big style issues. Don't write in uppercase (some, like myself, like to write symbols in uppercase in comments and in text outside of code, but the code itself should be written in lowercase), and don't put parentheses on their own lines. So the SEARCHDEEP function should look more like
(defun search-deep (what where)
(cond ((null where) nil)
(t (or (cond ((atom (car where)) (equal what (car where)))
(t (searchdeep what (car where))))
(searchdeep what (cdr where))))))
You also should not use SETQ to define variables. Use DEFPARAMETER or DEFVAR instead, although in this case you should not use global variables in the first place. You should name global variables with asterisks around the name (*X* instead of x, but use a more descriptive name).
For the problem itself, I would start by writing a function to traverse a tree.
(defun traverse-tree (function tree)
"Traverse TREE, calling FUNCTION on every atom."
(typecase tree
(atom (funcall function tree))
(list (dolist (item tree)
(traverse-tree function item))))
(values))
Notice that TYPECASE is more readable than COND in this case. You should also use the mapping or looping constructs provided by the language instead of writing recursive loops yourself. The (values) at the end says that the function will not return anything.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(traverse-tree (lambda (item)
(format t "~a " item))
tree))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
; No values
If you were traversing trees a lot, you could hide that function behind a DO-TREE macro
(defmacro do-tree ((var tree &optional result) &body body)
`(progn (traverse-tree (lambda (,var)
,#body)
,tree)
,result))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(do-tree (item tree)
(format t "~a " item)))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
;=> NIL
Using this, we can write a function that counts every element in the tree, returning an alist. I'll use a hash table to keep track of the counts. If you're only interested in counting numbers that will stay in a small range, you might want to use a vector instead.
(defun tree-count-elements (tree &key (test 'eql))
"Count each item in TREE. Returns an alist in
form ((item1 . count1) ... (itemn . countn))"
(let ((table (make-hash-table :test test)))
(do-tree (item tree)
(incf (gethash item table 0)))
(loop for value being the hash-value in table using (hash-key key)
collect (cons key value))))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(tree-count-elements tree))
;=> ((2 . 5) (-3 . 1) (4 . 2) (3 . 1) (0 . 2) (-4 . 1) (-5 . 1))
The function takes a keyword argument for the TEST to use with the hash table. For numbers or characters, EQL works.
Now you can use the standard COUNT-IF-function to count the elements that occur more than once.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(count-if (lambda (item)
(> item 1))
(tree-count-elements tree)
:key #'cdr))
;=> 3
I am working on program related to the different of dealing with even numbers in C and lisp , finished my c program but still having troubles with lisp
isprime function is defined and I need help in:
define function primesinlist that returns unique prime numbers in a lis
here what i got so far ,
any help with that please?
(defun comprimento (lista)
(if (null lista)
0
(1+ (comprimento (rest lista)))))
(defun primesinlist (number-list)
(let ((result ()))
(dolist (number number-list)
(when (isprime number)
( number result)))
(nreverse result)))
You need to either flatten the argument before processing:
(defun primesinlist (number-list)
(let ((result ()))
(dolist (number (flatten number-list))
(when (isprime number)
(push number result)))
(delete-duplicates (nreverse result))))
or, if you want to avoid consing up a fresh list, flatten it as you go:
(defun primesinlist (number-list)
(let ((result ()))
(labels ((f (l)
(dolist (x l)
(etypecase x
(integer (when (isprime x)
(push x result)))
(list (f x))))))
(f number-list))
(delete-duplicates (nreverse result))))
To count distinct primes, take the length of the list returned by primesinlist.
Alternatively, you can use count-if:
(count-if #'isprime (delete-duplicates (flatten number-list)))
It sounds like you've already got a primality test implemented, but for sake of completeness, lets add a very simple one that just tries to divide a number by the numbers less than it up to its square root:
(defun primep (x)
"Very simple implementation of a primality test. Checks
for each n above 1 and below (sqrt x) whether n divides x.
Example:
(mapcar 'primep '(2 3 4 5 6 7 8 9 10 11 12 13))
;=> (T T NIL T NIL T NIL NIL NIL T NIL T)
"
(do ((sqrt-x (sqrt x))
(i 2 (1+ i)))
((> i sqrt-x) t)
(when (zerop (mod x i))
(return nil))))
Now, you need a way to flatten a potentially nested list of lists into a single list. When approaching this problem, I usually find it a bit easier to think in terms of trees built of cons-cells. Here's an efficient flattening function that returns a completely new list. That is, it doesn't share any structure with the original tree. That can be useful, especially if we want to modify the resulting structure later, without modifying the original input.
(defun flatten-tree (x &optional (tail '()))
"Efficiently flatten a tree of cons cells into
a list of all the non-NIL leafs of the tree. A completely
fresh list is returned.
Examples:
(flatten-tree nil) ;=> ()
(flatten-tree 1) ;=> (1)
(flatten-tree '(1 (2 (3)) (4) 5)) ;=> (1 2 3 4 5)
(flatten-tree '(1 () () 5)) ;=> (1 5)
"
(cond
((null x) tail)
((atom x) (list* x tail))
((consp x) (flatten-tree (car x)
(flatten-tree (cdr x) tail)))))
Now it's just a matter of flatting a list, removing the number that are not prime, and removing duplicates from that list. Common Lisp includes functions for doing these things, namely remove-if-not and remove-duplicates. Those are the "safe" versions that don't modify their input arguments. Since we know that the flattened list is freshly generated, we can use their (potentially) destructive counterparts, delete-if-not and delete-duplicates.
There's a caveat when you're removing duplicate elements, though. If you have a list like (1 3 5 3), there are two possible results that could be returned (assuming you keep all the other elements in order): (1 3 5) and (1 5 3). That is, you can either remove the the later duplicate or the earlier duplicate. In general, you have the question of "which one should be left behind?" Common Lisp, by default, removes the earlier duplicate and leaves the last occurrence. That behavior can be customized by the :from-end keyword argument. It can be nice to duplicate that behavior in your own API.
So, here's a function that puts all those considerations together.
(defun primes-in-tree (tree &key from-end)
"Flatten the tree, remove elements which are not prime numbers,
using FROM-END to determine whether earlier or later occurrences
are kept in the list.
Examples:
(primes-in-list '(2 (7 4) ((3 3) 5) 6 7))
;;=> (2 3 5 7)
(primes-in-list '(2 (7 4) ((3 3) 5) 6 7) :from-end t)
;;=> (2 7 3 5)"
;; Because FLATTEN-TREE returns a fresh list, it's OK
;; to use the destructive functions DELETE-IF-NOT and
;; DELETE-DUPLICATES.
(delete-duplicates
(delete-if-not 'primep (flatten-tree list))
:from-end from-end))
I am trying to write a function which takes a list (x) and a number (y) and deletes every occurance of that number in the list. Ex. (deepdeleting '(0 0 1 2 0 3 0) 0) ===> '(1 2 3)
Here's what I have so far:
(define (deepdeleting x y)
(if (pair? x)
(if (eqv? (car x) y)
(begin
(set! x (cdr x))
(deepdeleting x y)
)
(deepdeleting (cdr x) y) ; else
)
x ; else
)
)
The code works, but my problem is I want it to modify the original list, not just return a new list. Right now this is what happens:
> (define list '(0 0 1 2 0 3 0))
> (deepdeleting list 0)
(1 2 3)
> list
(0 0 1 2 0 3 0) ; <<< I want this to be (1 2 3)
This seems strange to me since both the set-car! and set-cdr! functions seem to change the input list, whereas set! does not...
Any insight would be much appreciated!
When you use set! you are redefining the innermost binding:
(define test 10)
(set! test 11) ; changes global test to 11
(define (change-test value)
(set! test value))
(change-test 12) ; changes global test to 12
(define (change-test! value new-value)
(display value)
(set! value new-value) ; changes the local binding value
(display value))
(change-test! test 13) ; changes nothing outside of change-test, prints 12 then 13
Variable bindings are totally different than list structure mutation. Here a binding is used to point to a pair that is altered:
(define lst '(1 2 3))
(define lst2 (cdr lst)) ; lst2 shares structure with lst
(set-cdr! lst2 '(8 7 6 5))
lst2 ; ==> (2 8 7 6 5)
lst ; ==> (1 2 8 7 6 5) the original binding share structure thus is changed too
(set-cdr! lst lst) ; makes a circular never ending list (1 1 1 1 ...)
(eq? lst (cdr lst)) ;==> #t
(set-car! lst 2) ; changes lst to be never ending list (2 2 2 2 ...)
So you can mutate pairs with set-cdr! and set-car! and a binding to the original list will point to the first pair. Thus you need the result to start with the same pair as the first. With that you can make your mutating procedure this way:
#!r6rs
(import (rnrs) (rnrs mutable-pairs))
(define (remove! lst e)
(if (pair? lst)
(let loop ((prev lst)(cur (cdr lst)))
(if (pair? cur)
(if (eqv? (car cur) e)
(begin
(set-cdr! prev (cdr cur))
(loop prev (cdr cur)))
(loop cur (cdr cur)))
(if (eqv? (car lst) e)
(if (pair? (cdr lst))
(begin
(set-car! lst (cadr lst))
(set-cdr! lst (cddr lst)))
(error 'first-pair-error "Not possible to remove the first pair"))
#f)))
#f))
(define test '(0 0 1 2 0 3 0))
(define test2 (cdr test))
test2 ;==> (0 1 2 0 3 0)
(remove! test 0)
test ; ==> (1 2 3)
test2 ; ==> (0 1 2 0 3 0)
(remove! '(0) 0)
; ==> first-pair-error: Not possible to remove the first pair
(remove! '(1 2 3) 2) ; this works too but you have no way of checking
While lst is bound to the list during removal and the same list has one element less there was not binding to it outside of the remove! procedure so the result is forever lost.
EDIT
For R5RS remove the first two lines and add error:
;; won't halt the program but displays the error message
(define (error sym str)
(display str)
(newline))
I need a function that concatenates multiple values into (simple) vector, similar to (concatenate ). However, unlike concatenate, it should be able to handle arguments that are not vectors or sequences.
I.e. it should work like this:
(concat #(1 2) 3) => #(1 2 3)
(concat 1 2 3) => #(1 2 3)
(concat 1 #(2 3 4)) => #(1 2 3 4)
(concat #(1 2) 2 #(3 4 5)) => #(1 2 3 4 5)
How can I do this? I think I've forgotten some trivial lisp construct that makes it possible.
As far as I can tell, concatenate can't do it. and I'm not quite sure how to use make it with macro (there's ,# consturct that inserts list into resulting lisp form, but but I'm not quite sure how to distinguish between non-sequences and sequences in this case).
The reduce approach in the other reply is quadratic in time.
Here is a linear solution:
(defun my-concatenate (type &rest args)
(apply #'concatenate type
(mapcar (lambda (a) (if (typep a 'sequence) a (list a)))
args)))
Since we can compute the length of the sequence, we can allocate the result sequence and then copy the elements into it.
(defun concat (type &rest items)
(let* ((len (loop for e in items
if (typep e 'sequence)
sum (length e)
else sum 1))
(seq (make-sequence type len)))
(loop with pos = 0
for e in items
if (typep e 'sequence)
do (progn
(setf (subseq seq pos) e)
(incf pos (length e)))
else
do (progn
(setf (elt seq pos) e)
(incf pos)))
seq))
CL-USER 17 > (concat 'string "abc" #\1 "def" #\2)
"abc1def2"
Above works well for vectors. A version for lists is left as an exercise.
defun my-concatenate (type &rest vectors)
(reduce (lambda (a b)
(concatenate
type
(if (typep a 'sequence) a (list a))
(if (typep b 'sequence) b (list b))))
vectors))
You can use reduce with a little modification of #'concatenate on your arguments. If one of the arguments is not a sequence, just transform it into a list (concatenate works even with mixed arguments of simple-vectors and lists).
CL-USER> (my-concatenate 'list #(1 2 3) 3 #(3 5))
(1 2 3 3 3 5)
CL-USER> (my-concatenate 'simple-vector #(1 2 3) 3 #(3 5))
#(1 2 3 3 3 5)
CL-USER> (my-concatenate 'simple-vector 1 #(2 3) (list 4 5))
#(1 2 3 4 5)
EDIT: well, you should probably accept the other answer.