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))
Related
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)))))))
I am trying to remove the duplicate occurrences of the atoms in the given list.
My code is as below -
(defun combine (item List)
(if (member item List)
List (cons item List)))
(defuneliminateDuplicates(L)
(do
((M L) M)
((null L) M)
(setq M (combine (car L) M))
(setq L (cdr L))
))
This code works fine, it removes duplicates from the list -
[3]> (eliminateduplicates '(a b b c a c g a))
(G C B A)
[4]> (eliminateduplicates '(a a a a a a))
(A)
[5]> (eliminateduplicates '(a b c d))
(D C B A)
Here, I want the results to be in the same order as they are present in the given list.
i.e., the result of the (eliminateduplicates '(a b b c a c g a)) should be (B C G A), but not (G C B A)
How can I achieve this? Thanks.
I suggest using a different approach, it's simpler and the result is as expected:
(defun eliminateDuplicates (L)
(cond ((null L) L)
((member (car L) (cdr L))
(eliminateDuplicates (cdr L)))
(t (cons (car L) (eliminateDuplicates (cdr L))))))
For example:
(eliminateDuplicates '(a b b c a c g a))
=> (B C G A)
Preface: I'm currently taking a condensed course that is apparently taught in LISP and I've never worked with LISP in my life so I had to learn the language over a weekend. I apologize in advance for the abysmal code. I'm just familiar enough with LISP's syntax to get the code working and not much more.
I'm currently working on a program that solves the map coloring problem. This code takes a sequence where the first element of each sub sequence is a state and the second element represents a color. ex: '((A R) (B G) (C G) (D Y) (E B) (F B)) and then checks to make sure that no state has the same color as a state it's constrained by (defined by the constraint list). I know there are probably a lot of cleaner and simpler ways to do this but what I'm currently struggling with is having my dolist loops immediately return the value T whenever the if statement is met. So far I've been unable to get the functions to simply return a value and had to resort to this really ugly/wrong method of setting a variable to true and waiting for the loop to finish in order to make the code work. I've tried using return and just having T inside the if statements but, in both cases, the loop would finish instead of returning a value and I have no idea why.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (f s)
(setf ans nil)
(dolist (state constraint)
(if (eq (first state) f)
(if (search (list s) (second state))
(setf ans T) ;;where I want it to just return T
)
)
)
ans
)
;;ex: ((A R) (B R) (C B) (D R) (E B) (F G))
(defun check_conflict (lst)
(setf anb nil)
(dolist (state lst)
(dolist (neighbor (remove state lst))
(if (check_constraint (first state) (first neighbor))
(if (eq (second state) (second neighbor))
(setf anb T)) ;;where I want it to just return T
)
)
)
anb
)
EDIT: I ended up just fixing this with recursion. The code is cleaner now but I'd still love to know what my issue was. This is the recursive code.
(setq constraint '((A (B C E)) (B (A E F)) (C (A E F)) (D (F)) (E (A B C F)) (F (B C D E))))
(defun check_constraint (lst f s)
(COND
((null lst) nil)
((search (list (car (car lst))) f)
(if (search s (second (car lst))) T))
(t (check_constraint (cdr lst) f s))
)
)
(defun check_neighbor (check lst)
(COND
((null lst) nil)
((check_constraint constraint (list (car check)) (list (first (first lst))))
(if (eq (second check) (second (car lst))) T))
(t (check_neighbor check (cdr lst)))
)
)
;;(check_state '((A R) (B R) (C B) (D R) (E B) (F G)))
(defun check_state (lst)
(COND
((null lst) nil)
((check_neighbor (car lst) (cdr lst)) T)
(t (check_state (cdr lst)))
)
)
First a few style issues. You should use DEFVAR or DEFPARAMETER to declare global variables. Those should also have asterisks around the name to show that they are global (or special actually).
(defparameter *constraint*
'((A (B C E))
(B (A E F))
(C (A E F))
(D (F))
(E (A B C F))
(F (B C D E))))
The lisp convention for naming things is to use dashes between words (CHECK-CONSTRAINT instead of CHECK_CONSTRAINT). You should also prefer full words for variable names instead of abbreviations (LIST instead of LST). The closing parentheses should not be written on their own line.
Then the actual problem. You can use RETURN to return a value from a block named NIL. Loops establish such a block, so you can write the first function like
(defun check-constraint (first second)
(dolist (state *constraint*)
(when (and (eq first (first state))
(member second (second state)))
(return t))))
It's better to use WHEN instead of IF when there's only a then-branch. I also combined the two IFs into one using AND. Since you were wrapping S in a list for using SEARCH, I figured you probably want to use MEMBER instead (although I'm not sure since I don't exactly know what the code is supposed to do). You can change that back if it's wrong.
You probably could also simplify it to
(defun check-constraint (first second)
(member second (second (find first *constraint* :key #'first))))
In the second function you have two loops. If you use RETURN to return from the inner one, you just end up continuing the outer loop and ignoring the return value. So you have to use RETURN-FROM to return from the function instead of the inner loop.
(defun check-conflict (list)
(dolist (state list)
(dolist (neighbor (remove state list))
(when (and (check-constraint (first state) (first neighbor))
(eq (second state) (second neighbor)))
(return-from check-conflict t)))))
I am confused about the difference between '(()) and (cons null null) in scheme.
The code below show that b and c are completely the same thing.
(define (dup2 x)
(let ((d '(())))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup2 a))
(define c (dup2 a))
(set-car! b 2)
> c ;; --> (2 2)
However, when I used dup instead of dup2:
(define (dup x)
(let ((d (cons null null)))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup a))
(define c (dup a))
(set-car! b 2)
> c ;; --> (1 2)
Variable b and c are different. I have done some experiments, but I haven't understand yet.
The value of d in the first implementation is literal data, and is modified with undefined consequences. To highlight what's happening, consider the following code:
(define (incorrect-list-null-and-x x)
(let ((l '(()))) ; a list of the form (() . ())
(set-cdr! l (cons x (cdr l))) ; (cdr l) is (), so (cons x (cdr l)) should be (x . ()) == (x), right?
; and now l should be (() . (x . ())) == (() x), right?
l))
The expected result is that (incorrect-list-null-and-x n) should return a list of the form (() n), and it does the first time, but successive calls are still accessing the same data:
(incorrect-list-null-and-x 1) ;=> (() 1)
(incorrect-list-null-and-x 2) ;=> (() 2 1)
(incorrect-list-null-and-x 3) ;=> (() 3 2 1)
(incorrect-list-null-and-x 4) ;=> (() 4 3 2 1)
The same problem manifests itself a bit differently in your dup2. Every value returned from dup2 is actually the same pair:
(let* ((x (dup2 (cons 1 2)))
(y (dup2 (cons 3 4))))
(display x)
(display y))
outputs:
(3 . 4)(3 . 4)
because the call (dup2 (cons 3 4)) modifies the same structure that was previously returned by (dup2 (cons 1 2)).
Data literals, like '(()), are meant to be read-only, and modifying it using set-car! or set-cdr! has undefined behaviour. For predictable behaviour, use the (cons '() '()) version if you want to use set-car! or set-cdr! on it.
In particular, cons creates a new cons cell, whereas a data literal usually won't.
Still, for the purposes of implementing dup, why are you using set-car! and set-cdr! anyway? Just use cons directly:
(define (dup x)
(cons (car x) (cdr x)))
In your first code snippet you use (d '(())) which ends up binding a literal to d. You then modify the literal which is generally undefined. In your second code snippet you use (d (cons null null)) which binds d to a newly created 'cons cell' which you then modify. There is no problem modifying that.
Note: you've not defined null. Perhaps you meant '()?
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.