每个棋盘的摆放可以用一个逆序的列表表示,比如书上列举的解法(棋盘从低到高总共 8 列):
可以表示为 (list 6 3 1 7 5 8 2 4)
。
其中列表的第一个元素表示第 8 列的皇后所在的行,而列表的第二个元素表示第 7 列的皇后所在的行,以此类推。
一个空棋盘可以使用 '()
表示:
;;; 42-empty-board.scm
(define empty-board '())
因为题目要求给出八皇后问题的所有解法,所以 queens
求出的最终结果将是一个二维列表: (list (list 6 3 1 7 5 8 2 4) (list ...) (list ...) ...)
。
添加皇后的工作由 adjoin-position
完成,它简单地将新皇后的行位置 new-row
添加到列表的前端,因为列表中元素的位置指定了列的位置,所以参数 k
实际上是用不上的:
;;; 42-adjoin-position.scm
(define (adjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
添加皇后的简单性是产生逆序列表的其中一个原因,另一个原因是,逆序列表会使得接下来定义的 safe?
函数可以方便地从高到低检查棋盘的安全性。
safe?
以及它的辅助函数 iter-check
完成过滤不安全皇后的操作,对于一个给定的新皇后行,它迭代地向棋盘的下方检查是否有已存在的皇后和新皇后的行发生冲突:
;;; 42-safe.scm
(define (safe? k position)
(iter-check (car position)
(cdr position)
1))
(define (iter-check row-of-new-queen rest-of-queens i)
(if (null? rest-of-queens) ; 下方所有皇后检查完毕,新皇后安全
#t
(let ((row-of-current-queen (car rest-of-queens)))
(if (or (= row-of-new-queen row-of-current-queen) ; 行碰撞
(= row-of-new-queen (+ i row-of-current-queen)) ; 右下方碰撞
(= row-of-new-queen (- row-of-current-queen i))) ; 左下方碰撞
#f
(iter-check row-of-new-queen
(cdr rest-of-queens) ; 继续检查剩余的皇后
(+ i 1)))))) ; 更新步进值
比如说,当 k
为 4
,新皇后放在第 5
行的时候,产生这样一个检查序列( o
号表示皇后, x
表示被检查的位置):
8 (safe? 4 (list 5 8 2 4))
7
6
5
4 o
3 o
2 o
1 o
1 2 3 4 5 6 7 8
8 (iter-check 4 (list 5 8 2 4) 1)
7
6
5
4 o
3 x x x o
2 o
1 o
1 2 3 4 5 6 7 8
8 (iter-check 5 (list 2 4) 2)
7
6
5
4 o
3 x x x o
2 o x x x
1 o
1 2 3 4 5 6 7 8
8 (iter-check 5 (list 4) 3)
7
6
5
4 o
3 x x x o
2 o x x x
1 x o x x
1 2 3 4 5 6 7 8
1 ]=> (load "42-queens.scm")
;Loading "42-queens.scm"...
; Loading "p78-enumerate-interval.scm"... done
; Loading "p83-flatmap.scm"...
; Loading "p78-accumulate.scm"... done
; ... done
; Loading "42-safe.scm"... done
; Loading "42-empty-board.scm"... done
; Loading "42-adjoin-position.scm"... done
;... done
;Value: queens
1 ]=> (for-each (lambda (pos)
(begin
(display pos)
(newline)))
(queens 8))
(4 2 7 3 6 8 5 1)
(5 2 4 7 3 8 6 1)
(3 5 2 8 6 4 7 1)
(3 6 4 2 8 5 7 1)
(5 7 1 3 8 6 4 2)
(4 6 8 3 1 7 5 2)
(3 6 8 1 4 7 5 2)
(5 3 8 4 7 1 6 2)
(5 7 4 1 3 8 6 2)
(4 1 5 8 6 3 7 2)
(3 6 4 1 8 5 7 2)
(4 7 5 3 1 6 8 2)
(6 4 2 8 5 7 1 3)
(6 4 7 1 8 2 5 3)
(1 7 4 6 8 2 5 3)
(6 8 2 4 1 7 5 3)
(6 2 7 1 4 8 5 3)
(4 7 1 8 5 2 6 3)
(5 8 4 1 7 2 6 3)
(4 8 1 5 7 2 6 3)
(2 7 5 8 1 4 6 3)
(1 7 5 8 2 4 6 3)
(2 5 7 4 1 8 6 3)
(4 2 7 5 1 8 6 3)
(5 7 1 4 2 8 6 3)
(6 4 1 5 8 2 7 3)
(5 1 4 6 8 2 7 3)
(5 2 6 1 7 4 8 3)
(6 3 7 2 8 5 1 4)
(2 7 3 6 8 5 1 4)
(7 3 1 6 8 5 2 4)
(5 1 8 6 3 7 2 4)
(1 5 8 6 3 7 2 4)
(3 6 8 1 5 7 2 4)
(6 3 1 7 5 8 2 4)
(7 5 3 1 6 8 2 4)
(7 3 8 2 5 1 6 4)
(5 3 1 7 2 8 6 4)
(2 5 7 1 3 8 6 4)
(3 6 2 5 8 1 7 4)
(6 1 5 2 8 3 7 4)
(8 3 1 6 2 5 7 4)
(2 8 6 1 3 5 7 4)
(5 7 2 6 3 1 8 4)
(3 6 2 7 5 1 8 4)
(6 2 7 1 3 5 8 4)
(3 7 2 8 6 4 1 5)
(6 3 7 2 4 8 1 5)
(4 2 7 3 6 8 1 5)
(7 1 3 8 6 4 2 5)
(1 6 8 3 7 4 2 5)
(3 8 4 7 1 6 2 5)
(6 3 7 4 1 8 2 5)
(7 4 2 8 6 1 3 5)
(4 6 8 2 7 1 3 5)
(2 6 1 7 4 8 3 5)
(2 4 6 8 3 1 7 5)
(3 6 8 2 4 1 7 5)
(6 3 1 8 4 2 7 5)
(8 4 1 3 6 2 7 5)
(4 8 1 3 6 2 7 5)
(2 6 8 3 1 4 7 5)
(7 2 6 3 1 4 8 5)
(3 6 2 7 1 4 8 5)
(4 7 3 8 2 5 1 6)
(4 8 5 3 1 7 2 6)
(3 5 8 4 1 7 2 6)
(4 2 8 5 7 1 3 6)
(5 7 2 4 8 1 3 6)
(7 4 2 5 8 1 3 6)
(8 2 4 1 7 5 3 6)
(7 2 4 1 8 5 3 6)
(5 1 8 4 2 7 3 6)
(4 1 5 8 2 7 3 6)
(5 2 8 1 4 7 3 6)
(3 7 2 8 5 1 4 6)
(3 1 7 5 8 2 4 6)
(8 2 5 3 1 7 4 6)
(3 5 2 8 1 7 4 6)
(3 5 7 1 4 2 8 6)
(5 2 4 6 8 3 1 7)
(6 3 5 8 1 4 2 7)
(5 8 4 1 3 6 2 7)
(4 2 5 8 6 1 3 7)
(4 6 1 5 2 8 3 7)
(6 3 1 8 5 2 4 7)
(5 3 1 6 8 2 4 7)
(4 2 8 6 1 3 5 7)
(6 3 5 7 1 4 2 8)
(6 4 7 1 3 5 2 8)
(4 7 5 2 6 1 3 8)
(5 7 2 6 3 1 4 8)
;Unspecified return value