明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1467|回复: 1

8皇后问题

[复制链接]
发表于 2016-5-10 23:44:02 | 显示全部楼层 |阅读模式
(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 ffolst))
                                    (foreach x7 (setq fselst (vl-remove x6 ffolst))
                                        (foreach x8 (setq feilst (vl-remove x7 ffolst))
                                              (setq fallst (list x1 x2 x3 x4 x5 x6 x7 x8))
                                              (if (= 1 (f fallst)) (setq valst (cons fallst valst)))
                                          )
                                      )
                                )
                         )
                )
          )
     )
)
(princ valst)
(length valst)

 楼主| 发表于 2020-5-29 10:12:01 | 显示全部楼层
采用多叉树裁枝查找过程(远算量都是爆炸式增长类型),可省去N多foreach循环。对比网上的数列结果,程序运行结果是正确的。
(defun f(n)
(defun check(nlst k)
  (setq i 0)
  (setq num (+ 1 (length nlst)))
  (setq slst (mapcar '(lambda (x) (list (setq i (+ i 1)) x)) nlst))
  (if (or (member k nlst) (= 0 (apply '*(mapcar '(lambda (y) (if (= (- num (car y)) (abs (- k (cadr y)))) 0 1)) slst))))  (setq vt nil) (setq vt t))
  vt
)
(setq j n flst nil)
(while (> j 0)
   (setq flst (cons (list j) flst))
   (setq j (- j 1))
)
(setq ii 1)
(while (< ii n)
  (setq bestlst nil)
               (foreach en flst
               (setq jj 1 valst nil)
               (while (<= jj n)
                      (if (check en jj)
                                  (progn
                                    (setq valst (cons (reverse (cons jj (reverse en))) valst))
                                            (setq jj (+ jj 1))
                                           )
                                           (setq jj (+ jj 1))
                               )
                                )
               (setq bestlst (append valst bestlst))
                        )
(setq flst bestlst)
(setq ii (+ ii 1))
)
flst
)
F
_$ (f 4)
((3 1 4 2) (2 4 1 3))
_$ (f 5)
((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))
_$ (f 6)
((5 3 1 6 4 2) (4 1 5 2 6 3) (3 6 2 5 1 4) (2 4 6 1 3 5))
_$ (f 7)
((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 6 1 3 5 7) (2 4 1 7 5 3 6) (2 5 7 4 1 3 6) (2 5 3 1 7 4 6) (2 5 1 4 7 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 4 1 5 2 6) (3 7 2 4 6 1 5) (4 1 5 2 6 3 7) (4 1 3 6 2 7 5) (4 2 7 5 3 1 6) (4 6 1 3 5 7 2) (4 7 5 2 6 1 3) (4 7 3 6 2 5 1) (5 1 6 4 2 7 3) (5 1 4 7 3 6 2) (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 7 4 1 5 2) (6 3 5 7 1 4 2) (6 3 1 4 7 5 2) (6 4 7 1 3 5 2) (6 4 2 7 5 3 1) (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))
_$ (f 8)
((8 4 1 3 6 2 7 5) (8 3 1 6 2 5 7 4) (8 2 4 1 7 5 3 6) (8 2 5 3 1 7 4 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 1 6 8 5 2 4) (7 3 8 2 5 1 6 4) (7 2 4 1 8 5 3 6) (7 2 6 3 1 4 8 5) (7 1 3 8 6 4 2 5) (6 8 2 4 1 7 5 3) (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 3 1 8 4 2 7 5) (6 3 1 8 5 2 4 7) (6 3 1 7 5 8 2 4) (6 3 5 8 1 4 2 7) (6 3 5 7 1 4 2 8) (6 3 7 4 1 8 2 5) (6 3 7 2 4 8 1 5) (6 3 7 2 8 5 1 4) (6 2 7 1 3 5 8 4) (6 2 7 1 4 8 5 3) (6 1 5 2 8 3 7 4) (5 8 4 1 3 6 2 7) (5 8 4 1 7 2 6 3) (5 7 1 4 2 8 6 3) (5 7 1 3 8 6 4 2) (5 7 2 6 3 1 4 8) (5 7 2 6 3 1 8 4) (5 7 2 4 8 1 3 6) (5 7 4 1 3 8 6 2) (5 3 1 7 2 8 6 4) (5 3 1 6 8 2 4 7) (5 3 8 4 7 1 6 2) (5 2 4 7 3 8 6 1) (5 2 4 6 8 3 1 7) (5 2 6 1 7 4 8 3) (5 2 8 1 4 7 3 6) (5 1 4 6 8 2 7 3) (5 1 8 6 3 7 2 4) (5 1 8 4 2 7 3 6) (4 8 1 5 7 2 6 3) (4 8 1 3 6 2 7 5) (4 8 5 3 1 7 2 6) (4 7 1 8 5 2 6 3) (4 7 3 8 2 5 1 6) (4 7 5 3 1 6 8 2) (4 7 5 2 6 1 3 8) (4 6 1 5 2 8 3 7) (4 6 8 3 1 7 5 2) (4 6 8 2 7 1 3 5) (4 2 5 8 6 1 3 7) (4 2 7 5 1 8 6 3) (4 2 7 3 6 8 1 5) (4 2 7 3 6 8 5 1) (4 2 8 6 1 3 5 7) (4 2 8 5 7 1 3 6) (4 1 5 8 2 7 3 6) (4 1 5 8 6 3 7 2) (3 8 4 7 1 6 2 5) (3 7 2 8 5 1 4 6) (3 7 2 8 6 4 1 5) (3 6 2 7 1 4 8 5) (3 6 2 7 5 1 8 4) (3 6 2 5 8 1 7 4) (3 6 4 2 8 5 7 1) (3 6 4 1 8 5 7 2) (3 6 8 2 4 1 7 5) (3 6 8 1 4 7 5 2) (3 6 8 1 5 7 2 4) (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 1 7 5 8 2 4 6) (2 8 6 1 3 5 7 4) (2 7 3 6 8 5 1 4) (2 7 5 8 1 4 6 3) (2 6 1 7 4 8 3 5) (2 6 8 3 1 4 7 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 4 6 8 2 5 3) (1 7 5 8 2 4 6 3) (1 6 8 3 7 4 2 5) (1 5 8 6 3 7 2 4))

_$ (length (f 1))
1
_$ (length (f 2))
0
_$ (length (f 3))
0
_$ (length (f 4))
2
_$ (length (f 5))
10
_$ (length (f 6))
4
_$ (length (f 7))
40
_$ (length (f 8))
92
_$ (length (f 9))
352
_$ (length (f 10))
724
_$

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +2 金钱 +15 收起 理由
qjchen + 2 + 15 很给力! ,BTW, OEIS是个好地方

查看全部评分

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-23 22:14 , Processed in 0.169891 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表