先實(shí)現(xiàn)一個(gè)產(chǎn)生特定順序序列的庫(kù)
(library (range)
(export range make-range)
(import (chezscheme))
(define make-range
(lambda (first last delta)
(if (= delta 0)
(error 'delta "make-range arg 3 must not be zero!"))
(if (= first last)
(list first)
(let ([cmp (cond
[(< first last) >]
[(> first last) <])])
(set! last (+ first (* (fx/ (- last first) delta) delta)))
(if (cmp delta 0)
(do ([last last (- last delta)]
[range '() (cons last range)])
[(cmp first last) range])
'())))))
; 只適合用來(lái)產(chǎn)生一個(gè)序列矢棚，不適合用于循環(huán)的迭代
(define range
(case-lambda
[(n) (make-range 0 n 1)]
[(n1 n2) (make-range n1 n2 1)]
[(n1 n2 delta) (if (= delta 0)
(error 'delta "range arg 3 must not be zero!")
(make-range n1 n2 delta))])))
定義一個(gè)高階函數(shù)，將一個(gè)過(guò)程作用于一個(gè)序列府喳，將產(chǎn)生的多個(gè)序列合并為一個(gè)序列蒲肋。
(define (flatmap proc seq)
(fold-right append '() (map proc seq)))
現(xiàn)在來(lái)實(shí)現(xiàn)求解皇后問(wèn)題的函數(shù)。
(import (range))
(define (queens board-size)
(define col car) ;取得當(dāng)前位置的列數(shù)
(define row cdr) ;取得當(dāng)前位置的行數(shù)
(define (queen-cols k)
(define (safe-range k k-1cols)
(let ([r (range 1 board-size)])
(for-each
(lambda (pos) ;移除對(duì)角線上的queens和已經(jīng)存在的行數(shù)
(let ([dx (- k (col pos))][y (row pos)])
(set! r (remove! (- y dx) (remove! (+ y dx) (remove! y r))))))
k-1cols)
; (printf "~a => ~a" k-1cols r)
r))
(if (= k 0)
(list '())
(flatmap (lambda (less-queens)
(map (lambda (new-row) ;列在前，行在后
(cons (cons k new-row) less-queens))
(safe-range k less-queens)))
(queen-cols (- k 1))))) ;遞歸生成前k-1列的所有不攻擊的格局
(map (lambda (x) (reverse (map row x))) (queen-cols board-size)))
打印結(jié)果兜粘，可以看到申窘，皇后問(wèn)題有
個(gè)解。
(let ([queen8 (queens 8)])
(pretty-print queen8)
(printf "~a\n" (length queen8)))
