Lisp/Intersection of Lists - lisp

Hello i am trying to create a function in common-lisp that takes two lists, and output their intersections, assuming there is no repetition in each list without using intersection function. It seems that it is not working. Can anyone help?
(defun isect (lst_1 lst_2)
(setq newlist nil)
(dolist (x lst_1 newlist)
(dolist (y lst_2)
(if (equal x y) (setf newlist (append newlist x)))
)
)
)

I assume isect with both arguments being the same list should return an equal list and not one that is flattened. In that case (append newlist x) is not adding an element to the end of a list. Here is my suggestion:
(defun intersect (lst-a lst-b &aux result)
(dolist (a lst-a (nreverse result))
(dolist (b lst-b)
(when (equal a b)
(push a result)))))
This is O(n^2) while you can do it in O(n) using a hash table.

A built-in way (that won't work for homeworks ;) ) is to use intersection: https://lispcookbook.github.io/cl-cookbook/data-structures.html#intersection-of-lists
What elements are both in list-a and list-b ?
(defparameter list-a '(0 1 2 3))
(defparameter list-b '(0 2 4))
(intersection list-a list-b)
;; => (2 0)

If you can ensure that the lists are sorted (ascending) you could do something like
(defun isect (l1 l2 acc)
(let ((f1 (car l1))
(f2 (car l2))
(r1 (cdr l1))
(r2 (cdr l2)))
(cond ((or (null l1) (null l2)) acc)
((= f1 f2) (isect r1 r2 (cons f1 acc)))
((< f1 f2) (isect r1 l2 acc))
((> f1 f2) (isect l1 r2 acc)))))
Note though, that the result is in reversed order. Also, the example assumes that the
elements are numbers. If you wanted to generalize, you could pass an ordering as an optional argument to make it work with arbitrary elements.
NB: A solution using loop would likely be faster but I could not think of how to partially "advance" the lists when the cars are different.

;; the key function for simple lists
(defun id (x) x)
;; the intersect function for two lists
;; with sorting included:
;; you need an equality-test:
;; default is #'eql (for simple numbers or symbols this is sufficient)
;; - for numbers only #'=
;; - for characters only #'char=
;; - for strings only #'string=
;; - for lists #'equal
;; - for nearly everything #'equalp (case insensitive for char/strings!)
;; then you need also a sorting tester:
;; - increasing number: #'<
;; - decreasing number: #'>
;; - increasing char: #'char<
;; - decreasing char: #'char>
;; - increasing strings: #'string<
;; - decreasing strings: #'string>
;; - other cases I haven't think of - does somebody have an idea?
;; (one could sort by length of element etc.)
;; so sort-test should be a diadic function (function taking 2 arguments to compare)
;; then you also need an accessor function
;; so, how withing each element the to-be-sorted element should be accessed
;; for this, I prepared the `id` - identity - function because this is the
;; sort-key when simple comparison of the elements of the two lists
;; should be compared - and this function is also used for testing
;; for equality in the inner `.isect` function.
(defun isect (lst-1 lst-2 &key (equality-test #'eql) (sort-test #'<) (sort-key #'id))
(let ((lst-1-sorted (stable-sort lst-1 sort-test :key sort-key))
(lst-2-sorted (stable-sort lst-2 sort-test :key sort-key)))
(labels ((.isect (l1 l2 acc)
(cond ((or (null l1) (null l2)) (nreverse acc))
(t (let ((l1-element (funcall sort-key (car l1)))
(l2-element (funcall sort-key (car l2))))
(cond ((funcall sort-test l1-element l2-element)
(.isect (cdr l1) l2 acc))
((funcall equality-test l1-element l2-element)
(.isect (cdr l1) (cdr l2) (cons (car l1) acc)))
(t (.isect l1 (cdr l2) acc))))))))
(.isect lst-1-sorted lst-2-sorted '()))))
Simple tests:
(isect '(0 1 2 3 4 5 6) '(9 0 3 5 12 24 8 6))
;; => (0 3 5 6)
(isect '(#\a #\c #\h #\t #\e #\r #\b #\a #\h #\n)
'(#\a #\m #\s #\e #\l #\s #\t #\a #\r)
:equality-test #'char=
:sort-test #'char<
:key #'id)
;; => (#\a #\a #\e #\r #\t)
(isect '("this" "is" "just" "a" "boring" "test")
'("this" "boring" "strings" "are" "to" "be" "intersected")
:equality-test #'string=
:sort-test #'string<
:key #'id)
;; => ("boring" "this")

Related

Generate TYPECASE with macro in Common Lisp

I have a list of two element sublists which will change and grow in the course of the program. I want to write a macro which takes a key and generates a case dynamically like:
;; This is the List for saving CASE clauses
(setf l '((number 2) (symbol 3)))
;; and i want to have the following expansion
(typecase 'y
(number 2)
(symbol 3))
I could have a macro which only refers to the global l:
(defmacro m (x)
`(typecase ,x ,#l))
which would expand correctly
(m 'y) ;expands to (TYPECASE 'Y (number 2) (symbol 3))
But how can i write the macro with a parameter for the list l so that it would work with other lists as well?
;; A macro which should generate the case based on the above list
(defmacro m (x l)
`(typecase ,x ,#l))
This doesn't work since l in the arguments list i a symbol and a call to (m 'y l) will expand to (TYPECASE 'Y . L).
Wanting to adhere to typecase mechanism, my workaround was as follows:
(setf types-x '(((integer 0 *) 38)
((eql neli) "Neli in X")
(symbol 39))
)
(setf types-y '(((eql neli) "Neli in Y")
((array bit *) "A Bit Vector")))
(defmacro m (x types-id)
(case types-id
(:x `(typecase ,x ,#types-x))
(:y `(etypecase ,x ,#types-y))))
(m 'neli :x) ;"Neli in X"
(m 'neli :y) ;"Neli in Y"
(m 'foo :x) ;39
Any hints and comments is appreciated.
You don't need a macro for what you're trying to do: use a function.
For instance, given
(defvar *type-matches*
'((float 0)
(number 1)
(t 3)))
Then
(defun type-match (thing &optional (against *type-matches*))
(loop for (type val) in against
when (typep thing type)
return (values val type)
finally (return (values nil nil))))
Will match a thing against a type:
> (type-match 1.0)
0
float
> (type-match 1)
1
number
You want to keep the variables sorted by type, which you can do by, for instance:
(setf *type-matches* (sort *type-matches* #'subtypep :key #'car))
You want to keep the matches sorted of course.
If you want to delay the execution of the forms then you can do something like this (this also deals with sorting the types):
(defvar *type-matches*
'())
(defmacro define-type-match (type/spec &body forms)
;; define a type match, optionally in a specified list
(multiple-value-bind (type var)
(etypecase type/spec
(symbol (values type/spec '*type-matches*))
(cons (values (first type/spec) (second type/spec))))
(let ((foundn (gensym "FOUND")))
`(let ((,foundn (assoc ',type ,var :test #'equal)))
(if ,foundn
(setf (cdr ,foundn) (lambda () ,#forms))
(setf ,var (sort (acons ',type (lambda () ,#forms) ,var)
#'subtypep :key #'car)))
',type/spec))))
(defun type-match (thing &optional (against *type-matches*))
(loop for (type . f) in against
when (typep thing type)
return (values (funcall f) type)
finally (return (values nil nil))))
The actual problem that you face is that if you do
(setf l '((number 2) (symbol 3)))
already on toplevel, if you evaluate l, you don't come further than
((number 2) (symbol 3))
So if you use l in a macro as an argument, you can't come further
than this. But what you need is to evaluate this form (modified after adding a typecase and an evaluated x upfront) once more within the macro.
This is, why #tfb suggested to write a function which actually evaluates the matching of the types specified in l.
So, we could regard his type-match function as a mini-interpreter for the type specifications given in l.
If you do a simple (defmacro m (x l) `(typecase ,x ,#l))
you face exactly that problem:
(macroexpand-1 '(m 1 l))
;; (typecase 1 . l)
but what we need is that l once more evaluated.
(defmacro m (x l)
`(typecase ,x ,#(eval l)))
Which would give the actually desired result:
(macroexpand-1 '(m 1 l))
;; (TYPECASE 1 (NUMBER 2) (SYMBOL 3)) ;
;; T
;; and thus:
(m 1 l) ;; 2
So far, it seems to work. But somewhere in the backhead it becomes itchy, because we know from books and community: "Don't use eval!! Eval in the code is evil!"
Trying around, you will find out when it will bite you very soon:
# try this in a new session:
(defmacro m (x l) `(typecase ,x ,#(eval l)))
;; m
;; define `l` after definition of the macro works:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m 1 l)
;; 2 ;; so our `eval` can handle definitions of `l` after macro was stated
(m '(1 2) l)
;; NIL
;; even redefining `l` works!
(setf l '((number 2) (symbol 3) (list 4)))
;; ((NUMBER 2) (SYMBOL 3) (LIST 4))
(m 1 l)
;; 2
(m '(1 2) l)
;; 4 ;; and it can handle re-definitions of `l` correctly.
;; however:
(let ((l '((number 2) (symbol 3)))) (m '(1 2) l))
;; 4 !!! this is clearly wrong! Expected is NIL!
;; so our `eval` in the macro cannot handle scoping correctly
;; which is a no-go for usage!
;; but after re-defining `l` globally to:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m '(1 2) l)
;; NIL ;; it behaves correctly
(let ((lst '((number 2) (symbol 3) (list 4)))) (m '(1 2) lst))
;; *** - EVAL: variable LST has no value
;; so it becomes clear: `m` is looking in the scoping
;; where it was defined - the global scope (the parent scope of `m` when `m` was defined or within the scope of `m`).
So the conclusion is:
The given macro with eval is NOT working correctly!!
Since it cannot handle local scoping.
So #tfb's answer - writing a mini-evaluator-function for l is the probably only way to handle this in a proper, safe, correct way.
Update
It seems to me that doing:
(defmacro m (x l)
`(typecase ,x ,#l))
(defun m-fun (x l)
(eval `(m ,x ,l)))
(m-fun ''y l) ;; 3
(m-fun 'y l) ;; error since y unknown
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun ''(1 2) l)) ;; => 4 since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''(1 2) l)) ;; => NIL since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''y l)) ;; => 3 since it is a symbol
(let ((n 12))
(m-fun n l)) ;; => 2 since it is a number
;; to improve `m-fun`, one could define
(defun m-fun (x l)
(eval `(m ',x ,l)))
;; then, one has not to do the strangely looking double quote
;; ''y but just one quote 'y.
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun '(1 2) l)) ;; => 4 since it is a list
;; etc.
at least hides the eval within a function.
And one does not have to use backquote in the main code.
Macro expansion happens at compile time, not run time, thus if the case clause list changes over the course of the program, the macro expansion will not change to reflect it.
If you want to dynamically select an unevaluated but changeable value, you can use assoc in the expansion instead of case:
(defmacro m (x l)
`(second (assoc ,x ,l)))
Sample expansion:
(m x l)
->
(SECOND (ASSOC X L))
Output of (assoc x l) with the value of l in your question and x = 'x:
(let ((x 'x))
(m x l))
->
2
However if you did decide to do it this way, you could simplify things and replace the macro with a function:
(defun m (x l)
(second (assoc x l)))
UPDATE FOR QUESTION EDIT:
Replace assoc as follows:
(defun m (x l)
(second (assoc-if (lambda (type)
(typep x type))
l)))

Check for proper list in Common Lisp

Is there a standard function in Common Lisp that can check against improper lists (i.e. circular and dotted lists) without signaling an error? list-length can check against circular lists (it returns nil for them), but signals type-error when given a dotted list.
Scheme's list? traverses the whole list to make sure it is not dotted or circular; Common Lisp's listp only checks that it's given nil or a cons cell.
Here's the simplest I could come up with:
(defun proper-list-p (x)
(not (null (handler-case (list-length x) (type-error () nil)))))
Since several implementations have been suggested and many unexpected problems have been found, here's a test suite for aspiring proper-list-p writers:
(defun circular (xs)
(let ((xs (copy-list xs)))
(setf (cdr (last xs)) xs)
xs))
(assert (eql t (proper-list-p '())))
(assert (eql t (proper-list-p '(1))))
(assert (eql t (proper-list-p '(1 2))))
(assert (eql t (proper-list-p '(1 2 3))))
(assert (not (proper-list-p 1)))
(assert (not (proper-list-p '(1 . 2))))
(assert (not (proper-list-p '(1 2 . 3))))
(assert (not (proper-list-p '(1 2 3 . 4))))
(assert (not (proper-list-p (circular '(1)))))
(assert (not (proper-list-p (circular '(1 2)))))
(assert (not (proper-list-p (circular '(1 2 3)))))
(assert (not (proper-list-p (list* 1 (circular '(2))))))
(assert (not (proper-list-p (list* 1 2 (circular '(3 4))))))
There is no standard function to do this, perhaps because such a function was seen as rather expensive if it was to be correct, but, really, this just seems like am omission from the language to me.
A minimal (not very performant) implementation, which does not rely on handling errors (Python people think that's a reasonable way to program, I don't, although this is a stylistic choice), is, I think
(defun proper-list-p (l)
(typecase l
(null t)
(cons
(loop for tail = l then (cdr tail)
for seen = (list tail) then (push tail seen)
do (cond ((null tail)
(return t))
((not (consp tail))
(return nil))
((member tail (rest seen))
(return nil)))))))
This takes time quadratic in the length of l, and conses proportional to the length of l. You can obviously do better using an hashtable for the occurs check, and you can use a tortoise-&-hare algorithm do avoid the occurs check (but I'm not sure what the complexity of that is off the top of my head).
I am sure there are much better functions than this in libraries. In particular Alexandria has one.
While thinking about this question, I also wrote this function:
(defun classify-list (l)
"Classify a possible list, returning four values.
The first value is a symbol which is
- NULL if the list is empty;
- LIST if the list is a proper list;
- CYCLIC-LIST if it contains a cycle;
- IMPROPER-LIST if it does not end with nil;
- NIL if it is not a list.
The second value is the total number of conses in the list (following
CDRs only). It will be 0 for an empty list or non-list.
The third value is the cons at which the cycle in the list begins, or
NIL if there is no cycle or the list isn't a list.
The fourth value is the number if conses in the cycle, or 0 if there is no cycle.
Note that you can deduce the length of the leading element of the list
by subtracting the total number of conses from the number of conses in
the cycle: you can then use NTHCDR to pull out the cycle."
;; This is written as a tail recursion, I know people don't like
;; that in CL, but I wrote it for me.
(typecase l
(null (values 'null 0 nil 0 0))
(cons
(let ((table (make-hash-table)))
(labels ((walk (tail previous-tail n)
(typecase tail
(null
(values 'list n nil 0))
(cons
(let ((m (gethash tail table nil)))
(if m
(values 'cyclic-list n tail (- n m))
(progn
(setf (gethash tail table) n)
(walk (cdr tail) tail (1+ n))))))
(t
(values 'improper-list n previous-tail 0)))))
(walk l nil 0))))
(t (values nil 0 nil 0))))
This can be used to get a bunch of information about a list: how long it is, if it is proper, if not if it's cyclic, and where the cycle is. Beware that in the cases of cyclic lists this will return circular structure as its third value. I believe that you need to use an occurs check to do this – tortoise & hare will tell you if a list is cyclic, but not where the cycle starts.
in addition, something slightly less verbose, than the accepted answer:
(defun improper-tail (ls)
(do ((x ls (cdr x))
(visited nil (cons x visited)))
((or (not (consp x)) (member x visited)) x)))
(defun proper-list-p (ls)
(null (improper-tail ls)))
or just like this:
(defun proper-list-p (ls)
(do ((x ls (cdr x))
(visited nil (cons x visited)))
((or (not (consp x)) (member x visited)) (null x))))
seen to pass all the op's test assertions
After our hopeless attempts with tailp, here, sth which uses the
sharp-representation of circular lists :) .
With regex (to detect circular sublist)
(setf *print-circle* t)
(ql:quickload :cl-ppcre)
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (cl-ppcre::scan "#\d+=(" (princ-to-string lst)))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
Without regex (cannot detect circular sublists)
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (string= "#" (subseq (princ-to-string lst) 0 1))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
(tailp l (cdr l)) is t for circular lists but nil for non-circular lists.
Credits to #tfp and #RainerJoswig who taught me this here .
So, your function would be:
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (tailp lst (cdr lst))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
By the way, I use proper-listp by purpose. Correct would be - by convetion proper-list-p. However, this name is already occupied in the CLISP implementation by SYSTEM::%PROPER-LIST-Pwhy the definition of the function raises a continuable error.
Conclusion of our discussion in the comment section:
The behavior of tailp for circular lists is undefined. Therefore this answer is wrong! Thank you #Lassi for figuring this out!

Simplify symbolic expressions

I am new in Lisp and i need some help.
I need to simplify next expressions:
from (+ (+ A B) C) to (+ A B C)
and from (- (- A B) C) to (- A B C).
If you could help me with one of them I'll understand how i need to do this to the next one.
Thanks a lot.
Assuming you have an input that matches this pattern, (+ e1 ... en), you want to recursively simplify all e1 to en, which gives you s1, ..., sn, and then extract all the si that start with a + to move their arguments one level up, to the simplified expression you are building.
An expression e matches the above pattern if (and (consp e) (eq '+ (car e))).
Then, all the ei are just given by the list that is (cdr e).
Consider the (+) case, how could you simplify it?
To apply a function f to a list of values, call (mapcar #'f list).
To split a list into two lists, based on a predicate p, you might use a loop:
(let ((sat nil) (unsat nil))
(dolist (x list (values sat unsat))
(if (funcall predicate x)
(push x sat)
(push x unsat))))
There is a purely functional way to write this, can you figure it out?
Here is a trivial simplifier written in Racket, with an implementation of a rather mindless simplifier for +. Note that this is not intended as anything serious: it's just what I typed in when I was thinking about this question.
This uses Racket's pattern matching, probably in a naïve way, to do some of the work.
(define/match (simplify expression)
;; simplifier driver
(((cons op args))
;; An operator with some arguments
;; Note that this assumes that the arguments to operators are always
;; expressions to simplify, so the recursive level can be here
(simplify-op op (map simplify args)))
((expr)
;; anything else
expr))
(define op-table (make-hash))
(define-syntax-rule (define-op-simplifier (op args) form ...)
;; Define a simplifier for op with arguments args
(hash-set! op-table 'op (λ (args) form ...)))
(define (simplify-op op args)
;; Note the slightly arcane fallback: you need to wrap it in a thunk
;; so hash-ref does not try to call it.
((hash-ref op-table op (thunk (λ (args) (cons op args)))) args))
(define-op-simplifier (+ exprs)
;; Simplify (+ ...) by flattening + in its arguments
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
`(+ ,#(reverse results))
(loop (rest ftail)
(match (first ftail)
[(cons '+ addends)
(append (reverse addends) results)]
[expr (cons expr results)])))))
It is possible to be more aggressive than this. For instance we can coalesce runs of literal numbers, so we can simplify (+ 1 2 3 a 4) to
(+ 6 a 4) (note it is not safe in general to further simplify this to (+ 10 a) unless all arithmetic is exact). Here is a function which does this coalescing for for + and *:
(define (coalesce-literal-numbers f elts)
;; coalesce runs of literal numbers for an operator f.
;; This relies on the fact that (f) returns a good identity for f
;; (so in particular it returns an exact number). Thisis true for Racket
;; and CL and I think any Lisp worth its salt.
;;
;; Note that it's important here that (eqv? 1 1.0) is false.
;;;
(define id (f))
(let loop ([tail elts]
[accum id]
[results '()])
(cond [(null? tail)
(if (not (eqv? accum id))
(reverse (cons accum results))
(reverse results))]
[(number? (first tail))
(loop (rest tail)
(f accum (first tail))
results)]
[(eqv? accum id)
(loop (rest tail)
accum
(cons (first tail) results))]
[else
(loop (rest tail)
id
(list* (first tail) accum results))])))
And here is a modified simplifier for + which uses this. As well as coalescing it notices that (+ x) can be simplified to x.
(define-op-simplifier (+ exprs)
;; Simplify (+ ...) by flattening + in its arguments
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
(let ([coalesced (coalesce-literal-numbers + (reverse results))])
(match coalesced
[(list something)
something]
[exprs
`(+ ,#exprs)]))
(loop (rest ftail)
(match (first ftail)
[(cons '+ addends)
(append (reverse addends) results)]
[expr (cons expr results)])))))
Here is an example of using this enhanced simplifier:
> (simplify 'a)
'a
> (simplify 1)
1
> (simplify '(+ 1 a))
'(+ 1 a)
> (simplify '(+ a (+ b c)))
'(+ a b c)
> (simplify '(+ 1 (+ 3 c) 4))
'(+ 4 c 4)
> (simplify '(+ 1 2 3))
6
For yet more value you can notice that the simplifier for * is really the same, and change things to this:
(define (simplify-arith-op op fn exprs)
(let loop ([ftail exprs]
[results '()])
(if (null? ftail)
(let ([coalesced (coalesce-literal-numbers fn (reverse results))])
(match coalesced
[(list something)
something]
['()
(fn)]
[exprs
`(,op ,#exprs)]))
(loop (rest ftail)
(match (first ftail)
[(cons the-op addends)
#:when (eqv? the-op op)
(append (reverse addends) results)]
[expr (cons expr results)])))))
(define-op-simplifier (+ exprs)
(simplify-arith-op '+ + exprs))
(define-op-simplifier (* exprs)
(simplify-arith-op '* * exprs))
And now
(simplify '(+ a (* 1 2 (+ 4 5)) (* 3 4) 6 (* b)))
'(+ a 36 b)
Which is reasonably neat.
You can go further than this, For instance when coalescing numbers for an operator you can simply elide sequences of the identity for that operator: (* 1 1 a 1 1 b) can be simplified to (* a b), not (* 1 a 1 b). It may seem silly to do that: who would ever write such an expression, but they can quite easily occur when simplifying complicated expressions.
There is a gist of an elaborated version of this code. It may still be buggy.

Two common elements between lists

I have a problem with this function two-similar-p.
(defun two-similar-p (list1 list2)
(mapcar
(lambda (e)
(mapcar
(lambda (e1)
(if (equal e e1) t))
list2))
list1))
But is not correct use mapcar because this function returns a new list with T or NIL, but I need only to return a true or false.
ex.
(two-similar-p '(2 1 3) '(1 2 3))
==> ((NIL T NIL) (T NIL NIL) (NIL NIL T))
I was thinking to use recursion to compare the various elements, but I have no idea how to do that.
My function needs to work like:
(two-similar-p '(1 2 3) '(1 4 5)) ; ==> nil
(two-similar-p '(1 2 5) '(1 4 5)) ; ==> t
(two-similar-p '(1 2 6) '(6 4 2)) ; ==> t
Any advice?
The easiest "off-the-shelf" solution is to check that the intersection contains at least two elements:
(defun two-similar-p (l1 l2)
(consp (cdr (intersection l1 l2 :test #'equal))))
A slightly less OTS solution is to use hash tables:
(defun two-similar-p (l1 l2)
(let ((h1 (make-hash-table :test 'equal))
(common 0))
(dolist (x l1)
(setf (gethash x h1) t))
(dolist (x l2)
(when (gethash x h1)
(incf common))
(when (>= common 2)
(return t)))))
The advantage of the second approach is that its complexity is O(len(l1) + len(l2)),
while the mapcar approach will be O(len(l1) * len(l2)).
The standard does not specify the complexity of intersection and friends, but most implementations take good care of their users here (IOW, the complexity will be linear, not quadratic).

Mapcar in-place: destructively modify a list of lists

I have a list of lists: (setq xs (list (list 1 2 3) (list 4 5 6) (list 7 8 9))). I want to remove a first element from each list to get ((2 3) (5 6) (8 9)). It's easy to do it non-destructively: (mapcar 'cdr xs). But I want mutate the original list. I tried:
(mapcar (lambda (x) (setf x (cdr x))) xs)
(mapcar (lambda (x) (pop x)) xs)
But it doesn't work. How to change each list of xs variable in-place, without creating any temporary lists, as efficiently as possible?
Use MAP-INTO:
CL-USER 16 > (let ((s (list (list 1 2 3)
(list 4 5 6)
(list 7 8 9))))
(map-into s #'rest s))
((2 3) (5 6) (8 9))
#Rainer Joswig's answer is correct, use map-into. The link gives example implementation using loop macro. If you want to implement map-into from scratch, or you use Emacs Lisp, you can also do it using dotimes. In Emacs Lisp dotimes is implemented in subr.el and doesn't require CL package. This is map-into with 1 sequence to map into the result sequence:
(defun map-into (r f xs)
(dotimes (i (min (length r) (length xs)) r)
(setf (elt r i)
(funcall f (elt xs i)))))
For version with variable amount of sequences we must sprinkle our code with apply and mapcar:
(defun map-into (r f &rest xss)
(dotimes (i (apply 'min (length r) (mapcar 'length xss)) r)
(setf (elt r i)
(apply f (mapcar (lambda (s) (elt s i))
xss)))))
We see, however, that elt inside dotimes makes our algorithm work in O(n2). We can optimize it to work in O(n) by using mapl (thanks #Joshua Taylor).
(defun map-into (rs f xs)
(mapl (lambda (r x) (setf (car r) (funcall f (car x)))) rs xs))
(defun map-into (rs f &rest xss)
(mapl (lambda (r xs)
(setf (car r)
(apply f (car xs))))
rs
(apply 'mapcar 'list xss))) ;; transpose a list of lists
The reason setf doesn't work inside mapcar is that setf is a complex macro that expands into expression that can manipulate the data it mutates. In a lambda scope inside mapcar it has access only to a variable, local to this lambda, not to the sequence passed to mapcar itself, so how should it know, where to put a modified value back? That's why mapcar code in the question returns modified list of lists but doesn't mutate it in-place. Just try (macroexpand '(setf (elt xs 0) (funcall 'cdr (elt xs 0)))) and see for yourself.