直接一行一行递进计算就行了~！
用Lisp实现速度不是很快~
;;皇后计算(queen 行数 列数)
(defun queen (rs cs / c lst nlst r)
;;位置检查
(defun isOk (r c lst / a ok r+c r-c)
(setq r+c (+ r c))
(setq r-c (- r c))
(setq ok t)
(while lst
(setq a (car lst))
(setq lst (cdr lst))
(if (or (= c (cadr a)) ;列号相等
(= r+c (apply '+ a)) ;-45度对角线
(= r-c (apply '- a)) ;45度对角线
)
(setq oknil
lst nil
)
)
)
ok
)
;;rs*cs(每行一个皇后)
(setq lst '(nil))
(setq r 1)
(repeat rs
(setq c 1)
(setq nLst nil)
(repeat cs
(foreach chd lst
(if (isOk r c chd)
(setq nLst (cons (cons (list r c) chd) nLst)) ;收集器
)
)
(setq c (1+ c)) ;列号+1
)
(setq lst nLst)
(setq r (1+ r)) ;行号+1
)
nLst
) 先写一个求所有解得快速方法
;;;by:lihuaili 2011.11.28
;;;参考了网上的一些资料
;;;构造行列（确定当前所处位置）
(defun make-queen (row col) (list row col))
;;;得到行号
(defun get-row (queen) (car queen))
;;;得到列号
(defun get-col (queen) (cadr queen))
;;;判断是否在同一行
(defun same-row? (nq oq) (= (get-row nq) (get-row oq)))
;;;判断是否在同一列
(defun same-col? (nq oq) (= (get-col nq) (get-col oq)))
;;;判断是否在同一对角线上
(defun same-diag? (nq oq)
(= (abs (- (get-row nq) (get-row oq)))
(abs (- (get-col nq) (get-col oq)))
) ;_ 结束=
) ;_ 结束defun
;;;几个位置判断（是否受到攻击）
(defun attacks?(nq oq)
(or (same-row? nq oq) (same-col? nq oq) (same-diag? nq oq))
) ;_ 结束defun
;;;判断皇后是否安全
(defun safe? (target queens)
(cond((null queens) T)
((attacks? target (car queens)) nil)
(T (safe? target (cdr queens)))
) ;_ 结束cond
) ;_ 结束defun
;解算棋盘阶数为sz的皇后问题（从书写上看是递归法，实际是一种迭代法）.
(defun solve (sz)
(defun s-rec (sz x y pos sols)
(cond
; 如果先通过了最后一列，表示有了一个解.
; (顺便说一句,反方向是因为pos是从后向前建立的.)
((> x sz) (cons (reverse pos) sols))
; 如果先通过了最后一行，就表示失败.
((> y sz) sols)
;如果皇后安全, 继续.
((safe? (make-queen x y) pos)
; 这是一种回溯调用. 执行一次就完成一次内部调用。
(s-rec sz
x
(+ y 1)
pos
; 运行下一列第一行，如果有任何解决方案的结果，
; 他们需要传送到回溯调用
(s-rec sz
(+ x 1)
1
; 当考虑加入这个王后下一列的位置
(cons (make-queen x y) pos)
sols
) ;_ 结束s-rec
) ;_ 结束s-rec
)
; 如果皇后不安全, 移到下一行.
(T (s-rec sz x (+ y 1) pos sols))
) ;_ 结束cond
) ;_ 结束defun
; 开始递归.
(s-rec sz 1 1 '() '())
) ;_ 结束defun
;;;显示n阶计算方法
(defun show-queens (n)
(princ "\n")
(princ (strcat "阶次为 "
(itoa n)
" 的皇后问题共有：***"
(itoa (length (solve n)))
"***解法."
) ;_ 结束list
) ;_ 结束display
(princ)
) ;_ 结束defun
(mapcar 'show-queens '(1 2 3 4 5 6 7 8 9 10))
;;;(setq alllst (solve 8))
本帖最后由 cabinsummer 于 2011-11-28 19:45 编辑
xianaihua 发表于 2011-11-28 17:27 http://bbs.mjtd.com/static/image/common/back.gif
先写一个求所有解得快速方法
速度很快，可惜没有输出解，也没有求独立解 就是厉害，无论如何都要顶啦。 皇后问题完整版
;;;构造行列（确定当前所处位置）
(defun make-queen (row col) (list row col))
;;;得到行号
(defun get-row (queen) (car queen))
;;;得到列号
(defun get-col (queen) (cadr queen))
;;;判断是否在同一行
(defun same-row? (nq oq) (= (get-row nq) (get-row oq)))
;;;判断是否在同一列
(defun same-col? (nq oq) (= (get-col nq) (get-col oq)))
;;;判断是否在同一对角线上
(defun same-diag? (nq oq)
(= (abs (- (get-row nq) (get-row oq)))
(abs (- (get-col nq) (get-col oq)))
) ;_ 结束=
) ;_ 结束defun
;;;几个位置判断（是否受到攻击）
(defun attacks?(nq oq)
(or (same-row? nq oq) (same-col? nq oq) (same-diag? nq oq))
) ;_ 结束defun
;;;判断皇后是否安全
(defun safe? (target queens)
(cond((null queens) T)
((attacks? target (car queens)) nil)
(T (safe? target (cdr queens)))
) ;_ 结束cond
) ;_ 结束defun
;解算棋盘阶数为sz的皇后问题（从书写上看是递归法，实际是一种迭代法）.
(defun solve (sz)
(defun s-rec (sz x y pos sols)
(cond
; 如果先通过了最后一列，表示有了一个解.
; (顺便说一句,反方向是因为pos是从后向前建立的.)
((> x sz) (cons (reverse pos) sols))
; 如果先通过了最后一行，就表示失败.
((> y sz) sols)
;如果皇后安全, 继续.
((safe? (make-queen x y) pos)
; 这是一种回溯调用. 执行一次就完成一次内部调用。
(s-rec sz
x
(+ y 1)
pos
; 运行下一列第一行，如果有任何解决方案的结果，
; 他们需要传送到回溯调用
(s-rec sz
(+ x 1)
1
; 当考虑加入这个王后下一列的位置
(cons (make-queen x y) pos)
sols
) ;_ 结束s-rec
) ;_ 结束s-rec
)
; 如果皇后不安全, 移到下一行.
(T (s-rec sz x (+ y 1) pos sols))
) ;_ 结束cond
) ;_ 结束defun
; 开始递归.
(s-rec sz 1 1 '() '())
) ;_ 结束defun
;;;--------------------------------中间内容参考了狂刀的方法（有时间再优化）----------------------------------------
;;;;表的转置
(defun inv(lst n / res)
(setq i 1)
(repeat n (setq res (cons (1+ (vl-position i lst)) res) i (1+ i)))
(reverse res)
)
;;;;表在水平方向镜像
(defun mirrorx(lst n)
(mapcar '(lambda(x) (- (1+ n) x)) lst)
)
;;;;表在垂直方向镜像
(defun mirrory(lst) (reverse lst))
;;;;表的90度转置
(defun rot90(lst n) (mirrorx (inv lst n) n))
;;;;所有9种同构的情况
(defun allsame (lst n / res l1 l2 l3)
(setql1(rot90 lst n)
res (cons (mirrory l1) (cons (mirrorx l1 n) (cons l1 res)))
) ;_ 结束setq
(setql2(rot90 l1 n)
res (cons (mirrory l2) (cons (mirrorx l2 n) (cons l2 res)))
) ;_ 结束setq
(setql3(rot90 l2 n)
res (cons (mirrory l1) (cons (mirrorx l3 n) (cons l3 res)))
) ;_ 结束setq
res
) ;_ 结束defun
;;;;处理8皇后解中的重复情况
(defun removeallsame(lst n / res a1)
(while (car lst)
(setq res (cons (setq a1 (car lst)) res)
lst (removebfroma (cdr lst) (allsame a1 n)))
)
res
)
;;;;把lsta中有lstb的元素删除
(defun removebfroma(lsta lstb / x)
(foreach x lstb (setq lsta (vl-remove x lsta)))
)
;;;--------------------------------中间内容参考了狂刀的方法----------------------------------------
;;;表的转换
(defun lst_convert (l)
(if (cdaar l)
(mapcar (function
(lambda (a) (mapcar (function (lambda (x) (nth 1 x))) a))
) ;_ 结束function
l
) ;_ 结束cons
) ;_ 结束if
) ;_ 结束defun
(defun c:test (/ alllst final)
;数字8可根据阶数进行调整
(setqalllst (solve 8)
alllst (reverse (lst_convert alllst))
unique_solution(removeallsame alllst 8)
) ;_ 结束setq
(foreach x (reverse unique_solution) (princ "\n") (princ x))
(princ)
) ;_ 结束defun
;;;(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 5 8 4 1 7 2 6)
;;;(3 6 2 5 8 1 7 4)
本帖最后由 飞诗(fsxm) 于 2011-11-30 12:45 编辑
补上皇后去重计算！做一个简单的优化，速度非常快了哦！
去重模块引用的是qjchen的代码，谢了！并针对性做了少量修改，嘿嘿
;;利用对称性仅计算一半
(defun fs:queen2 (n / c lst nlst r NotOk n/2)
(defun NotOk (r c lst / cc rr err r+c r-c) ;位置检查
(setq rrr
r+c (+ r c)
r-c (- r c)
)
(while lst
(setq cc (car lst))
(setq lst (cdr lst))
(setq rr (1- rr))
(if (or (= c cc) ;列号相等
(= r+c (+ rr cc));-45度对角线
(= r-c (- rr cc));45度对角线
)
(setq err t
lst nil
)
)
)
err
)
(setq n/2 (/ n 2))
(or (zerop (rem n 2)) (setq n/2 (1+ n/2)))
(setq c 0)
(repeat n/2 (setq lst (cons (list c) lst)) (setq c (1+ c)))
(setq r 0)
(repeat (1- n)
(setq c 0)
(setq nLst nil)
(repeat n
(foreach chd lst
(or (NotOk r c chd)
(setq nLst (cons (cons c chd) nLst)) ;收集器
)
)
(setq c (1+ c)) ;列号+1
)
(setq lst nLst)
(setq r (1+ r)) ;行号+1
)
nLst
)
;;;;表的转置
(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轴翻转
(setq q:queen:mirrorx reverse)
;;;;表的90度转置
(defun q:queen:rot90 (lst)
(q:queen:mirrory (q:queen:inv lst))
)
(defun q:queen:allsame (lst / l1 l2 l3 l4 l5 l6 l7)
(list (setq l1 (q:queen:mirrorx lst))
(setq l2 (q:queen:mirrory lst))
(setq l3 (q:queen:mirrorx l2))
(setq l4 (q:queen:rot90 lst))
(setq l5 (q:queen:mirrorx l4))
(setq l6 (q:queen:mirrory l4))
(setq l7 (q:queen:mirrorx l6))
)
)
;;;;处理8皇后解中的重复情况
(defun q:queen:removeallsame (lst / res a1)
(setq n (length (car lst)))
(setq n/2 (/ n 2))
(or (zerop (rem n 2)) (setq n/2 (1+ n/2)))
(while (setq a1 (car lst))
(setq res (cons a1 res)
lst (q:list:removebfroma
(cdr lst)
(q:queen:allsame a1)
n/2
)
)
)
res
)
;;;;把lsta中有lstb的元素删除
(defun q:list:removebfroma (lsta lstb n / x)
(foreach x lstb
(if (< (last x) n) ;针对性优化
(setq lsta (vl-remove x lsta))
)
)
lsta
)
;;皇后问题去重完整版
(defun c:test ()
(foreach a (q:queen:removeallsame (fs:queen2 8))
(princ "\n")
(princ a)
)
(princ)
)
本帖最后由 xyp1964 于 2011-12-3 10:41 编辑
'(((1 1) (2 7) (3 4) (4 6) (5 8) (6 2) (7 5) (8 3))
((1 2) (2 4) (3 6) (4 8) (5 3) (6 1) (7 7) (8 5))
((1 3) (2 5) (3 7) (4 1) (5 4) (6 2) (7 8) (8 6))
((1 4) (2 2) (3 5) (4 8) (5 6) (6 1) (7 3) (8 7))
((1 4) (2 2) (3 7) (4 3) (5 6) (6 8) (7 1) (8 5))
((1 4) (2 2) (3 8) (4 6) (5 1) (6 3) (7 5) (8 7))
((1 4) (2 2) (3 7) (4 5) (5 1) (6 8) (7 6) (8 3))
((1 4) (2 6) (3 1) (4 5) (5 2) (6 8) (7 3) (8 7))
((1 5) (2 2) (3 6) (4 1) (5 7) (6 4) (7 8) (8 3))
((1 5) (2 2) (3 8) (4 1) (5 4) (6 7) (7 3) (8 6))
((1 5) (2 2) (3 4) (4 7) (5 3) (6 8) (7 6) (8 1))
((1 6) (2 4) (3 1) (4 5) (5 8) (6 2) (7 7) (8 3))
((1 6) (2 3) (3 5) (4 7) (5 1) (6 4) (7 2) (8 8))
((1 7) (2 2) (3 4) (4 1) (5 8) (6 5) (7 3) (8 6))
)——不知道哪个重复了？
xianaihua 发表于 2011-11-29 19:24
皇后问题完整版
楼主很给力！ 飞诗(fsxm) 发表于 2011-11-29 23:56
补上皇后去重计算！做一个简单的优化，速度非常快了哦！
去重模块引用的是qjchen的代码，谢了！并针对性做 ...
飞诗太牛了！
页:
1
[2]