问题
(defun combinations (&rest lists) (if (car lists) (mapcan (lambda (inner-val)(mapcar (lambda (outer-val) (cons outer-val inner-val)) (car lists))) (apply #'combinations (cdr lists))) (list nil)))
The combinations function creates all combinations of the names, charms and position for each baseball player.
(defun main()
(setq m-list (combinations '(Blacket Bluet Browning Greenfield Whitehall)'(four-lear-clover penny rabbit-foot ribbon silver-dollar) '(center- field first-base right-field short-stop third-base)))
(setq contraints (list '(no Browning penny) '(no Browning silver-dollar) '(no Browning right-field) '(no Browning center-field) '(no Bluet center-field) '(no Bluet right-field) '(no Greenfield first-base) '(no Greenfield short-stop)
'(no Greenfield third-base) '(no Whitehall center-field) '(no Whitehall right-field) '(no Greenfield four-leaf-clover) '(no Greenfield penny) '(no Whitehall four-lear-clover) '(no Whitehall penny)
'(no Blacket four-leaf-clover) '(no Blacket penny) '(no Blacket first-base) '(no Blacket third-base) '(no Blacket ribbon) '(no Bluet ribbon) '(no center-field rabbit-foot)))
(loop
(setf n-constraint (car constraints))
(setf m-list (remove-l m-list n-constraint))
(setf constraints (cdr constraints))
(when (null constraints) (return m-list))))
The main function serves to solve a problem where none of the players positions and charm are known. The main function makes a list of all possible combinations of the players, their charms, and their baseball position. It then declares a list of constraints with each list stating no, in the beginning to indicate that both values after the no should not be in any combination. A loop is made in order to take one constraint from the constraint list. The car of the constraints is a list itself. Main then uses the remove-l function to eliminate combinations that don't agree with the constraints. Remove-l then returns a new m-list with fewer combinations than before
(defun remove-l (a b)
(setf n-list '())
(loop
(setf sample (car a))
(when (and (not (= (find (nth 1 b) sample) nil) (= (find (nth 2 b)sample) nil))) (cons sample (cons n-list nil)))
(setf a (cdr a))(when (null a) (return n-list))))
Remove-l function here serves return a new list with most of the same combinations as before. One constraint from the constraints list is used to eliminate certain combinations.
(defvar *data* nil)
ignore
(defun add-player (player)
(push player *data*))
ignore
(defun dump-data ()
(dolist (cd *data*)
(format t "~{~a:~10t~a~%~}~%" cd)))
ignore
回答1:
Xach already pointed out the spelling mistake in the comments, but I figured I'd add some comments regarding your code.
You should not define variables with SETQ or SETF. Those should be used only to set values to already defined variables. Use LET/LET* for local variables, or DEFVAR/DEFPARAMETER for globals.
Looping over lists is also such a common thing to do that there are built in constructs for it: DOLIST and in extended LOOPs you can use FOR element IN list.
After fixing those and adding some better indentation to your REMOVE-L, it would look like this:
(defun remove-l (a b)
(let ((n-list '()))
(dolist (sample a n-list) ; That N-LIST is the return value from the loop
(when (and (not (= (find (nth 1 b) sample)
nil)
(= (find (nth 2 b) sample)
nil)))
(cons sample (cons n-list nil))))))
That still has some problems. Notice how the AND only has one form in it, and the NOT has two. = is meant for numeric equality, so you should use NOT or NULL to check if something is non-true. Then there's of course the problem that CONS is not destructive; you have to set its return value to someplace. As it is now, the loop does not do anything. You could use PUSH to add elements to a list.
Fixing those, you would have something like this:
(defun remove-l (a b)
(let ((n-list '()))
(dolist (sample a n-list)
(when (and (not (find (nth 1 b) sample))
(not (find (nth 2 b) sample)))
(push sample n-list)))))
You could further improve it by assigning the two constraints to variables (using either LET or DESTRUCTURING-BIND) instead of calling NTH twice per iteration.
However, filtering a list is also a very common thing to do and your REMOVE-L could be easily expressed with the built-in REMOVE-IF. You could change your MAIN to something like this:
(defun main ()
(let ((m-list ...) ; I left out the long lists. Fill them in.
(constraints ...))
;; This uses LOOPs destructuring assignment. The underscore is
;; just an unused variable that holds the NO in each constraint.
;; CONSTRAINT-1 and -2 hold the two symbols.
(loop for (_ constraint-1 constraint-2) in constraints
do (setf m-list (remove-if (lambda (sample)
;; I used MEMBER instead of FIND.
;; It doesn't really matter, but
;; MEMBER communicates intent better.
(and (member constraint-1 sample)
(member constraint-2 sample)))
m-list)))
m-list))
Edit: Now that I remembered, Common Lisp also has a built in function SUBSETP to check if a list is a subset of another list (disregarding order). With that you don't need to destructure the constraint list.
(defun main ()
(let ((m-list ...)
(constraints ...))
(dolist (constraint constraints m-list)
(setf m-list (remove-if (lambda (sample)
(subsetp (cdr constraint)
sample))
m-list)))))
This would be a good place to use currying, which is not built in, but if you have Quicklisp installed you can use the implementation from Alexandria or you can just write a simple one yourself:
(defun curry (function &rest arguments)
(lambda (&rest more)
(multiple-value-call function (values-list arguments) (values-list more))))
(defun main ()
(let ((m-list ...)
(constraints ...))
(dolist (constraint constraints m-list)
(setf m-list (remove-if (curry #'subsetp (cdr constraint))
m-list)))))
来源：https://stackoverflow.com/questions/37162270/when-i-run-this-it-states-that-the-list-constraints-is-unbound-why-is-that