Scheme，N皇后优化策略，SICP第2章。

Question

SICP中包含了一个n皇后问题的部分解决方案。该方案通过遍历每一行可能的皇后位置的树形结构，生成下一行更多的可能位置来结合到目前为止的结果，对可能性进行过滤以保留只有最新的皇后是安全的选项，并递归重复这个过程。但是这种策略在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 

我并不是在寻找代码，而是需要解释一下一种或两种策略，让其更加符合函数式编程的思想，并且易于理解。

- WorBlux

---

“blows up”是什么意思？如果指Scheme实现失败，你使用的是哪个实现？ - GoZoner

请在此处查看：https://dev59.com/Gk3Sa4cB1Zd3GeqPrwou - GoZoner

@GoZoner，最大递归错误在n为11或更大时触发，但不会在n为10或更小时触发。使用MIT-Scheme。 - WorBlux

你可以增加mit-scheme的堆栈大小；这样做将避免您看到的递归错误。尝试使用 mit-scheme --stack <number-of-1024-blocks> 命令。我知道，这并没有回答你的算法问题。 - GoZoner

在视频讲座中，Hal Abelson使用这个问题来演示流。 - Sylwester

Answer 1

我可以为您提供简化代码的建议，以使其运行速度更快。我们可以从重命名某些变量开始，以提高可读性（可能因人而异）。

(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和filter融合成一个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组合运算符，但谁在乎呢），所以我们可以将这两个flatmap融合成一个，即

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

- Will Ness

---

将递归下列表的操作组合在一起，这样做非常有意义。谢谢。我还在考虑用一个以k开头的域列表替换域，并使用一个函数标记其余棋盘中的行和对角线，从而消除了安全测试的需要。 - WorBlux

@WorBlux 你可以尝试将域表示为平衡树，而不是列表，以减少更新时间。使用向量表示域，更新速度最快，但您需要复制向量，复制可能是O(n)；使用树，您可以在相同的O(log n)时间内创建一个更新后的副本。但是，n非常小（8、10、13），因此两者都值得检查。维护对角线与进行简单数学运算哪个更值得，还不清楚。Bratko在Prolog中做到了。 - Will Ness

关于树，目标是加速“remove-row”。您可以通过将其与从域中选择可能性的过程相结合来节省一些周期，代价是预先计算所有这些结构：在Haskell中，它是pick。当然，在Scheme中必须高效地生成它，以top-down，TRMC方式。提前知道域列表的长度可能会有所帮助。 - Will Ness

哎呀，我错过了“mit-scheme”标签，关于编辑的问题。在我记忆中，代码确实可以工作。然而，让代码符合规范是更好的选择。 - Will Ness

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

- WorBlux