[风之影][Lisp大挑战第四季]皇后

fsxm · 发表于 2011-11-28 17:26:51

算法啥的没学过也不是很清楚，
直接一行一行递进计算就行了~！
用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 ok nil
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
)

;;皇后计算(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 ok  nil 
              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 
)

xianaihua · 发表于 2011-11-28 17:27:45

先写一个求所有解得快速方法

;;;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))

;;;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:43:36

本帖最后由 cabinsummer 于 2011-11-28 19:45 编辑

xianaihua 发表于 2011-11-28 17:27
先写一个求所有解得快速方法

速度很快，可惜没有输出解，也没有求独立解

newbuser · 发表于 2011-11-28 21:39:53

就是厉害，无论如何都要顶啦。

xianaihua · 发表于 2011-11-29 19:24:48

皇后问题完整版

;;;构造行列（确定当前所处位置）
(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)
(setq l1 (rot90 lst n)
res (cons (mirrory l1) (cons (mirrorx l1 n) (cons l1 res)))
) ;_ 结束setq
(setq l2 (rot90 l1 n)
res (cons (mirrory l2) (cons (mirrorx l2 n) (cons l2 res)))
) ;_ 结束setq
(setq l3 (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可根据阶数进行调整
(setq alllst (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)

;;;构造行列（确定当前所处位置） 
(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) 
  (setq  l1  (rot90 lst n) 
  res (cons (mirrory l1) (cons (mirrorx l1 n) (cons l1 res))) 
  ) ;_ 结束setq 
  (setq  l2  (rot90 l1 n) 
  res (cons (mirrory l2) (cons (mirrorx l2 n) (cons l2 res))) 
  ) ;_ 结束setq 
  (setq  l3  (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可根据阶数进行调整 
  (setq  alllst (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-29 23:56:35

本帖最后由飞诗(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 rr r
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)
)

;;利用对称性仅计算一半 
(defun fs:queen2 (n / c lst nlst r NotOk n/2) 
  (defun NotOk (r c lst / cc rr err r+c r-c) ;位置检查 
    (setq rr  r 
   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 00:48:31

本帖最后由 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))
)——不知道哪个重复了？

fanpaulm · 发表于 2017-8-3 10:44:36

xianaihua 发表于 2011-11-29 19:24
皇后问题完整版

楼主很给力！

fanpaulm · 发表于 2017-8-3 10:47:32

飞诗(fsxm) 发表于 2011-11-29 23:56
补上皇后去重计算！做一个简单的优化，速度非常快了哦！
去重模块引用的是qjchen的代码，谢了！并针对性做 ...

飞诗太牛了！

账号		自动登录	找回密码
密码			注册

[【风之影】] [风之影][Lisp大挑战第四季]皇后

评分

评分

点评

本帖子中包含更多资源

点评

评分

点评

评分