Scheme，N-queens 优化策略 SICP 第 2 章

Question

SICP 包含 n-queens 解决方案的部分完整示例，通过遍历最后一行中每个可能的皇后位置的树，在下一行中生成更多可能的位置以组合迄今为止的结果，过滤保留的可能性只有最新的女王是安全的，并且递归地重复。

这个策略在大约 n=11 后出现了最大递归错误。

我实施了一种替代策略，该策略从第一列开始进行更智能的树遍历，从未使用的行列表中生成可能的位置，将每个位置列表连接到尚未使用的行的更新列表中。过滤那些被认为是安全的对，并在这些对上递归映射以用于下一列。这并没有爆炸（到目前为止），但 n=12 需要一分钟，n=13 需要大约 10 分钟才能解决。

(define (queens board-size)
 (let loop ((k 1) (pp-pair (cons '() (enumerate-interval 1 board-size))))
   (let ((position (car pp-pair))
         (potential-rows (cdr pp-pair)))
    (if (> k board-size) 
        (list position)
        (flatmap (lambda (pp-pair) (loop (++ k) pp-pair)) 
         (filter (lambda (pp-pair) (safe? k (car pp-pair))) ;keep only safe
          (map (lambda (new-row) 
                (cons (adjoin-position new-row k position) 
                      (remove-row new-row potential-rows))) ;make pp-pair
           potential-rows))))))) 
;auxiliary functions not listed 

不是真的在寻找代码，而是对一两个策略的简单解释，它不那么天真，并且与功能方法相得益彰。

Answer 1

我可以简化您的代码，使其运行速度更快一些。我们首先重命名一些变量以提高可读性 (YMMV)，

(define (queens board-size)
 (let loop ((k 1) 
            (pd (cons '() (enumerate-interval 1 board-size))))
   (let ((position (car pd))
         (domain   (cdr pd)))
    (if (> k board-size) 
        (list position)
        (flatmap (lambda (pd) (loop (1+ k) pd)) 
         (filter (lambda (pd) (safe? k (car pd))) ;keep only safe NewPositions
          (map (lambda (row) 
                (cons (adjoin-position row k position)  ;NewPosition
                      (remove-row row domain))) ;make new PD for each Row in D
               domain)))))))                            ; D

现在，filter f (map g d) == flatmap (\x->let {y=g x} in [y | f y]) d（使用一点 Haskell 语法），即我们可以融合 map 和 @ 987654327@合二为一flatmap：

        (flatmap (lambda (pd) (loop (1+ k) pd)) 
         (flatmap (lambda (row)                   ;keep only safe NewPositions
               (let ( (p (adjoin-position row k position))
                      (d (remove-row row domain)))
                 (if (safe? k p) 
                     (list (cons p d)) 
                     '())))
            domain)) 

然后，flatmap h (flatmap g d) == flatmap (h <=< g) d（其中<=< 是从右到左的 Kleisli 组合运算符，但谁在乎），所以我们可以融合这两个 @987654332 @s 合为一，与

        (flatmap 
            (lambda (row)                         ;keep only safe NewPositions
                (let ((p (adjoin-position row k position)))
                  (if (safe? k p)
                    (loop (1+ k) (cons p (remove-row row domain)))
                    '())))
            domain)

所以简化的代码是

(define (queens board-size)
 (let loop ((k        1) 
            (position '())
            (domain   (enumerate-interval 1 board-size)))
    (if (> k board-size) 
        (list position)
        (flatmap 
            (lambda (row)                         ;use only the safe picks
              (if (safe_row? row k position)      ;better to test before consing
                (loop (1+ k) (adjoin-position row k position)
                             (remove-row row domain))
                '()))
            domain))))

Answer 2

这是我第二次想到的。不确定它是否快得多。不过还是比较漂亮。

(define (n-queens n)
  (let loop ((k 1) (r 1) (dangers (starting-dangers n)) (res '()) (solutions '()))
    (cond ((> k n) (cons res solutions))
          ((> r n) solutions)
          ((safe? r k dangers) 
           (let ((this (loop (+ k 1) 1 (update-dangers r k dangers) 
                             (cons (cons r k) res) solutions)))
             (loop k (+ r 1) dangers res this)))
          (else (loop k (+ r 1) dangers res solutions)))))

重要的是使用 let 语句来序列化递归，将深度限制为 n。解决方案是向后出现的（可以通过在 r 和 k 上使用 n->1 而不是 1->n 来解决），但是向后的集合与向前的集合是相同的集合。

(define (starting-dangers n)
  (list (list)
        (list (- n))
        (list (+ (* 2 n) 1))))
;;instead of terminating in null list, terminate in term that cant threaten

小改进，危险可能来自连续、向下对角线或向上对角线，随着棋盘的发展跟踪每一个。

(define (safe? r k dangers)
   (and (let loop ((rdangers (rdang dangers)))
           (cond ((null? rdangers) #t)
                 ((= r (car rdangers))
                  #f)
                 (else (loop (cdr rdangers)))))
        (let ((ddiag (- k r)))
           (let loop ((ddangers (ddang dangers)))
              (if (<= (car ddangers) ddiag)
                  (if (= (car ddangers) ddiag)
                      #f
                      #t)
                  (loop (cdr ddangers)))))
        (let ((udiag (+ k r)))
           (let loop ((udangers (udang dangers)))
              (if (>= (car udangers) udiag)
                  (if (= (car udangers) udiag)
                      #f
                      #t)
                  (loop (cdr udangers)))))))

格式的变化中等改进，只需要做一个比较来检查与之前的两个。不要认为保持对角线排序会花费我什么，但我认为它也不会节省时间。

(define (update-dangers r k dangers)
  (list
     (cons r (rdang dangers))
     (insert (- k r) (ddang dangers) >)
     (insert (+ k r) (udang dangers) <))) 

 (define (insert x sL pred)
   (let loop ((L sL))
      (cond ((null? L) (list x))
            ((pred x (car L))
             (cons x L))
            (else (cons (car L)
                        (loop (cdr L)))))))

(define (rdang dangers)
  (car dangers))
(define (ddang dangers)
  (cadr dangers))
(define (udang dangers)
  (caddr dangers))