Mapcar and assoc - lisp

I would like to do:
(mapcar #'assoc '(a s) '((a . b) (c . d) (s . f)))
and have it return
((A . B) (S . F))
Which seems pretty reasonable, considering (assoc 'a '((a . b) (c . d) (s . f))) returns (A . B) and (assoc 's '((a . b) (c . d) (s . f))) returns (S . F). But alas it does not work:
*** - ASSOC: A is not a list
The following restarts are available:
ABORT :R1 Abort main loop
Any thoughts?

When used with two lists, mapcar applies the function pair-wise to the lists (and with three lists it applies them triple-wise etc.). So
(mapcar #'assoc '(a s) '((a . b) (c . d) (s . f)))
is the same as
( (assoc 'a (a . b)) (assoc 's (c . d)) )
(when used with lists of different length, mapcar uses the size of the smallest list). To get what you want, you should do:
(mapcar (lambda (x) (assoc x '((a . b) (c . d) (s . f)))) '(a s))

We need another list level. The second argument should be a list of assoc lists.
CL-USER > (mapcar #'assoc '(a s) '(((a . b) (c . d) (s . f))))
((A . B))
But the second argument is only one element long. Now we can use a trick and make it a circular list:
CL-USER > (mapcar #'assoc '(a s) '#1=(((A . B) (C . D) (S . F)) . #1#))
((A . B) (S . F))
If we construct a circular list for the second argument, then it works.
As a function:
(defun circular (list)
(if (null list)
list
(setf (cdr (last list)) list)))
CL-USER > (mapcar #'assoc '(a s) (circular '(((a . b) (c . d) (s . f)))))
((A . B) (S . F))

Related

LISP function to make all possible pairs from a list?

I'm trying to create a LISP function that creates from a list all possible pairs.
Example of what I'm trying to achieve: (a b c d) --> ((a b) (a c) (a d) (b c) (b d) (c d))
Any advice please? I'm not sure how to approach this problem
Here is a simple solution:
(defun make-couples (x l)
"makes a list of couples whose first element is x and the second is each element of l in turn"
(loop for y in l collect (list x y)))
(defun all-pairs (l)
"makes a list of all the possible pairs of elements of list l"
(loop for (x . y) on l nconc (make-couples x y)))
A recursive solution is:
(defun make-couples (x l)
"makes a list of couples whose first element is x and the second is each element of l in turn"
(if (null l)
nil
(cons (cons x (first l)) (make-couples x (rest l)))))
(defun all-pairs (l)
"makes a list of all the possible pairs of elements of list l"
(if (null l)
nil
(nconc (make-couples (first l) (rest l))
(all-pairs (rest l)))))
Here is a version (this is quite closely related to Gwang-Jin Kim's) which has two nice properties:
it is tail recursive;
it walks no list more than once;
it allocates no storage that it does not use (so there are no calls to append and so on);
it uses no destructive operations.
It does this by noticing that there's a stage in the process where you want to say 'prepend a list of pairs of this element with the elements of this list to this other list' and that this can be done without using append or anything like that.
It does return the results in 'reversed' order, which I believe is inevitable given the above constraints.
(defun all-pairs (l)
(all-pairs-loop l '()))
(defun all-pairs-loop (l results)
(if (null (rest l))
results
(all-pairs-loop (rest l)
(prepend-pairs-to (first l) (rest l) results))))
(defun prepend-pairs-to (e them results)
(if (null them)
results
(prepend-pairs-to e (rest them) (cons (list e (first them))
results))))
the simplest tail recursive variant without explicit loops / mapcar could also look like this:
(defun pairs (data)
(labels ((rec (ls a bs res)
(cond
((null ls) (nreverse res))
((null bs) (rec
(cdr ls)
(car ls)
(cdr ls)
res))
(t (rec
ls
a
(cdr bs)
(cons (cons a (car bs)) res))))))
(rec data nil nil nil)))
CL-USER> (pairs (list 1 2 3 4))
;; ((1 . 2) (1 . 3) (1 . 4) (2 . 3) (2 . 4) (3 . 4))
Tail call recursive solution:
(defun pairs (lst &key (acc '()))
(if (null (cdr lst))
(nreverse acc)
(pairs (cdr lst)
:acc (append (nreverse
(mapcar #'(lambda (el)
(list (car lst) el))
(cdr lst)))
acc))))
Both nreverses are there just for aesthetics (for a nicer looking output). They can be left out.
Try it with:
(pairs '(a b c d))
;; => ((A B) (A C) (A D) (B C) (B D) (C D))
General Combinations
(defun pair (el lst)
"Pair el with each element of lst."
(mapcar (lambda (x) (cons el x)) lst))
(defun dedup (lst &key (test #'eql))
"Deduplicate a list of lists by ignoring order
and comparing the elements by test function."
(remove-duplicates lst :test (lambda (x y) (null (set-difference x y :test test)))))
(defun comb (lst &key (k 3) (acc '()) (test #'eql))
"Return all unique k-mer combinations of the elements in lst."
(labels ((%comb (lst &key (k k) (acc '()) (test #'eql) (total lst))
(let ((total (if total total lst)))
(cond ((or (null (cdr lst)) (zerop k)) (nreverse acc))
((= k 1) (mapcar #'list lst))
(t (let* ((el (car lst))
(rst (remove-if (lambda (x) (funcall test x el)) total)))
(dedup (%comb (cdr lst)
:k k
:total total
:test test
:acc (append (pair el (comb rst :k (1- k) :test test))
acc)))))))))
(%comb lst :k k :acc acc :test test :total lst)))
The number of combinations are calculatable with the combinations formula:
(defun fac (n &key (acc 1) (stop 1))
"n!/stop!"
(if (or (= n stop) (zerop n))
acc
(fac (1- n) :acc (* acc n) :stop stop)))
(defun cnr (n r)
"Number of all r-mer combinations given n elements.
nCr with n and r given"
(/ (fac n :stop r) (fac (- n r))))
We can test and count:
(comb '(a b c d) :k 2)
;; => ((A D) (B D) (B A) (C D) (C B) (C A))
(comb '(a b c d e f) :k 3)
;; => ((B A F) (C B A) (C B F) (C A F) (D C A) (D C B)
;; => (D C F) (D B A) (D B F) (D A F) (E D A) (E D B)
;; => (E D C) (E D F) (E C A) (E C B) (E C F) (E B A)
;; => (E B F) (E A F))
(= (length (comb '(a b c d e f) :k 3)) (cnr 6 3)) ;; => T
(= (length (comb '(a b c d e f g h i) :k 6)) (cnr 9 6)) ;; => T

A list with their position via for loop in racket

(define ( addposition x )
(cond
[(empty? x) "empty list"]
[#t (for/list ([i x])
(list i (add1 (index-of x i))))]
))
(addposition (list 'a 'b 'c ))
it returns me '((a 1) (b 2) (c 3)), but I need the list like '(a 1 b 2 c 3)
As a bare minimum to get what you want you can throw that nested list to a (flatten) call:
> (flatten '((a 1) (b 2) (c 3)))
'(a 1 b 2 c 3)
But overall the idea to build mini lists with index-of and then flattening it is not the most performant. Nor will it be correct if your list contains duplicate values.
If we keep our own record of the next index, and using recursion instead of the otherwise handy for/list structure, we can build our list this way:
(define (add-positions xs [ind 0])
(if (null? xs)
xs
(append (list (first xs) ind)
(add-positions (rest xs) (add1 ind))
)))
(add-positions '(a b c d))
;=> '(a 0 b 1 c 2 d 3)
This can be expressed pretty naturally using map and flatten:
;;; Using map and flatten:
(define (list-pos xs (start 0))
(flatten (map (lambda (x y) (list x y))
xs
(range start (+ start (length xs))))))
Here map creates a list of lists, each containing one value from the input list and one value from a range list starting from start, and flatten flattens the result.
This seems more natural to me than the equivalent using for/list, but tastes may differ:
;;; Using for/list:
(define (list-pos xs (start 0))
(flatten (for/list ((x xs)
(p (range start (+ start (length xs)))))
(list x p))))
There are a lot of ways that you could write this, but I would avoid using append in loops. This is an expensive function, and calling append repeatedly in a loop is just creating unnecessary overhead. You could do this:
;;; Using Racket default arguments and add1:
(define (list-pos xs (pos 0))
(if (null? xs)
xs
(cons (car xs)
(cons pos (list-pos (cdr xs) (add1 pos))))))
Here the first element of the list and a position counter are added onto the front of the result with every recursive call. This isn't tail recursive, so you might want to add an accumulator:
;;; Tail-recursive version using inner define:
(define (list-pos xs (start 0))
(define (loop xs pos acc)
(if (null? xs)
(reverse acc)
(loop (cdr xs)
(add1 pos)
(cons pos
(cons (car xs) acc)))))
(loop xs start '()))
Because the intermediate results are collected in an accumulator, reverse is needed to get the final result in the right order.
You could (and I would) replace the inner define with a named let. Named let should work in Racket or Scheme; here is a Scheme version. Note that Scheme does not have default arguments, so an optional argument is used for start:
;;; Tail-recursive Scheme version using named let:
(define (list-pos xs . start)
(let loop ((xs xs)
(pos (if (null? start) 0 (car start)))
(acc '()))
(if (null? xs)
(reverse acc)
(loop (cdr xs)
(add1 pos)
(cons pos
(cons (car xs) acc))))))
All of the above versions have the same behavior:
list-pos.rkt> (list-pos '(a b c))
'(a 0 b 1 c 2)
list-pos.rkt> (list-pos '(a b c) 1)
'(a 1 b 2 c 3)
Here is a simple solution using for/fold
(define (addposition l)
(for/fold ([accum empty]) ([elem l])
(append accum elem)))
I love the for loops in Racket 😌
Note: As pointed out by ad absurdum, append is expensive here. So we can simply reverse first and then use cons to accumulate
(define (addposition l)
(for/fold ([accum empty]) ([elem (reverse l)])
(cons (first elem) (cons (second elem) accum))))
As others have pointed out, you can start by making a list of lists. Let's use a list comprehension:
> (for/list ([x '(a b c)]
[pos (in-naturals 1)])
(list x pos))
'((a 1) (b 2) (c 3))
Here, we iterate in parallel over two sets of data:
The list '(a b c)
The stream (in-naturals 1), which produces 1, 2, 3, ....
We combine them into lists with list, giving this structure:
'((a 1) (b 2) (c 3))
This is called "zipping", and using list comprehensions is a convenient way to do it in Racket.
Next, we want to flatten our list, so it ends up looking like this:
'(a 1 b 2 c 3)
However, you shouldn't use flatten for this, as it flattens not just the outermost list, but any sub-lists as well. Imagine if we had data like this, with a nested list in the middle:
> (flatten
(for/list ([x '(a (b c d) e)]
[pos (in-naturals 1)])
(list x pos)))
'(a 1 b c d 2 e 3)
The nested list structure got clobbered! We don't want that. Unless we have a good reason, we should preserve the internal structure of each element in the list we're given. We'll do this by using append* instead, which flattens only the outermost list:
> (append*
(for/list ([x '(a (b c d) e)]
[pos (in-naturals 1)])
(list x pos)))
'(a 1 (b c d) 2 e 3)
Now that we've got it working, let's put it into a function:
> (define (addposition xs)
(append*
(for/list ([x xs]
[pos (in-naturals 1)])
(list x pos))))
> (addposition '(a b c))
'(a 1 b 2 c 3)
> (addposition '(a (b c d) e))
'(a 1 (b c d) 2 e 3)
Looks good!

Association list in another association list

Is there any way to make something in lisp that can do like an association list in another association list, I tried :
(setq alist '((A . B) (B . C) (C . (D . E))))
but it gives :
((A . B) (B . C) (C D . E))
and then do a something like:
(assoc 'd (assoc 'c alist))
and i get this error:
Maximum error depth exceeded (22 nested errors) with
'The value C is not of type LIST.'.
((A . B) (B . C) (C . (D . E))) is not a nested assoc list.
((A . B)
(B . C)
(C . (D . E)) ; <- (d . e) is not an assoc list. Just one association.
)
You want to have a list of associations: ((d . e)).
Which makes it this solution:
CL-USER 5 > (assoc 'C '((A . B) (B . C) (C . ((D . E)))))
(C (D . E))
CL-USER 6 > (assoc 'd (cdr (assoc 'C '((A . B) (B . C) (C . ((D . E)))))))
(D . E)
Note that '(C . (D . E)) and (C D . E) are both lists of the same structure, just differently written:
CL-USER 8 > (equal '(C . (D . E)) '(C D . E))
T
I think i found it,
(setq alist '((A . B) (B . C) (C . ((D . E)))))
(assoc 'd ( cdr ( assoc 'c alist))) => (D . E)

how to map an element in a list to a value from other list in LISP

I am new to lisp programming and i am trying to think about the below operation.
(extract '(0 1 0) '(a b c)) give us '(a b a)
(extract '(1 1 1 ) '(a b c)) gives us '(b b b)
how can i think about this and how to solve it.
As Chris Jester-Young described, it just returns elements from second list at indexes in first list. Writing such a function is very easy:
(defun extract (list-1 list-2)
(mapcar (lambda (n) (nth n list-2)) list-1))
CL-USER>(extract '(0 1 0) '(a b c))
(A B A)
CL-USER>(extract '(1 1 1 ) '(a b c))
(B B B)
If there no such index, it'll give you NIL in that place.
CL-USER> (extract '(1 100 1 ) '(a b c))
(B NIL B)
But this won't work on nested structures (trees). If you want it to return elements of list-2 shaped in the structure of list-1, you can use a simple maptree helper function, then do the same thing:
(defun maptree (fn tree)
(cond
((null tree) tree)
((atom tree) (funcall fn tree))
(t (cons
(maptree fn (first tree))
(maptree fn (rest tree))))))
(defun extract* (list-1 list-2)
(maptree (lambda (n)
(nth n list-2)) list-1))
CL-USER> (extract* '(3 (2 1 (0))) '(a b c d))
(D (C B (A)))
(extract a b) returns a copy of a where each element is replaced by the element of b in that position.

How to do ((A.B).(C.D)) in lisp

I'm trying to figure out how to do this using cons:
((A . B) . (C . D))
where (A . B) and (C . D) are in each cons cell
I've tried doing this (cons (cons 'a 'b) (cons 'c 'd)) but it gives me this:
((A.B) C . D)
I also tried this: (cons (cons 'a 'b) (cons (cons 'c 'd) ())) but it gives me this:
((A . B) (C . D))
Any idea how to achieve this?
The first one is what you want. They're equivalent. You can verify like this:
1 ]=> (cons (cons 'a 'b) (cons 'c 'd))
;Value 11: ((a . b) c . d)
1 ]=> (car (cons (cons 'a 'b) (cons 'c 'd)))
;Value 12: (a . b)
1 ]=> (cdr (cons (cons 'a 'b) (cons 'c 'd)))
;Value 13: (c . d)
Remember a list is a cons cell. The "car" is the head element of the list or the first half of the cons cell, and the cdr is the rest of the list, or the second element of the cons cell.
Another way to verify that they're equivalent:
1 ]=> '((a . b) . (c . d))
;Value 14: ((a . b) c . d)
Just look at what you get back when you enter in a literal ((A . B) . (C . D)):
* '((a . b) . (c . d))
((A . B) C . D)
There is a defined algorithm the Lisp printer uses to print out data structures built from pairs. Basically, you can't ever get a cons to be printed as a dotted pair inside parentheses when it is the CDR of another cons.
However, it is possible to re-configure the printer so that you get the behavior you are seeking, via SET-PPRINT-DISPATCH:
(set-pprint-dispatch 'cons
(lambda (stream object)
(format stream "(~W . ~W)" (car object) (cdr object))))
* '((a . b) . (c . d))
((A . B) . (C . D))
* (cons (cons 'a 'b) (cons 'c 'd)) ;The same object
((A . B) . (C . D))
Although in spite of that it would frankly be better in the long run if you got comfortable with reading the default behavior.
I'm not quite sure what you mean... I agree with the above comment that the last line of your code resembles the first, which you are matching against.
Here's a decent general resource for you anyhow: http://www-2.cs.cmu.edu/~dst/LispBook/
What you're looking for isn't possible because of how lists are represented in Lisp. When you create a list, you are creating a series of cons cells, where the car of the cell is the value of that element in the list, and the cdr is a reference to the next cons cell. Your desired cell, ((A . B) . (C . D)) means "create a cons cell where the car is (A . B) and the cdr is (C . D)". That is equivalent to a list where the first element is (A . B), second element is C and the tail of the list is D, or ((A . B) C . D).