[风之影][Lisp大挑战第四季]皇后
LISP大挑战已经发布过三季了，第一季圆周率受到大家的热捧，第二季光路计算也吸引了不少人的关注。本打算将八皇后作为第三季的，临时决定启用了个高难度的完美正方形，现在估计是很少人挑战第三季了。这次将八皇后问题作为第四季大挑战，应该能吸引不少高手参与，这次希望能见到高效率的算法。八皇后问题是一个以国际象棋为背景的问题：如何能够在 8×8 的国际象棋棋盘上放置八个皇后，使得任何一个皇后都无法直接吃掉其他的皇后？为了达到此目的，任两个皇后都不能处于同一条横行、纵行或斜线上。下图是八皇后问题的一个解：八皇后问题一共有 92 个互不相同的解。如果将旋转和对称的解归为一种的话，则一共有12个独立解。很奇怪吧？为什么不是12×8＝96个解。本期LISP大挑战就是求出八皇后问题的12个独立解。
风为什么不挑战92个互不相同的解而要挑战独立解？就是因为判断旋转和对称也需要有效率的算法。
由于八皇后问题的解法很多，大家可以到网上查找其它语言的算法。本次大挑战的优胜者将是LISP程序效率最高的那位。
飞诗(fsxm) 发表于 2011-11-29 23:56
补上皇后去重计算！做一个简单的优化，速度非常快了哦！
去重模块引用的是qjchen的代码，谢了！并针对性做 ...
飞诗太牛了！ xianaihua 发表于 2011-11-29 19:24
皇后问题完整版
楼主很给力！ 先贴一个计算92个不同解的，运算速度超快，92个解不到一秒钟
(defun c:queen(/ QP Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8)
(setq QP '(1 2 3 4 5 6 7 8))
(foreach Q1 QP
(foreach Q2 QP
(if
(and (/= Q1 Q2)(/= (+ Q1 1) Q2)(/= (- Q1 1) Q2))
(foreach Q3 QP
(if
(and
(/= Q1 Q3)(/= (+ Q1 2) Q3)(/= (- Q1 2) Q3)
(/= Q2 Q3)(/= (+ Q2 1) Q3)(/= (- Q2 1) Q3)
)
(foreach Q4 QP
(if
(and
(/= Q1 Q4)(/= (+ Q1 3) Q4)(/= (- Q1 3) Q4)
(/= Q2 Q4)(/= (+ Q2 2) Q4)(/= (- Q2 2) Q4)
(/= Q3 Q4)(/= (+ Q3 1) Q4)(/= (- Q3 1) Q4)
)
(foreach Q5 QP
(if
(and
(/= Q1 Q5)(/= (+ Q1 4) Q5)(/= (- Q1 4) Q5)
(/= Q2 Q5)(/= (+ Q2 3) Q5)(/= (- Q2 3) Q5)
(/= Q3 Q5)(/= (+ Q3 2) Q5)(/= (- Q3 2) Q5)
(/= Q4 Q5)(/= (+ Q4 1) Q5)(/= (- Q4 1) Q5)
)
(foreach Q6 QP
(if
(and
(/= Q1 Q6)(/= (+ Q1 5) Q6)(/= (- Q1 5) Q6)
(/= Q2 Q6)(/= (+ Q2 4) Q6)(/= (- Q2 4) Q6)
(/= Q3 Q6)(/= (+ Q3 3) Q6)(/= (- Q3 3) Q6)
(/= Q4 Q6)(/= (+ Q4 2) Q6)(/= (- Q4 2) Q6)
(/= Q5 Q6)(/= (+ Q5 1) Q6)(/= (- Q5 1) Q6)
)
(foreach Q7 QP
(if
(and
(/= Q1 Q7)(/= (+ Q1 6) Q7)(/= (- Q1 6) Q7)
(/= Q2 Q7)(/= (+ Q2 5) Q7)(/= (- Q2 5) Q7)
(/= Q3 Q7)(/= (+ Q3 4) Q7)(/= (- Q3 4) Q7)
(/= Q4 Q7)(/= (+ Q4 3) Q7)(/= (- Q4 3) Q7)
(/= Q5 Q7)(/= (+ Q5 2) Q7)(/= (- Q5 2) Q7)
(/= Q6 Q7)(/= (+ Q6 1) Q7)(/= (- Q6 1) Q7)
)
(foreach Q8 QP
(if
(and
(/= Q1 Q8)(/= (+ Q1 7) Q8)(/= (- Q1 7) Q8)
(/= Q2 Q8)(/= (+ Q2 6) Q8)(/= (- Q2 6) Q8)
(/= Q3 Q8)(/= (+ Q3 5) Q8)(/= (- Q3 5) Q8)
(/= Q4 Q8)(/= (+ Q4 4) Q8)(/= (- Q4 4) Q8)
(/= Q5 Q8)(/= (+ Q5 3) Q8)(/= (- Q5 3) Q8)
(/= Q6 Q8)(/= (+ Q6 2) Q8)(/= (- Q6 2) Q8)
(/= Q7 Q8)(/= (+ Q7 1) Q8)(/= (- Q7 1) Q8)
)
(print (list Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8))
) ) ) ) ) ) ) ) ) ) ) ) ) ) )
(princ)
)
以下是92个不同解，独立解要从这92个解中排除同类的，caoyin的表中删除指定项的挑战在此重现。 (1 5 8 6 3 7 2 4)
(1 6 8 3 7 4 2 5)
(1 7 4 6 8 2 5 3)
(1 7 5 8 2 4 6 3)
(2 4 6 8 3 1 7 5)
(2 5 7 1 3 8 6 4)
(2 5 7 4 1 8 6 3)
(2 6 1 7 4 8 3 5)
(2 6 8 3 1 4 7 5)
(2 7 3 6 8 5 1 4)
(2 7 5 8 1 4 6 3)
(2 8 6 1 3 5 7 4)
(3 1 7 5 8 2 4 6)
(3 5 2 8 1 7 4 6)
(3 5 2 8 6 4 7 1)
(3 5 7 1 4 2 8 6)
(3 5 8 4 1 7 2 6)
(3 6 2 5 8 1 7 4)
(3 6 2 7 1 4 8 5)
(3 6 2 7 5 1 8 4)
(3 6 4 1 8 5 7 2)
(3 6 4 2 8 5 7 1)
(3 6 8 1 4 7 5 2)
(3 6 8 1 5 7 2 4)
(3 6 8 2 4 1 7 5)
(3 7 2 8 5 1 4 6)
(3 7 2 8 6 4 1 5)
(3 8 4 7 1 6 2 5)
(4 1 5 8 2 7 3 6)
(4 1 5 8 6 3 7 2)
(4 2 5 8 6 1 3 7)
(4 2 7 3 6 8 1 5)
(4 2 7 3 6 8 5 1)
(4 2 7 5 1 8 6 3)
(4 2 8 5 7 1 3 6)
(4 2 8 6 1 3 5 7)
(4 6 1 5 2 8 3 7)
(4 6 8 2 7 1 3 5)
(4 6 8 3 1 7 5 2)
(4 7 1 8 5 2 6 3)
(4 7 3 8 2 5 1 6)
(4 7 5 2 6 1 3 8)
(4 7 5 3 1 6 8 2)
(4 8 1 3 6 2 7 5)
(4 8 1 5 7 2 6 3)
(4 8 5 3 1 7 2 6)
(5 1 4 6 8 2 7 3)
(5 1 8 4 2 7 3 6)
(5 1 8 6 3 7 2 4)
(5 2 4 6 8 3 1 7)
(5 2 4 7 3 8 6 1)
(5 2 6 1 7 4 8 3)
(5 2 8 1 4 7 3 6)
(5 3 1 6 8 2 4 7)
(5 3 1 7 2 8 6 4)
(5 3 8 4 7 1 6 2)
(5 7 1 3 8 6 4 2)
(5 7 1 4 2 8 6 3)
(5 7 2 4 8 1 3 6)
(5 7 2 6 3 1 4 8)
(5 7 2 6 3 1 8 4)
(5 7 4 1 3 8 6 2)
(5 8 4 1 3 6 2 7)
(5 8 4 1 7 2 6 3)
(6 1 5 2 8 3 7 4)
(6 2 7 1 3 5 8 4)
(6 2 7 1 4 8 5 3)
(6 3 1 7 5 8 2 4)
(6 3 1 8 4 2 7 5)
(6 3 1 8 5 2 4 7)
(6 3 5 7 1 4 2 8)
(6 3 5 8 1 4 2 7)
(6 3 7 2 4 8 1 5)
(6 3 7 2 8 5 1 4)
(6 3 7 4 1 8 2 5)
(6 4 1 5 8 2 7 3)
(6 4 2 8 5 7 1 3)
(6 4 7 1 3 5 2 8)
(6 4 7 1 8 2 5 3)
(6 8 2 4 1 7 5 3)
(7 1 3 8 6 4 2 5)
(7 2 4 1 8 5 3 6)
(7 2 6 3 1 4 8 5)
(7 3 1 6 8 5 2 4)
(7 3 8 2 5 1 6 4)
(7 4 2 5 8 1 3 6)
(7 4 2 8 6 1 3 5)
(7 5 3 1 6 8 2 4)
(8 2 4 1 7 5 3 6)
(8 2 5 3 1 7 4 6)
(8 3 1 6 2 5 7 4)
(8 4 1 3 6 2 7 5) 忽然发现论坛代码的着色有问题。看上面代码中有括号不是红色。 图书编辑太高了 12个独立解出来了。不过还有一点点疑问。
;;;逆时针旋转90度
(defun RT90(elist / n temp x elst)
(setq n 1 temp nil)
(foreach x elist
(setq temp (append temp (list (cons (- 9 x) n))) n (1+ n))
)
(setq temp (vl-sort temp (function (lambda (x y)(< (car x)(car y))))))
(setq elst nil)
(foreach x temp
(setq elst (append elst (list (cdr x))))
)
elst
)
;;;水平镜像
(defun MHOR(elist)
(reverse elist)
)
;;;垂直镜像
(defun MVER(elist / x)
(mapcar (function (lambda (x)(- 9 x))) elist)
)
;;;左上右下镜像
(defun M135(elist / n temp x elst)
(setq n 1 temp nil)
(foreach x elist
(setq temp (append temp (list (cons x n))) n (1+ n))
)
(setq temp (vl-sort temp (function (lambda (x y)(< (car x)(car y))))))
(setq elst nil)
(foreach x temp
(setq elst (append elst (list (cdr x))))
)
elst
)
;;;左下右上镜像
(defun M045(elist / n temp x elst)
(setq n 1 temp nil)
(foreach x elist
(setq temp (append temp (list (cons (- 9 x) (- 9 n)))) n (1+ n))
)
(setq temp (vl-sort temp (function (lambda (x y)(< (car x)(car y))))))
(setq elst nil)
(foreach x temp
(setq elst (append elst (list (cdr x))))
)
elst
)
(defun c:queen(/ QP Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8
elist elst n
list00 list01 list02 list03 list04
list05 list06 list07 list08 list09
list10 list11 list12 list13 list14
list15 list16 list17 list18 list19
)
(setq QP '(1 2 3 4 5 6 7 8))
(foreach Q1 QP
(foreach Q2 QP
(if
(and (/= Q1 Q2)(/= (+ Q1 1) Q2)(/= (- Q1 1) Q2))
(foreach Q3 QP
(if
(and
(/= Q1 Q3)(/= (+ Q1 2) Q3)(/= (- Q1 2) Q3)
(/= Q2 Q3)(/= (+ Q2 1) Q3)(/= (- Q2 1) Q3)
)
(foreach Q4 QP
(if
(and
(/= Q1 Q4)(/= (+ Q1 3) Q4)(/= (- Q1 3) Q4)
(/= Q2 Q4)(/= (+ Q2 2) Q4)(/= (- Q2 2) Q4)
(/= Q3 Q4)(/= (+ Q3 1) Q4)(/= (- Q3 1) Q4)
)
(foreach Q5 QP
(if
(and
(/= Q1 Q5)(/= (+ Q1 4) Q5)(/= (- Q1 4) Q5)
(/= Q2 Q5)(/= (+ Q2 3) Q5)(/= (- Q2 3) Q5)
(/= Q3 Q5)(/= (+ Q3 2) Q5)(/= (- Q3 2) Q5)
(/= Q4 Q5)(/= (+ Q4 1) Q5)(/= (- Q4 1) Q5)
)
(foreach Q6 QP
(if
(and
(/= Q1 Q6)(/= (+ Q1 5) Q6)(/= (- Q1 5) Q6)
(/= Q2 Q6)(/= (+ Q2 4) Q6)(/= (- Q2 4) Q6)
(/= Q3 Q6)(/= (+ Q3 3) Q6)(/= (- Q3 3) Q6)
(/= Q4 Q6)(/= (+ Q4 2) Q6)(/= (- Q4 2) Q6)
(/= Q5 Q6)(/= (+ Q5 1) Q6)(/= (- Q5 1) Q6)
)
(foreach Q7 QP
(if
(and
(/= Q1 Q7)(/= (+ Q1 6) Q7)(/= (- Q1 6) Q7)
(/= Q2 Q7)(/= (+ Q2 5) Q7)(/= (- Q2 5) Q7)
(/= Q3 Q7)(/= (+ Q3 4) Q7)(/= (- Q3 4) Q7)
(/= Q4 Q7)(/= (+ Q4 3) Q7)(/= (- Q4 3) Q7)
(/= Q5 Q7)(/= (+ Q5 2) Q7)(/= (- Q5 2) Q7)
(/= Q6 Q7)(/= (+ Q6 1) Q7)(/= (- Q6 1) Q7)
)
(foreach Q8 QP
(if
(and
(/= Q1 Q8)(/= (+ Q1 7) Q8)(/= (- Q1 7) Q8)
(/= Q2 Q8)(/= (+ Q2 6) Q8)(/= (- Q2 6) Q8)
(/= Q3 Q8)(/= (+ Q3 5) Q8)(/= (- Q3 5) Q8)
(/= Q4 Q8)(/= (+ Q4 4) Q8)(/= (- Q4 4) Q8)
(/= Q5 Q8)(/= (+ Q5 3) Q8)(/= (- Q5 3) Q8)
(/= Q6 Q8)(/= (+ Q6 2) Q8)(/= (- Q6 2) Q8)
(/= Q7 Q8)(/= (+ Q7 1) Q8)(/= (- Q7 1) Q8)
)
(setq elist (append elist (list (list Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8))))
) ) ) ) ) ) ) ) ) ) ) ) ) ) )
(setq n 0)
(while (setq list00 (nth n elist))
(setq list01 (MHOR list00))(if (not (eq list00 list01))(setq elist (vl-remove list01 elist)))
(setq list02 (MVER list00))(if (not (eq list00 list02))(setq elist (vl-remove list02 elist)))
(setq list03 (M135 list00))(if (not (eq list00 list03))(setq elist (vl-remove list03 elist)))
(setq list04 (M045 list00))(if (not (eq list00 list04))(setq elist (vl-remove list04 elist)))
(setq list05 (RT90 list00))(if (not (eq list00 list05))(setq elist (vl-remove list05 elist)))
(setq list06 (MHOR list05))(if (not (eq list00 list06))(setq elist (vl-remove list06 elist)))
(setq list07 (MVER list05))(if (not (eq list00 list07))(setq elist (vl-remove list07 elist)))
(setq list08 (M135 list05))(if (not (eq list00 list08))(setq elist (vl-remove list08 elist)))
(setq list09 (M045 list05))(if (not (eq list00 list09))(setq elist (vl-remove list09 elist)))
(setq list10 (RT90 list05))(if (not (eq list00 list10))(setq elist (vl-remove list10 elist)))
(setq list11 (MHOR list10))(if (not (eq list00 list11))(setq elist (vl-remove list11 elist)))
(setq list12 (MVER list10))(if (not (eq list00 list12))(setq elist (vl-remove list12 elist)))
(setq list13 (M135 list10))(if (not (eq list00 list13))(setq elist (vl-remove list13 elist)))
(setq list14 (M045 list10))(if (not (eq list00 list14))(setq elist (vl-remove list14 elist)))
(setq list15 (RT90 list10))(if (not (eq list00 list15))(setq elist (vl-remove list15 elist)))
(setq list16 (MHOR list15))(if (not (eq list00 list16))(setq elist (vl-remove list16 elist)))
(setq list17 (MVER list15))(if (not (eq list00 list17))(setq elist (vl-remove list17 elist)))
(setq list18 (M135 list15))(if (not (eq list00 list18))(setq elist (vl-remove list18 elist)))
(setq list19 (M045 list15))(if (not (eq list00 list19))(setq elist (vl-remove list19 elist)))
(setq n (1+ n))
(setq elst (append elst (list list00)))
)
elst
)
(1 5 8 6 3 7 2 4)
(1 6 8 3 7 4 2 5)
(2 4 6 8 3 1 7 5)
(2 5 7 1 3 8 6 4)
(2 5 7 4 1 8 6 3)
(2 6 1 7 4 8 3 5)
(2 6 8 3 1 4 7 5)
(2 7 3 6 8 5 1 4)
(2 7 5 8 1 4 6 3)
(3 5 2 8 1 7 4 6)
(3 6 2 5 8 1 7 4)
(3 6 8 2 4 1 7 5)
本帖最后由 cabinsummer 于 2011-11-28 19:50 编辑
在求十二个独立解时有一点疑问。
思路是在92个不同解组成的表中逐一提取一个表，将提取的表进行各种镜像和旋转，以及旋转后的镜像，再将镜像和旋转的表从92个解中一一去除。奇怪的是，如果输出结果是从92个解的表中去除的，结果就是11个，前一帖子的第10个解没了。风琢磨了一下午也没琢磨个所以然来，因为表太长了，难以调试。所以采用另组新表的方式输出12个独立解。大侠们可以帮我看看到底哪里出问题了，还是算法本身就不完善？ :) 先写一个所有解的，可以不止8阶，用的是回溯法，8阶还是速度挺快。
不过到11阶以上，速度就比较慢了
后面再来修改为12解的
;;;;八皇后法的回溯法解法
(defun q:queen (n lst / i)
(setq i 0)
(repeat qn
(if (not (q:queen:check i lst))
(if (= n (1- qn))
(setq final (cons (reverse (cons i lst)) final))
(q:queen (1+ n) (cons i lst)))
)
(setq i (1+ i))
)
)
;;;;八皇后的位置检验
(defun q:queen:check (n1 lst1 / res x j)
(setq j 1)
(foreach x lst1
(setq res (append res (list (- x j) x (+ x j)))j (1+ j))
)
(member n1 (vl-sort res '<))
)
;;;;主程序
(defun c:test(/ final qn)
(setq qn 8)
(q:queen 0 nil)
(foreach x (reverse final) (princ "\n") (princ x))
(princ)
)
(princ "\n By qjchen@gmail.com, 八皇后问题，命令test")
(princ)
:) 修改了一个是属于12解的
;;;;八皇后法的回溯法解法
(defun q:queen (n lst / i)
(setq i 0)
(repeat qn
(if (not (q:queen:check i lst))
(if (= n (1- qn))
(setq final (cons (reverse (cons i lst)) final))
(q:queen (1+ n) (cons i lst)))
)
(setq i (1+ i))
)
)
;;;;八皇后的位置检验
(defun q:queen:check (n1 lst1 / res x j)
(setq j 1)
(foreach x lst1
(setq res (append res (list (- x j) x (+ x j)))j (1+ j))
)
(member n1 (vl-sort res '<))
)
;;;;表的转置
(defun q:queen:inv(lst / res)
(setq i 0)
(repeat (length lst) (setq res (cons (vl-position i lst) res) i (1+ i)))
(reverse res)
)
;;;;表的y轴翻转
(defun q:queen:mirrory(lst)
(mapcar '(lambda(x) (- (length lst) 1 x)) lst)
)
;;;;表的x轴翻转
(defun q:queen:mirrorx(lst) (reverse lst))
;;;;表的90度转置
(defun q:queen:rot90(lst) (q:queen:mirrory (q:queen:inv lst)))
;;;;所有9种同构的情况
(defun q:queen:allsame(lst / res l1 l2 l3)
(setq l1 (q:queen:rot90 lst) res (cons (q:queen:mirrorx l1) (cons (q:queen:mirrory l1) (cons l1 res))))
(setq l2 (q:queen:rot90 l1) res (cons (q:queen:mirrorx l2) (cons (q:queen:mirrory l2) (cons l2 res))))
(setq l3 (q:queen:rot90 l2) res (cons (q:queen:mirrorx l1) (cons (q:queen:mirrory l3) (cons l3 res))))
res
)
;;;;处理8皇后解中的重复情况
(defun q:queen:removeallsame(lst / res a1)
(while (car lst)
(setq res (cons (setq a1 (car lst)) res)
lst (q:list:removebfroma (cdr lst) (q:queen:allsame a1)))
)
res
)
;;;;把lsta中有lstb的元素删除
(defun q:list:removebfroma(lsta lstb / x)
(foreach x lstb (setq lsta (vl-remove x lsta)))
)
;;;;主程序
(defun c:test(/ final qn)
(setq qn (getint "\n 请输入皇后阶数(建议小于或等于8):"))
(if (not qn) (setq qn 8))
(q:queen 0 nil)
(setq final (q:queen:removeallsame (reverse final)))
(foreach x (reverse final) (princ "\n") (princ x))
(princ)
)
(princ "\n By qjchen@gmail.com, 八皇后问题，命令test")
(princ)
To cabinsummer，您过奖了，我的水平还很普通，离大师有n光年。
在这里
http://www.theswamp.org/index.php?topic=39213.0
Lee Mac和Evgeniy都写了很漂亮的8皇后解法。
qjchen 发表于 2011-11-27 18:09 static/image/common/back.gif
To cabinsummer，您过奖了，我的水平还很普通，离大师有n光年。
在这里
http://www.theswamp.org/ ...
你把我的大挑战都放到国外网站上了。
这是我第一次走出国门，呵呵
页:
[1]
2