(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)))
组合功能为每个棒球运动员创建名称,魅力和位置的所有组合。
(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))))
主要功能用于解决没有球员位置和魅力的问题。主要功能列出了球员的所有可能组合,他们的魅力和他们的棒球位置。然后它声明一个约束列表,每个列表都表示不,在开头表示no之后的两个值不应该是任何组合。进行循环以便从约束列表中获取一个约束。约束的汽车本身就是一个列表。 Main然后使用remove-l函数来消除不符合约束的组合。 Remove-l然后返回一个新的m-list,其组合比之前更少
(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函数返回一个新列表,其中包含与之前大多数相同的组合。约束列表中的一个约束用于消除某些组合。
(defvar *data* nil)
忽略
(defun add-player (player)
(push player *data*))
忽略
(defun dump-data ()
(dolist (cd *data*)
(format t "~{~a:~10t~a~%~}~%" cd)))
忽略
答案 0 :(得分:4)
Xach已经在评论中指出了拼写错误,但我想我会在你的代码中添加一些评论。
您不应使用SETQ
或SETF
定义变量。这些应仅用于将值设置为已定义的变量。使用LET
/LET*
表示局部变量,或DEFVAR
/DEFPARAMETER
表示全局变量。
循环使用列表也是常见的事情,因为它有内置的构造:DOLIST
,在扩展的LOOP
中你可以使用FOR element IN list
。
修好这些内容并为REMOVE-L
添加更好的缩进后,它看起来像这样:
(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))))))
仍有一些问题。请注意AND
中只有一个表单,NOT
有两个表单。 =
用于数字相等,因此您应使用NOT
或NULL
来检查某些内容是否为真。当然,CONS
不具有破坏性的问题;你必须将其返回值设置为某个地方。就像现在一样,循环没有做任何事情。您可以使用PUSH
将元素添加到列表中。
解决这些问题,你会有这样的事情:
(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)))))
您可以通过将两个约束分配给变量(使用LET
或DESTRUCTURING-BIND
)而不是每次迭代调用NTH
两次来进一步改进它。
但是,过滤列表也是一件非常常见的事情,您可以使用内置的REMOVE-IF
轻松表达REMOVE-L
。您可以将MAIN
更改为以下内容:
(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))
编辑:现在我记得,Common Lisp还有一个内置函数SUBSETP
来检查列表是否是另一个列表的子集(忽略顺序)。这样您就不需要对约束列表进行解构。
(defun main ()
(let ((m-list ...)
(constraints ...))
(dolist (constraint constraints m-list)
(setf m-list (remove-if (lambda (sample)
(subsetp (cdr constraint)
sample))
m-list)))))
这是一个使用currying的好地方,它不是内置的,但是如果你安装了Quicklisp,你可以使用Alexandria中的实现,或者你可以写一个简单的一个人:
(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)))))