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.
Related
I'm new to coding in racket, but I wanted to define a procedure that checks to see if a given list is a sublist (or part of) another list.
This is my code so far:
(define prefix?
(lambda (lst1 lst2)
(cond
((equal? lst1 lst2) #t)
((null? lst2) #f)
(else (prefix? lst1 (reverse (rest (reverse lst2))))))))
(define sublist?
(lambda (lst1 lst2)
(cond
((prefix? lst1 lst2) #t)
((null? lst2) #f)
(else (prefix? lst1 (rest lst2))))))
I've tried most cases and it works the way it's supposed to but when I tried this test case:
(sublist? '(a b d) '(a b c a b d e))
It returns #f when it's supposed to return #t
I tried tracing the sublist? procedure but it isn't returning me any useful information.
Is there a logic error in my code?
There is a logic error. The default case of sublist? should call sublist?, but instead calls prefix? so your prefix? will only be true if the match is either in index 0 or 1.
Also you have created a rather complex prefix?. Instead of comparing one by one element until any of them are empty you do a O(n) removal of the last element until you have a empty list before returning #f even if the two first elements are different. I would have compared the first elements and then recurred with rest in both args until either list is empty. Which one depends on the result and eg. (prefix '(a b) '(w a d f s)) will stop computing after the very first check between a and w.
try this:
(define sub?
(lambda (l sub)
(define test (lambda (x) (equal? x sub)))
((lambda (s) (s s l test))
(lambda (s l k)
(or (k '())
(and (pair? l)
(s s (cdr l)
(lambda (r)
(or (test r)
(k (cons (car l) r)))))))))))
(sub? '(a b c a b d e) '(b d e) )
(sub? '(a b c a b d e) '(c a b) )
(sub? '(a b c a b d e) '(a b c) )
(sub? '(a b c a b x e) '(a b d) )
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 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)
I'm trying to write a scheme function that will return the unique atoms found in the input list such that.
> (unique-atoms '(a (b) b ((c)) (a (b))))
(a c b)
> (unique-atoms '(a . a))
(a)
> (unique-atoms '())
()
I was thinking something like this as a start
(define (unique-atoms l)
(if (null? l)
'()
(eq? (car (l) unique-atoms(cdr (l))))))
but I don't know how to collect the atoms that are unique, and create a new list while checking everything recursively.
The following walks list, term by term. If the next value is a list itself, then a recursive call is made with (append next rest) - that is, as list is walked we are flattening sublists at the same time.
We use a (tail) recursive function, looking, to walk the list and to accumulate the rslt. We add to the result when next is not alreay in rslt.
(define (uniquely list)
(let looking ((rslt '()) (list list))
(if (null? list)
rslt
(let ((next (car list))
(rest (cdr list)))
(if (list? next)
(looking rslt (append next rest))
(looking (if (memq next rslt)
rslt
(cons next rslt))
rest))))))
> (uniquely '(a b (a b) ((((a))))))
(b a)
If you really want the code to work for 'improper lists' like '(a . a) then the predicates null? and list? probably need to change.
This problem has two parts:
You need to find a way to visit each element of the given form, recursing into sublists.
You need a way to collect the unique elements being visited.
Here's a solution to the first part:
(define (recursive-fold visitor initial x)
(let recur ((value initial)
(x x))
(cond ((null? x) value)
((pair? x) (recur (recur value (car x)) (cdr x)))
(else (visitor x value)))))
I leave it for you to implement the second part.
I found a half solution where the non unique items are removed, although this wont work for an atom b and a list with b such as '(b (b))
(define (uniqueAtoms l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(uniqueAtoms (cdr l)))
(else
(cons (car l) (uniqueAtoms (cdr l))))))
The easiest way to solve this problem with all kinds of list structures is to divide it into two parts
1) flatten then list - this results in a proper list with no sublists
; if you use Racket, you can use the build-in flatten procedure
; otherwise this one should do
(define (flatten expr)
(let loop ((expr expr) (res '()))
(cond
((empty? expr) res)
((pair? expr) (append (flatten (car expr)) (flatten (cdr expr))))
(else (cons expr res)))))
2) find all unique members of this proper list
(define (unique-atoms lst)
(let loop ((lst (flatten lst)) (res '()))
(if (empty? lst)
(reverse res)
(let ((c (car lst)))
(loop (cdr lst) (if (member c res) res (cons c res)))))))
Tests:
; unit test - Racket specific
(module+ test
(require rackunit)
(check-equal? (unique-atoms '(a (b) b ((c)) (a (b)))) '(a b c))
(check-equal? (unique-atoms '(a (b) b ((c . q)) (a (b . d)))) '(a b c q d))
(check-equal? (unique-atoms '(a . a)) '(a))
(check-equal? (unique-atoms '(a b (a b) ((((a)))))) '(a b))
(check-equal? (unique-atoms '()) '()))
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))