I am trying to make a function that returns the union of two lists in an ordered manner.
Here is my code:
(defun setunion (lst1 lst2)
(cond
((null lst1) lst2)
((null lst2) lst1)
((member (car lst2) lst1)
(setunion lst1 (cdr lst2)))
(t (append (setunion lst1 (cdr lst2))
(list (car lst2))))))
(print (setunion '(a b c) '(a c d e f a)))
This returns (A B C F E D) but the output I am looking for is (A B C D E F). How can I change my code to return the right output?
Thanks!
EDIT: I figured it out I think. I made a helper function that removes the duplicates of list 2 and reverses it as well as remove the duplicates of list 1.
(defun help (lst1 lst2)
(setunion (remove-duplicates lst1 :from-end t) (reverse(remove-duplicates lst2 :from-end t))))
(print (help '(b c b d) '(a d e a)))
This gives me the output (B C D A E) which is what I'm looking for.
OK, so basically all you want to do is remove duplicates over all lists, and the elements should be in order of first appearance. You could append all lists, then remove duplicates from the end:
(defun set-union (&rest lists)
(remove-duplicates (reduce #'append lists)
:from-end t))
If what you want is the union of a bunch of lists such that elements in the lists occur in the order they occur in the lists, working from the left, then here is one fairly natural way of doing that. I'm not sure if this is what I'd write in real life. It has the advantage that:
it's easy to see what is happening;
it doesn't rely on hairy standard CL functions.
It has the disadvantage that it requires tail-call elimination to work with long lists (and some people regard code which works like this not to be idiomatic CL).
(defun union-preserving-order (&rest ls)
;; Union of a bunch of lists. The result will not contain
;; duplicates (under EQL) and elements will occur in the order they
;; occur in the lists, working from the left to the right. So
;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
;; (union-preserving-order '(a b) '(c b a)), while
;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
;; d).
(upo/loop (first ls) (rest ls) '()))
(defun upo/loop (lt more accum)
;; LT is the list we're working on, MORE is more lists for later,
;; ACCUM is the list we're building (backwards). In real life this
;; would be a local function in UNION-PRESERVING-ORDER.
(if (null lt)
;; Finished this list
(if (null more)
;; no more lists: we're done
(nreverse accum)
;; more lists, so pick the first of them and loop on that
(upo/loop (first more) (rest more) accum))
;; not finished this list, so loop on it
(upo/loop (rest lt) more
;; Either the next element of this list is already in
;; the accumulator, or it's not and we need to add it.
(if (member (first lt) accum)
accum
(cons (first lt) accum)))))
Here's a version which uses explicit iteration but otherwise does the same trick.
(defun union-preserving-order (&rest ls)
;; Union of a bunch of lists. The result will not contain
;; duplicates (under EQL) and elements will occur in the order they
;; occur in the lists, working from the left to the right. So
;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
;; (union-preserving-order '(a b) '(c b a)), while
;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
;; d).
(let ((accum '()))
(dolist (l ls (nreverse accum))
(dolist (e l)
(pushnew e accum)))))
Finally here's a dirty hack which builds the results forwards. Without proof I think this is as good as you can do in terms of performance without resorting to some clever lookup structure like a hash-table to check whether you've seen elements already.
(defun union-preserving-order (&rest ls)
;; Union of a bunch of lists. The result will not contain
;; duplicates (under EQL) and elements will occur in the order they
;; occur in the lists, working from the left to the right. So
;; (union-preserving-order '(a b) '(b a c)) will be (a b c), as will
;; (union-preserving-order '(a b) '(c b a)), while
;; (union-preserving-order '(b a) '(a b c) '(c d)) will be (b a c
;; d).
(let ((results '()) ;results we'll return
(rlc nil)) ;last cons of results
(dolist (l ls results)
(dolist (e l)
(unless (member e results)
(if (not (null rlc))
(setf (cdr rlc) (list e)
rlc (cdr rlc))
(setf rlc (list e)
results rlc)))))))
Related
say I have two lists in lisp
(setq a '(p q))
(setq b '(1 2))
(car a) is p
(car b) is 1
now I want to define a symbol '(test p 1) but if I use below
(setq c '(test (car a) (car b)))
I get '(test (car a) (car b))
it is understandable, but I just want to know how can I substitute those (car a) to p and (car b) to 1 and form a new symbol of '(test p 1)
Thanks
First off, setq should not be used on unbound variables. You can use setq on established variables. Also for global variables you should use *earmuffs*.
(defparameter *a* '(p q))
(defparameter *b* '(1 2))
(car *a*) ; ==> p
(car *b*) ; ==> 1
The quote will use the quotes structure as data. That means everything expr where you write 'expr will never be evaluated beyond taking the data verbatim. New lists are created with cons. eg.
;; creates/updates binding *x* to point at the newly created list (test p 1)
(defparameter *c* (cons 'test
(cons (car *a*)
(cons (car *b*)
'()))))
cons is the primitive, but CL has several other ways to create lists. eg. the same with the function list:
;; creates/updates binding *x* to point at the newly created list (test p 1)
(defparameter *c* (list 'test (car *a*) (car *b*)))
The second the structure becomes more complex using quasiquote/unquote/unquote-splice is a lot easier.
;; creates/updates binding *x* to point at the newly created list (test p 1)
(defparameter *c* `(test ,(car *a*) ,(car *b*)))
;; more complex example
(defmacro my-let ((&rest bindings) &body body)
`((lambda ,(mapcar #'car bindings)
,#body)
,(mapcar #'cadr bindings)))
(macroexpand-1 '(my-let ((a 10) (b 20)) (print "hello") (+ (* a a) (* b b))))
; ==> ((lambda (a b)
; (print "hello")
; (+ (* a a) (* b b)))
; (10 20))
Note that this is just sugar for the identical structure made with cons, list, and append. It might be optimized for minimal memory use so will share structure. eg. `(,x b c) in a procedure will do (cons x '(b c)) which means if you create two versions their cdr will be eq and you should refrain from mutating these parts.
If you want to make a list the function you want is list:
(list 'test (car a) (car b))`
Will be the list (test p 1).
Note that the purpose of quote (abbreviated ', so '(x) is identical to (quote (x))) is simply to tell the evaluator that what follows is literal data, not code. So, in (list 'test ...), which is the same as (list (quote test) ...) then quote tells the evaluator that test is being used as a literal datum, rather than as the name of a binding, and similarly '(p q) means 'this is a literal list with elements p and q', while (p q) means 'this is a form for evaluation, whose meaning depends on what p is')
To complete the answer from tfb, you can write
`(test ,(car a) ,(car b)
This is strictly the same of
(list 'test (car a) (car b)
I want a predicate as a parameter of a function.
(DEFUN per (F L)
(cond ((F L) 'working)
(T 'anything)))
(per 'numberp 3)
as result it raises an error:
Undefined operator F in form (F L).
As explained in Technical Issues of Separation in Function Cells and Value Cells,
Common Lisp is a Lisp-2, i.e., you
need funcall:
(defun per (F L)
(if (funcall F L)
'working
'other))
(per #'numberp 3)
==> WORKING
(per #'numberp "3")
==> OTHER
See also apply.
Late to the party, but here's another example:
(defun strip-predicate (p list)
(cond ((endp list) nil)
((funcall p (first list)) (strip-predicate (rest list)))
( T (cons (first list) (strip-Predicate p (rest list))))))
This could be used on predicates such as atom or numberp:
(strip-predicate 'numberp '(a 1 b 2 c 3 d))
(a b c d)
or:
(strip-predicate 'atom '(a (a b) b c d))
((a b))
The Program is supposed to find each symbol in the List, that comes after a certain symbol.
The function gets to parameters passed in. A List which could contain nested-lists and a symbol.
The function has to scan thru the list and search for the given symbol and print the symbols that come after the given symbol.
Examples:
(find-all 'a '((b a) ((c a b)))) --> (c b)
(find-all 'a '(b (a a) c)) --> (a c)
(find-all 'a '(b d c e)) --> nil
My Code So Far:
(defun find-all (a list)
(if (consp list)
(if (consp (car list))
(find-all a (car list))
(if (eq a (car list))
(cons (car(cdr list)) (find-all a(cdr list)))
(find-all a(cdr list))))))
This code works except when the symbol its looking for is the last atom in the list.
it fails in these test cases:
(find-all 'a '((b a) ((c a b)))) --> (c b)
(find-all 'a '(b (a a) c)) --> (a c)
but works fine in these cases:
(find-all 'a '(b a c a e)) --> (c e)
The issue is probably at my cons statement and i am unable to fix this.
I don't think your code is correct. First of all, it's not correctly indented, which makes it difficult to read. The correct indentation should be:
(defun find-all (a list)
(if (consp list)
(if (consp (car list))
(find-all a (car list))
(if (eq a (car list)) ; if properly intended here
(cons (car(cdr list)) (find-all a(cdr list)))
(find-all a(cdr list)))))))))
Even after that I have trouble following your logic. For example, when something is a cons, then you should process both the car and the cdr, but you don't. I didn't go through the the debugging process, but you should.
Instead, I'd like to show you an alternative. I would suggest splitting the problem in 2 parts:
flattening the list
Since we start with a nested list but end up with a flat list, it's easier to flatten the list first. Here is a classical flatten function:
(defun flatten (sxp)
(labels
((sub (sxp res)
(cond
((null sxp) res)
((consp sxp) (sub (car sxp) (sub (cdr sxp) res)))
(t (cons sxp res)))))
(sub sxp nil)))
processing the flat list
Now, with a flat list, the rest becomes obvious, using the member function (and calling my function find-from to distinguish it from yours at the REPL):
(defun find-from (a lst)
(labels
((sub (lst)
(when lst
(let ((rst (cdr (member a lst))))
(when rst
(cons (car rst) (sub rst)))))))
(sub (flatten lst))))
testing
? (find-from 'a '((b a) ((c a b))))
(C B)
? (find-from 'a '(b (a a) c))
(A C)
? (find-from 'a '(b d c e))
NIL
? (find-from 'a '(b a c a e))
(C E)
I have a lisp homework I am having a hard time with it.
I have to write a function that perform a union operation. The function takes 2 inputs, either in the form of either atom or list and unions every element, preserving the order and stripping off all levels of parenthesis.
The output for the function:
(my-union 'a 'b) ;; (a b)
(my-union 'a '(b)) ;; (a b)
(my-union '(a b) '(b c)) ;; (a b c)
(my-union '(((a))) '(b(c((d e))a))) ;; (a b c d e)
I am fairly new to lisp.
Here is what I have written so far and it works only for the third example:
(defun new-union (a b)
(if (not b)
a
(if (member (car b) a)
(new-union a (cdr b))
(new-union (append a (list (car b))) (cdr b)))))
Any help would be appreciated!
Since this is your first homework, and you are new to Lisp, here is a very simple top-down approach, not worrying about performance, and making good use of the tools CL offers:
In Common Lisp, there is already a function which removes duplicates: remove-duplicates. Using it with the :from-end keyword-argument will "preserve order". Now, imagine you had a function flatten, which flattens arbitrarily nested lists. Then the solution to your question would be:
(defun new-union (list1 list2)
(remove-duplicates (flatten (list list1 list2)) :from-end t))
This is how I would approach the problem when no further restrictions are given, and there is no real reason to worry much about performance. Use as much of the present toolbox as possible and do not reinvent wheels unless necessary.
If you approach the problem like this, it boils down to writing the flatten function, which I will leave as an exercise for you. It is not too hard, one easy option is to write a recursive function, approaching the problem like this:
If the first element of the list to be flattened is itself a list, append the flattened first element to the flattened rest. If the first element is not a list, just prepend it to the flattened rest of the list. If the input is not a list at all, just return it.
That should be a nice exercise for you, and can be done in just a few lines of code.
(If you want to be very correct, use a helper function to do the work and check in the wrapping function whether the argument really is a list. Otherwise, flatten will work on atoms, too, which may or may not be a problem for you.)
Now, assuming you have written flatten:
> (defun new-union (list1 list2)
(remove-duplicates (flatten (list list1 list2)) :from-end t))
NEW-UNION
> (new-union 'a 'b)
(A B)
> (new-union 'a '(b))
(A B)
> (new-union '(a b) '(b c))
(A B C)
> (new-union '(((a))) '(b (c ((d e)) a)))
(A B C D E)
One way to approach this is to separate your concerns. One is flattening; another is duplicates-removing; yet another is result-building.
Starting with empty list as your result, proceed to add into it the elements of the first list, skipping such elements that are already in the result.
Then do the same with the second list's elements, adding them to the same result list.
(defun my-union (a b &aux (res (list 1)) (p res))
(nadd-elts p a)
(nadd-elts p b)
(cdr res))
nadd-elts would add to the end of list, destructively updating its last cell (pointed to by p) using e.g. rplacd. An example is here.
To add elements, nadd-elts would emulate the flattening procedure, and add each leaf element into p after checking res for duplicates.
Working in functional style, without destructive update, the general approach stays the same: start with empty result list, add first list into it - without duplicates - then second.
(defun my-union (a b &aux res)
(setq res (add-into res a))
(setq res (add-into res b))
res)
Now we're left with implementing the add-into function.
(defun add-into (res a &aux r1 r2)
(cond
((atom a) .... )
(T (setq r1 (add-into res (car a)))
(setq r2 (............ (cdr a)))
r2)))
The above can be re-written without the auxiliary variables and without set primitives. Try to find out how... OK here's what I meant by that:
(defun my-union (a b) (add-into NIL (cons a b)))
(defun add-into (res a)
(cond
((atom a) .... )
(T (add-into (add-into res (car a))
(cdr a)))))
Unless you are not allowed to use hash table (for some reason I've encountered this as a requirement before), you could come up with an ordering function that will help you build the resulting set in the way, that you don't have to repeat the search over and over again.
Also, since nested lists are allowed your problem scales down to only removing duplicates in a tree (as you can simply append as many lists as you want before you start processing them.
Now, I'll try to show few examples of how you could do it:
;; Large difference between best and worst case.
;; Lists containing all the same items will be processed
;; in square time
(defun union-naive (list &rest lists)
(when lists (setf list (append list lists)))
(let (result)
(labels ((%union-naive (tree)
(if (consp tree)
(progn
(%union-naive (car tree))
(when (cdr tree) (%union-naive (cdr tree))))
(unless (member tree result)
(setq result (cons tree result))))))
(%union-naive list) result)))
;; Perhaps the best solution, it is practically linear time
(defun union-hash (list &rest lists)
(when lists (setf list (append list lists)))
(let ((hash (make-hash-table)) result)
(labels ((%union-hash (tree)
(if (consp tree)
(progn
(%union-hash (car tree))
(when (cdr tree) (%union-hash (cdr tree))))
(setf (gethash tree hash) t))))
(%union-hash list))
(maphash
#'(lambda (a b)
(declare (ignore b))
(push a result)) hash)
result))
;; This will do the job in more time, then the
;; solution with the hash-map, but it requires
;; significantly less memory. Memory is, in fact
;; a more precious resource some times, but you
;; have to decide what algo to use based on the
;; data size
(defun union-flatten (list &rest lists)
(when lists (setf list (append list lists)))
(labels ((%flatten (tree)
(if (consp tree)
(if (cdr tree)
(nconc (%flatten (car tree))
(%flatten (cdr tree)))
(%flatten (car tree)))
(list tree))))
;; the code below is trying to do something
;; that you could've done using
;; (remove-duplicates (%flatten list))
;; however sorting and then removing duplicates
;; may prove to be more efficient
(reduce
#'(lambda (a b)
(cond
((atom a) (list a))
((eql (car a) b) b)
(t (cons b a))))
(sort (%flatten list)
#'(lambda (a b)
(string< (symbol-name a)
(symbol-name b)))))))
(union-naive '(((a))) '(b(c((d e))a)))
(union-hash '(((a))) '(b(c((d e))a)))
(union-flatten '(((a))) '(b(c((d e))a)))
Notice that the function I've used to order elements is not universal, but you would probably be able to come up with an alternative function for any sort of data. Any fast hashing function in general would do, I've used this one for simplicity.
I have 2 lists of elements '(a b c) '(d b f) and want to find differences, union, and intersection in one result. Is that possible? How?
I wrote a member function that checks if there is a car of the first list in the second list, but I can't throw a member to the new list.
(define (checkResult lis1 lis2)
(cond...........
))
(checkresult '( a b c) '(d b f))
My result should be (( a c) (d f) (a b c d f) (b)).
Like others have said, all you need to do is create separate functions to compute the intersection, union, and subtraction of the two sets, and call them from checkresult:
(define (checkresult a b)
(list (subtract a b)
(subtract b a)
(union a b)
(intersect a b)))
Here are some example union, intersection, and subtraction functions:
(define (element? x lst)
(cond ((null? lst) #f)
((eq? x (car lst)) #t)
(#t (element? x (cdr lst)))))
(define (union a b)
(cond ((null? b) a)
((element? (car b) a)
(union a (cdr b)))
(#t (union (cons (car b) a) (cdr b)))))
(define (intersect a b)
(if (null? a) '()
(let ((included (element? (car a) b)))
(if (null? (cdr a))
(if included a '())
(if included
(cons (car a) (intersect (cdr a) b))
(intersect (cdr a) b))))))
(define (subtract a b)
(cond ((null? a) '())
((element? (car a) b)
(subtract (cdr a) b))
(#t (cons (car a) (subtract (cdr a) b)))))
Note: since these are sets and order doesn't matter, the results are not sorted. Also, the functions assume that the inputs are sets, and therefore don't do any duplicate checking beyond what's required for union.
Sure it is possible. Assuming that you have function to compute the differences, union intersection etc:
(define (checkResult lis1 list2)
(list (difference lis1 lis2)
(union ...
Sure it's possible. Here are a couple hints:
what's the result of combining a list and an empty list?
You don't have to do it all at once. Take a piece at a time.
On top of Charlie Martin's and tomjen's answers, I have come up with this source:
Union Intersection and Difference
Implementation of the distinct functions can be found with nice explanations.