N皇后问题

aimisiyou

;;;引用ElpanovEvgeniy的get-nIA-lst函数
(defun get-nIA-lst  (l / f1 f2)
  (setq f1 (lambda (a b)
      (if b
        (cons (append a (cdr b))
       (f1 (append a (list (car b))) (cdr b))
       ))))
  (setq f2 (lambda (l)
      (if l
        (cons (car l) (f2 (vl-remove (car l) (cdr l))))
        )))
  (if (cdr l)
    (f2
      (apply
(function append)
(mapcar
   (function (lambda (a b)
        (mapcar (function (lambda (b) (cons a b)))
         (get-nIA-lst b)
         )))
   l
   (f1 nil l))))
    (list l)))
(defun check(lst k)
  (setq i 0)
  (setq num (+ 1 (length lst)))
  (setq slst (mapcar '(lambda (x) (list (setq i (+ i 1)) x)) lst))
  (if (or (member k lst) (= 0 (apply '*(mapcar '(lambda (y) (if (= (- num (car y)) (abs (- k (cadr y)))) 0 1)) slst))))  (setq v nil) (setq v t))
  v
)
(defun ff(lst i)
   (setq j 0)
   (vl-remove nil (mapcar '(lambda (x) (if (<= (setq j (+ 1 j)) i) x nil)) lst))
)
(defun f(lst)
(cond
    ( (and   (check
                 (setq flst
                            (ff
                                     lst
                                    (setq n (- (length lst) 1))
                             )  
                  )
                 (nth n lst)
             )
           flst
        )
      
     (f flst)
    )
   ((null flst) 1)
   (t 0)
  )
)
(setq lst (get-nIA-lst '(1 2 3 4 5)))
(vl-remove nil (mapcar '(lambda (x y) (if (= 1 x) y)) (mapcar 'f lst) lst))
;;;运行结果((1 3 5 2 4) (1 4 2 5 3) (2 4 1 3 5) (2 5 3 1 4) (3 1 4 2 5) (3 5 2 4 1) (4 1 3 5 2) (4 2 5 3 1) (5 2 4 1 3) (5 3 1 4 2))
;;;即有10组解，如（1 3 5 2 4）表示第一行第一列放置一个，第二行第三列放置一个，第三行第五列放置一个，第四行第二列放置一个，第五行第四列放置一个。

aimisiyou

对所有的全排列进行检查，满足要求的保留，其余舍去。运行效率很低，当N>7时基本运行不了！

HLCAD

冒昧问一下：什么是“N皇后问题”，介绍一下好吗

aimisiyou

HLCAD 发表于 2016-4-28 07:47
冒昧问一下：什么是“N皇后问题”，介绍一下好吗

百度一下就知道了。

aimisiyou

(setq lst (get-nIA-lst '(1 2 3 4 5 6)))
(vl-remove nil (mapcar '(lambda (x y) (if (= 1 x) y)) (mapcar 'f lst) lst))
;;;运行结果有四组解
;;;((2 4 6 1 3 5) (3 6 2 5 1 4) (4 1 5 2 6 3) (5 3 1 6 4 2))

(setq lst (get-nIA-lst '(1 2 3 4 5 6 7)))
(vl-remove nil (mapcar '(lambda (x y) (if (= 1 x) y)) (mapcar 'f lst) lst))
;;;运行结果有40组解
;;;((1 3 5 7 2 4 6) (1 4 7 3 6 2 5) (1 5 2 6 3 7 4) (1 6 4 2 7 5 3) (2 4 1 7 5 3 6) (2 4 6 1 3 5 7) (2 5 1 4 7 3 6) (2 5 3 1 7 4 6) (2 5 7 4 1 3 6) (2 6 3 7 4 1 5) (2 7 5 3 1 6 4) (3 1 6 2 5 7 4) (3 1 6 4 2 7 5) (3 5 7 2 4 6 1) (3 6 2 5 1 4 7) (3 7 2 4 6 1 5) (3 7 4 1 5 2 6) (4 1 3 6 2 7 5) (4 1 5 2 6 3 7) (4 2 7 5 3 1 6) (4 6 1 3 5 7 2) (4 7 3 6 2 5 1) (4 7 5 2 6 1 3) (5 1 4 7 3 6 2) (5 1 6 4 2 7 3) (5 2 6 3 7 4 1) (5 3 1 6 4 2 7) (5 7 2 4 6 1 3) (5 7 2 6 3 1 4) (6 1 3 5 7 2 4) (6 2 5 1 4 7 3) (6 3 1 4 7 5 2) (6 3 5 7 1 4 2) (6 3 7 4 1 5 2) (6 4 2 7 5 3 1) (6 4 7 1 3 5 2) (7 2 4 6 1 3 5) (7 3 6 2 5 1 4) (7 4 1 5 2 6 3) (7 5 3 1 6 4 2))

aimisiyou

(defun check(lst k)
  (setq i 0)
  (setq num (+ 1 (length lst)))
  (setq slst (mapcar '(lambda (x) (list (setq i (+ i 1)) x)) lst))
  (if (or (member k lst) (= 0 (apply '*(mapcar '(lambda (y) (if (= (- num (car y)) (abs (- k (cadr y)))) 0 1)) slst))))  (setq v nil) (setq v t))
  v
)
(defun ff(lst i)
   (setq j 0)
   (vl-remove nil (mapcar '(lambda (x) (if (<= (setq j (+ 1 j)) i) x nil)) lst))
)
(defun f(lst)
(cond
    ( (and   (check
                 (setq flst
                            (ff
                                     lst
                                    (setq n (- (length lst) 1))
                             )  
                  )
                 (nth n lst)
             )
           flst
        )
      
     (f flst)
    )
   ((null flst) 1)
   (t 0)
  )
)

(setq fstlst '(1 2 3 4 5 6 7 8) valst nil)
(foreach x1 fstlst
    (foreach x2 (setq ftwlst (vl-remove x1 fstlst))
         (foreach x3 (setq fthlst (vl-remove x2 ftwlst))
               (foreach x4 (setq ffolst (vl-remove x3 fthlst))
                        (foreach x5 (setq ffrlst (vl-remove x4 ffolst))
                             (foreach x6 (setq fsilst (vl-remove x5 ffrlst))
                                    (foreach x7 (setq fselst (vl-remove x6 fsilst))
                                        (foreach x8 (setq feilst (vl-remove x7 fselst))
                                              (setq fallst (list x1 x2 x3 x4 x5 x6 x7 x8))
                                              (if (= 1 (f fallst)) (setq valst (cons fallst valst)))
                                          )
                                      )
                                )
                         )
                )
          )
     )
)
(princ valst)
(length valst)


;;;结果有92组
;;;((8 4 1 3 6 2 7 5) (8 3 1 6 2 5 7 4) (8 2 5 3 1 7 4 6) (8 2 4 1 7 5 3 6) (7 5 3 1 6 8 2 4) (7 4 2 8 6 1 3 5) (7 4 2 5 8 1 3 6) (7 3 8 2 5 1 6 4) (7 3 1 6 8 5 2 4) (7 2 6 3 1 4 8 5) (7 2 4 1 8 5 3 6) (7 1 3 8 6 4 2 5) (6 8 2 4 1 7 5 3) (6 4 7 1 8 2 5 3) (6 4 7 1 3 5 2 8) (6 4 2 8 5 7 1 3) (6 4 1 5 8 2 7 3) (6 3 7 4 1 8 2 5) (6 3 7 2 8 5 1 4) (6 3 7 2 4 8 1 5) (6 3 5 8 1 4 2 7) (6 3 5 7 1 4 2 8) (6 3 1 8 5 2 4 7) (6 3 1 8 4 2 7 5) (6 3 1 7 5 8 2 4) (6 2 7 1 4 8 5 3) (6 2 7 1 3 5 8 4) (6 1 5 2 8 3 7 4) (5 8 4 1 7 2 6 3) (5 8 4 1 3 6 2 7) (5 7 4 1 3 8 6 2) (5 7 2 6 3 1 8 4) (5 7 2 6 3 1 4 8) (5 7 2 4 8 1 3 6) (5 7 1 4 2 8 6 3) (5 7 1 3 8 6 4 2) (5 3 8 4 7 1 6 2) (5 3 1 7 2 8 6 4) (5 3 1 6 8 2 4 7) (5 2 8 1 4 7 3 6) (5 2 6 1 7 4 8 3) (5 2 4 7 3 8 6 1) (5 2 4 6 8 3 1 7) (5 1 8 6 3 7 2 4) (5 1 8 4 2 7 3 6) (5 1 4 6 8 2 7 3) (4 8 5 3 1 7 2 6) (4 8 1 5 7 2 6 3) (4 8 1 3 6 2 7 5) (4 7 5 3 1 6 8 2) (4 7 5 2 6 1 3 8) (4 7 3 8 2 5 1 6) (4 7 1 8 5 2 6 3) (4 6 8 3 1 7 5 2) (4 6 8 2 7 1 3 5) (4 6 1 5 2 8 3 7) (4 2 8 6 1 3 5 7) (4 2 8 5 7 1 3 6) (4 2 7 5 1 8 6 3) (4 2 7 3 6 8 5 1) (4 2 7 3 6 8 1 5) (4 2 5 8 6 1 3 7) (4 1 5 8 6 3 7 2) (4 1 5 8 2 7 3 6) (3 8 4 7 1 6 2 5) (3 7 2 8 6 4 1 5) (3 7 2 8 5 1 4 6) (3 6 8 2 4 1 7 5) (3 6 8 1 5 7 2 4) (3 6 8 1 4 7 5 2) (3 6 4 2 8 5 7 1) (3 6 4 1 8 5 7 2) (3 6 2 7 5 1 8 4) (3 6 2 7 1 4 8 5) (3 6 2 5 8 1 7 4) (3 5 8 4 1 7 2 6) (3 5 7 1 4 2 8 6) (3 5 2 8 6 4 7 1) (3 5 2 8 1 7 4 6) (3 1 7 5 8 2 4 6) (2 8 6 1 3 5 7 4) (2 7 5 8 1 4 6 3) (2 7 3 6 8 5 1 4) (2 6 8 3 1 4 7 5) (2 6 1 7 4 8 3 5) (2 5 7 4 1 8 6 3) (2 5 7 1 3 8 6 4) (2 4 6 8 3 1 7 5) (1 7 5 8 2 4 6 3) (1 7 4 6 8 2 5 3) (1 6 8 3 7 4 2 5) (1 5 8 6 3 7 2 4))
;;;92

aimisiyou

趁热打铁，根据最近研究多叉树裁剪查找算法来把N皇后问题攻克一下。

aimisiyou

关键是如何处理斜线上冲突的问题。