I'm making a recursive lisp function that takes two lists and makes a sublist of index pairs
ex: put in (A B C D) and (1 2 3 4) and get ((1 A) (2 B) (3 C) (4 D))
However, I'm having trouble using car along with cons to make said sublist. Here's my code:
(DEFUN zipper (a b)
(if (= (OR (list-length a) (list-length b)) 0)
(setq c NIL)
(progn (zipper (cdr a) (cdr b))
(cons '((car a) (car b)) c))
)
)
I played around for a little and it appears using car to create lists just doesn't work most of the time. Additionally, I'm using CLISP. Any ideas?
Thanks!
The general idea goes into the right direction. There are a bunch of problems, though. Let's have a look.
(DEFUN zipper (a b)
(if (= (OR (list-length a) (list-length b)) 0)
(setq c NIL)
(progn (zipper (cdr a) (cdr b))
(cons '((car a) (car b)) c))
)
)
First indentation:
(DEFUN zipper (a b)
(if (= (OR (list-length a) (list-length b)) 0)
(setq c NIL)
(progn (zipper (cdr a) (cdr b))
(cons '((car a) (car b)) c)) ; <--
)
)
Next dangling parentheses:
(DEFUN zipper (a b)
(if (= (OR (list-length a) (list-length b)) 0)
(setq c NIL)
(progn (zipper (cdr a) (cdr b))
(cons '((car a) (car b)) c))))
Return the empty list in IF for the true case:
(defun zipper (a b)
(if (= (OR (list-length a) (list-length b)) 0)
nil
(progn (zipper (cdr a) (cdr b))
(cons '((car a) (car b)) c))))
Now cons to the result in the false case:
(defun zipper (a b)
(if (= (OR (list-length a) (list-length b)) 0)
nil
(cons '((car a) (car b))
(zipper (cdr a) (cdr b)))))
What remains to be done?
see the comment by 'rsm': replace the quote with a call to list.
don't use list-length. Use null instead. It checks if a list is empty. list-length would traverse the input whole lists on each call -> inefficient.
If you call list-length at each step of recursion, you are going to traverse both lists entirely each time, which gives your zipper function a quadratic time complexity with respect to the sum of your lists' sizes:
(zipper '(1 2 3) '(4 5 6))
=> (list-length (1 2 3))
=> (list-length (2 3))
=> (list-length (3))
=> (list-length ())
=> (list-length (4 5 6))
=> (list-length (4 5))
=> (list-length (5))
=> (list-length ())
(zipper '(2 3) '(5 6))
=> (list-length (2 3))
...
=> (list-length (5 6))
...
...
This is inefficient and not necessary here. Since you are already visiting both lists, you can directly check if any of them is empty using null or endp, which take constant time. You return NIL as soon as one of the list is empty, which is by the way the default behaviour of mapcar. Notice also that mapcar can work on multiple lists at the same time, for example:
(mapcar #'+ '(1 2) '(5 8))
=> (6 10)
If you know a function that takes (at least) two arguments and return a list, then you could mapcar that function over your lists and have a list of lists.
The zip function from other languages such as Python and Haskell is a special case of mapcar.
The traditional zip function can be achieved via:
> (mapcar #'list list1 list2 ... listn)
Such that for this case:
> (mapcar #'list '(A B C D) '(1 2 3 4))
((A 1) (B 2) (C 3) (D 4))
To swap the order of the pairs as you indicated, simply change the function passed to mapcar accordingly:
> (mapcar #'(lambda (x y) (list y x)) '(A B C D) '(1 2 3 4))
((1 A) (2 B) (3 C) (4 D))
Checkout the documentation for mapcar for more details.
zip function with arbitrary number of lists
(defun zip (&rest lists)
(apply #'mapcar #'list lists))
Shortest list determines depth of zipping.
CL-USER> (zip '(1 2 3) '(a b c) '("a" "b" "c"))
((1 A "a") (2 B "b") (3 C "c"))
CL-USER> (zip '(1 2 3) '(a b c) '("a" "b" "c" "d"))
((1 A "a") (2 B "b") (3 C "c"))
You could do something such as this:
(defun zipper (a b)
(if (or (null a) (null b))
nil
(cons (list (car b) (car a)) (our-combiner (cdr a) (cdr b)))))
We can check if either of the lists is null, so that we could stop when one of the lists runs out (similar to how mapcar will stop applying a function to lists when one of the lists runs out). We can then cons a nested list with the car's of the lists in each recursive call. Your output would be:
CL-USER> (zipper '(a b c d) '(1 2 3 4))
((1 A) (2 B) (3 C) (4 D))
CL-USER>
We could also use mapcar as it will iterate over both lists and returns the result of applying the function to both lists (unlike mapc). This is fewer lines of code, and since it will return when some list runs out, there's no need for a conditional:
(defun zipper (a b)
(mapcar #'list b a))
Related
now I have a list:
(+ x (- 4 9))
I first need (- 4 9) change to (- (4 . 0) (9 . 0))
(please do worry this part too much)
(defun typecheck (A)
(cond
((numberp A)
(cons A 0))
((equal A 'x)
(cons 1 1))
(t A)))
then I need to subtract (4 . 0) and (9 . 0) (still this is not my problem, I don't want to post this function because it is too long...
so it becomes
(+ x (-5 . 0))
now this time I change x to (1 . 1) so the list becomes (+ (1 . 1) (- 5 . 0))
I finally add them together (final result is (-4 . 1))
My main problem is how to let Lisp know I want to calculate them first after I got (- (4 . 0) (9 .0)) ? My function will just go stright to (+ (1 . 1) ((- 4 .0) (9 . 0)) and gave me an error msg.
My process :
(defun check (A)
(cond
((atom A)
(let ((newA (typecheck A)))
(calucalte A)))
((listp A)
(mapcar #'check A))
but this function won't store anything...and I have no idea how to do it :( can anyone give me some help? THANK YOU.
If I understood the problem correctly you should just write a single recursive function handling operations and number/symbol conversion, for example:
(defun tcheck (expr)
(cond
((numberp expr)
(cons expr 0))
((eq expr 'x)
(cons 1 1))
((listp expr)
(cond
((eq (first expr) '+)
(let ((a (tcheck (second expr)))
(b (tcheck (third expr))))
(cons (+ (car a) (car b))
(+ (cdr a) (cdr b)))))
((eq (first expr) '-)
(let ((a (tcheck (second expr)))
(b (tcheck (third expr))))
(cons (- (car a) (car b))
(- (cdr a) (cdr b)))))
(T
(error "Unknown operation"))))
(T expr)))
With the above function
(tcheck '(+ x (- 4 9)))
returns (-4 . 1)
Related to this question I would like to count the number of matches between the elements of two different lists of lists in a certain position.
For instance:
'((a b c) (d e c) (f g h)) '((a e k) (l f c) (g p c))
would return 2 whenever we specify the matching position as the third one on every list (no matter what the other positions contain).
Is there a function doing this operation? I cannot find it. Thank you.
Solution
I don't know of any readily made functions. So I wrote own.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; filter list of list by inner list element position
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (position-filter lol pos)
(map (lambda (l) (list-ref l pos)) lol))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; intersect two lists (duplicate-preserved)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; without duplicates would be `set-intersect`
(define (list-intersect l1 l2 (acc '()) (test equal?))
(cond ((or (null? l1) (null? l2)) (reverse acc))
((member (car l1) l2 test)
(list-intersect (cdr l1) (remove (car l1) l2) (cons (car l1) acc) test))
(else (list-intersect (cdr l1) l2 acc test))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; intersect two position-filtered lols
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (lol-intersect-at-pos lol-1 lol-2 pos)
(let ((l1 (position-filter lol-1 pos))
(l2 (position-filter lol-2 pos)))
(list-intersect l1 l2)))
;; you can count then how many elements are common by `length`
That's it.
Testing
Since I was too "lazy" to write lol with strings, I wrote a convenience function:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; convert lol elements to strings
;; convenience function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require racket/format) ;; for ~a
(define to-string ~a)
(define (as-strings nested-list (acc '()))
(cond ((null? nested-list) (reverse acc))
((list? (car nested-list))
(as-strings (cdr nested-list)
(cons (as-strings (car nested-list))
acc)))
(else
(as-strings (cdr nested-list)
(cons (to-string (car nested-list))
acc)))))
Equipped with this, we can try out lols with symbols:
(lol-intersect-at-pos '((a b c) (d e c) (f g h))
'((a e k) (l f c) (g p c))
2)
;;'(c c) ;; length is 2
lols with numbers as elements:
(lol-intersect-at-pos '((1 2 3) (4 5 3) (6 7 8))
'((1 5 19) (18 7 3) (29 39 3))
2)
;;'(3 3) ;; length is 2
and lols with strings as elements:
(lol-intersect-at-pos (as-strings '((a b c) (d e c) (f g h)))
(as-strings '((a e k) (l f c) (g p c)))
2)
;;'("c" "c") ;; length is 2
even mixed lols:
(lol-intersect-at-pos '((a b c) (a b "c") (d e 3) (f g "3"))
'((d c c) ("a" "b" c) (1 3 3) (2 4 3))
2)
;;'(c 3) ;; length of that is 2
More complicated Solution with sorting (requires conversion symbol->string with all its complications)
Before that, I wrote this. I leave it for history.
#lang racket
(define (get-position-values lol pos) ; to extract elements at pos in inner lists
(map (lambda (l) (list-ref l pos)) lol))
; to determine all elements common between two lists
; set-intersect would remove duplicates, so I had to write an list-intersect
(define (list-intersect l1 l2 (acc '()) (test-equality equal?) (test-smaller <))
(let ((lst1 (sort l1 test-smaller))
(lst2 (sort l2 test-smaller)))
(cond ((or (null? lst1) (null? lst2)) (reverse acc))
((test-equality (car lst1) (car lst2))
(list-intersect (cdr lst1) (cdr lst2) (cons (car lst1) acc) test-equality test-smaller))
((test-smaller (car lst1) (car lst2))
(list-intersect (cdr lst1) lst2 acc test-equality test-smaller))
(else
(list-intersect lst1 (cdr lst2) acc test-equality test-smaller)))))
; to determine all elements common between two list of lists at position pos
; transformer is the function applied to the extracted list elements (necessary when symbols are used,
; since symbols don't have a test-smaller test, only equality test, but sorting would improve performance ...
; so this function doesn't allow to mixup strings and symbols, because symbols would be converted to strings
; so indistinguishable from strings when applying equality test.
; if one wants better equality test, then one has to construct a more complex test-smaller test function which
; can handle strings, symbols, numbers etc. - and one needs also such a more complex test-equality function -
; and then the transformer can be the identity function.
(define (match-element-lol-pos lol-1 lol-2 pos (test-equality string=?) (test-smaller string<?) (transformer symbol->string))
(let* ((l1 (get-position-values lol-1 pos))
(l2 (get-position-values lol-2 pos))
(sl1 (map transformer l1))
(sl2 (map transformer l2))
(commons (list-intersect sl1 sl2 '() test-equality test-smaller)))
(values (length commons) commons)))
This you can apply then to your example pair of list of lists.
(match-element-lol-pos '((a b c) (d e c) (f g h)) '((a e k) (l f c) (g p c)) 2)
; 2 for third element of inner lists!
Which gives:
;; 2
;; '("c" "c")
List of lists with numbers as elements, one can call like this:
(match-element-lol-pos '((1 2 3) (4 5 3) (6 7 8)) '((1 5 19) (18 7 3) (29 39 3)) 2 = < identity)
;; 2
;; '(3 3)
List of lists with strings as elements, one calls like this.
For convenient reasons, I wrote a function as-strings which converts all elements in a nested list into strings. I was just too lazy to wrap "" around each symbol ...
;; convert all list elements of any nested-list into strings
(require racket/format) ;; for ~a
(define to-string ~a)
(define (as-strings nested-list (acc '()))
(cond ((null? nested-list) (reverse acc))
((list? (car nested-list)) (as-strings (cdr nested-list) (cons (as-strings (car nested-list)) acc)))
(else (as-strings (cdr nested-list) (cons (to-string (car nested-list)) acc)))))
So this can be used then like this:
(match-element-lol-pos (as-strings '((a b c) (d e c) (f g h))) (as-strings '((a e k) (l f c) (g p c))) 2 string=? string<? identity)
;; 2
;; '("c" "c")
I want to fix my own function that gives the same result with the default intersection function. I've been trying to write a lisp code which prints same elements in the two lists. My code works for it. But it doesn't work for nested lists. How can I fix this?
(defun printelems (L1 L2)
(cond
((null L1) nil) ((member (first L1) L2) (cons (first L1) (printelems (rest L1) L2)))
(t (printelems (rest L1) L2))))
Expected inputs and outputs
(printelems '(2 3 5 7) '( 2 3)) => It works
=> (2 3)
(printelems '(a b '(c f)) '(a d '(c f) e)) => It doesn't work.
=> (a (c f))
Edit
Using the default intersection function works as intended. How can I use the equal function in my recursive function?
For default intersection,
(intersection '(a b (c f)) '(a d (c f) e) :test 'equal)
((C F) A)
(intersection '(a b (c f)) '(a d c f e) :test 'equal)
(A)
My intersection,
(printelems '(a b (c f)) '(a d c f e))
(A C F)
(printelems '(a b (c f)) '(a d (c f) e) )
(A C F)
My edited code:
(defun flatten (l)
(cond ((null l) nil)
((atom (car l)) (cons (car l) (flatten (cdr l))))
(t (append (flatten (car l)) (flatten (cdr l))))))
(defun printelemsv1(list1 list2)
(cond
((null list1) nil)
(((member (first list1) list2) (cons (first list1) (printelemsv1 (rest list1) list2)))
(t (printelemsv1 (rest list1) list2)))))
(defun printelems (L1 L2)
(printelemsv1 (flatten L1) (flatten L2)))
Common Lisp already has an intersection function. If you want to compare sublists like (C F), you'll want to use equal or equalp as the test argument.
(intersection '(a b '(c f)) '(a d '(c f) e) :test 'equal)
;=> ('(C F) A)
While it doesn't change how intersection works, you probably don't really want quote inside your list. Quote isn't a list creation operator; it's a "return whatever the reader read" operator. The reader can read (a b (c f)) as a list of two symbols and a sublist, so (quote (a b (c f))), usually abbreviated as '(a b (c f)) is fine. E.g.:
(intersection '(a b (c f)) '(a d (c f) e) :test 'equal)
;=> ((C F) A)
It's always helpful when you provide an example of input and the expected output. I assume you mean you have two lists like '(1 (2 3) 4) and '((1) 2 5 6) that the function should produce '(1 2). In this case you can just flatten the two lists before giving them to printelems.
Since I'm not familiar with Common-Lisp itself I will leave you with one example and a link.
(defun flatten (structure)
(cond ((null structure) nil)
((atom structure) (list structure))
(t (mapcan #'flatten structure))))
Flatten a list - Rosetta Code
flatten takes an arbitrary s-expression like a nested list '(1 (2 3) 4) and returns '(1 2 3 4).
So now you just have to write a new function in which you use your printelems as a helper function and give it flattened lists.
(defun printelems.v2 (L1 L2)
(printelems (flatten L1) (flatten L2)))
Take this with a grain of salt, since as said before I'm not familiar with Common-Lisp, so appologies in advance for any potential syntax errors.
I am trying to find depth of each element in a list and simultaneously create a output where flattened output is written with their depth level , so far i came up with following logic -
(define nestingDepth
(lambda (lst1)
(cond ((null? lst1) 1)
((list? (car lst1))
(cons(+ 1(nestingDepth (car lst1)))) (nestingDepth (cdr lst1)))
((null? (cdr lst1)) (cons (1 (cdr lst1))) (nestingDepth (cdr lst1))))))
But this is not printing anything in output. Please update where i am going wrong.
Expected result will look like -
input - '(a (b) c)
output - (1 a 2 b 1 c)
As some other answers have mentioned, it's important to make sure that each case retursn something of the proper type. If the input is the empty list, then the output should be the empty list. If the input is a pair, then you need to handle the car and the cdr of the pair and connect them. If the input is neither the empty list nor a pair, then the result is a list of the depth and the input.
Now, it may be handy to build the result incrementally. You can build from the right to the left, and add each element and its depth using an approach like the following:
(define (depths tree)
(let depths ((tree tree)
(depth 0)
(results '()))
(cond
((null? tree) results)
((pair? tree) (depths (car tree)
(+ 1 depth)
(depths (cdr tree)
depth
results)))
(else (cons depth (cons tree results))))))
> (depths '(a ((b) c ((d))) e))
(1 a 3 b 2 c 4 d 1 e)
Here's one possible solution (I have changed the output format a little to make the solution easier to code). append-map is defined in SRFI 1.
(define (depths x)
(cond ((list? x)
(append-map (lambda (y)
(map (lambda (z)
(cons (car z) (+ (cdr z) 1)))
(depths y)))
x))
(else `((,x . 0)))))
(I write the code as a seasoned Schemer would write it, not as someone would write a homework assignment. If that's your situation, try to understand what my code does, then reformulate it into something homework-acceptable.)
All the previous solutions work well for proper (nested) lists, for those who work for improper lists I am not sure if they are correct.
For example, (depths '(a . b)) yields (1 a 0 b) for Joshua's, and (((a . b) . 0)) for Chris', but I'd say it should be (1 a 1 b).
I'd therefore go for
(define (depths sxp)
(let loop ((sxp sxp) (res null) (level (if (cons? sxp) 1 0)))
(cond
((null? sxp) res)
((pair? sxp) (let ((ca (car sxp)))
(loop ca
(loop (cdr sxp) res level)
(if (pair? ca) (add1 level) level))))
(else (cons level (cons sxp res))))))
and my test cases are:
(check-equal? (depths '(a . b)) '(1 a 1 b))
(check-equal? (depths 'a) '(0 a)) ; 0
(check-equal? (depths '(a)) '(1 a))
(check-equal? (depths '(a a)) '(1 a 1 a))
(check-equal? (depths '(a (b . c) d (e (f (g h . i) . j)))) '(1 a 2 b 2 c 1 d 2 e 3 f 4 g 4 h 4 i 3 j))
(check-equal? (depths '(a (b) c)) '(1 a 2 b 1 c))
(check-equal? (depths '(a ((b) c ((d))) e)) '(1 a 3 b 2 c 4 d 1 e))
(check-equal? (depths '(a (b (c (d e))) f g)) '(1 a 2 b 3 c 4 d 4 e 1 f 1 g))
The base case is wrong (you can't return 1 if you intend to output a list as a result), the way the recursion is being advanced doesn't build a list as output … a complete rewrite is needed; the following solution is portable and should work on any Scheme interpreter, making use only of basic procedures:
(define (nestingDepth lst)
(let depth ((lst lst) (n 1))
(cond ((null? lst) '())
((not (pair? (car lst)))
(cons n
(cons (car lst)
(depth (cdr lst) n))))
(else
(append (depth (car lst) (+ 1 n))
(depth (cdr lst) n))))))
The output is as expected:
(nestingDepth '(a (b (c (d e))) f g))
=> '(1 a 2 b 3 c 4 d 4 e 1 f 1 g)
From any given list in lisp, I want to get the two element combinations of the elements of that list without having duplicate combinations ( meaning (a b) = (b a) and one should be removed)
So for example if I have a list that is (a b c d),
I want to get ((a b) (a c) (a d) (b c) (b d) (c d))
(defun combinations (list)
(loop for (a1 . r1) on list
nconc (loop for a2 in r1 collect (list a1 a2))))
CL-USER 172 > (combinations '(a b c d))
((A B) (A C) (A D) (B C) (B D) (C D))
Assuming I'm understanding you correctly, I'd use mapcar and friends.
(defun pair-with (elem lst)
(mapcar (lambda (a) (list elem a)) lst))
(defun unique-pairs (lst)
(mapcon (lambda (rest) (pair-with (car rest) (cdr rest)))
(remove-duplicates lst)))
That should let you
CL-USER> (unique-pairs (list 1 2 3 4 5))
((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5))
CL-USER> (unique-pairs (list :a :b :c :a :b :d))
((:C :A) (:C :B) (:C :D) (:A :B) (:A :D) (:B :D))
If you're not scared of loop, you can also write the second one slightly more clearly as
(defun unique-pairs (lst)
(loop for (a . rest) on (remove-duplicates lst)
append (pair-with a rest)))
instead. I'm reasonably sure that loops append directive is more efficient than the function of the same name.
Scheme solution:
(define (lol lst)
(let outer ((lhs lst))
(if (null? lhs)
'()
(let inner ((rhs (cdr lhs)))
(if (null? rhs)
(outer (cdr lhs))
(cons (list (car lhs) (car rhs)) (inner (cdr rhs))))))))
And a Common Lisp translation of same:
(defun lol (list)
(labels ((outer (lhs)
(and lhs (labels ((inner (rhs)
(if rhs
(cons (list (car lhs) (car rhs))
(inner (cdr rhs)))
(outer (cdr lhs)))))
(inner (cdr lhs))))))
(outer list)))
Sorry, I'm not a Common Lisper, so I hope this isn't too ugly. :-)
This is similar to Rainer's Joswig answer, in principle, except it doesn't use loops.
(defun combinations (list)
(mapcon (lambda (x) (mapcar (lambda (y) (list (car x) y)) (cdr x))) list))
One thing that confuses me about your example is that (a a) matches your verbal description of the desired result, but in the example of the result you've excluded it.
This is my own initial answer. It might not be completely efficient but it solves the problem.
(remove nil (let ((res))
(dotimes (n (length test-list) res)
(setq res
(append res
(let ((res2) (rest-list (remove (nth n test-list) test-list)))
(dotimes (m (length rest-list) res2)
(setq res2
(append res2
(list (if (< (nth n test-list) (nth m rest-list))
(list (nth n test-list) (nth m rest-list))
nil)))))))))))
If the "if statement" on line 9 is removed, the result will include also duplicates and the result will be
((a b) (a c) (a d) (a a) (b a) (b c) (b d) (b b)
(c a) (c b) (c d) (c c) (d a) (d b) (d c) (d d))