Scheme解八皇后问题

先实现一个产生特定顺序序列的库

(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])
                '())))))
  ; 只适合用来产生一个序列，不适合用于循环的迭代
  (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))])))

定义一个高阶函数，将一个过程作用于一个序列，将产生的多个序列合并为一个序列。

(define (flatmap proc seq)
  (fold-right append '() (map proc seq)))

现在来实现求解皇后问题的函数。

(import (range))

(define (queens board-size)
  (define col car)  ;取得当前位置的列数
  (define row cdr)  ;取得当前位置的行数
  (define (queen-cols k)
    (define (safe-range k k-1cols)
      (let ([r (range 1 board-size)])
        (for-each
          (lambda (pos)  ;移除对角线上的queens和已经存在的行数
            (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)))

打印结果，可以看到，皇后问题有个解。

(let ([queen8 (queens 8)])
  (pretty-print queen8)
  (printf "~a\n" (length queen8)))