scheme - 如何解决Scheme中的N-Queens？

Question

我被困在扩展 exercise 28.2 of How to Design Programs .我使用真值或假值的向量来表示板，而不是使用列表。这是我所拥有的，但不起作用:

#lang Scheme

(define-struct posn (i j))

;takes in a position in i, j form and a board and 
;  returns a natural number that represents the position in index form
;example for board xxx
;                  xxx
;                  xxx
;(0, 1) -> 1
;(2, 1) -> 7
(define (board-ref a-posn a-board)
  (+ (* (sqrt (vector-length a-board)) (posn-i a-posn))
     (posn-j a-posn)))

;reverse of the above function
;1 -> (0, 1)
;7 -> (2, 1)
(define (get-posn n a-board)
  (local ((define board-length (sqrt (vector-length a-board))))
    (make-posn (floor (/ n board-length)) 
               (remainder n board-length))))

;determines if posn1 threatens posn2
;true if they are on the same row/column/diagonal
(define (threatened? posn1 posn2)
  (cond
    ((= (posn-i posn1) (posn-i posn2)) #t)
    ((= (posn-j posn1) (posn-j posn2)) #t)
    ((= (abs (- (posn-i posn1)
                (posn-i posn2)))
        (abs (- (posn-j posn1)
                (posn-j posn2)))) #t)
    (else #f)))

;returns a list of positions that are not threatened or occupied by queens
;basically any position with the value true
(define (get-available-posn a-board)
  (local ((define (get-ava index)
            (cond
              ((= index (vector-length a-board)) '())
              ((vector-ref a-board index)
               (cons index (get-ava (add1 index))))
              (else (get-ava (add1 index))))))
    (get-ava 0)))

;consume a position in the form of a natural number and a board
;returns a board after placing a queen on the position of the board
(define (place n a-board)
  (local ((define (foo x)
            (cond
              ((not (board-ref (get-posn x a-board) a-board)) #f)
              ((threatened? (get-posn x a-board) (get-posn n a-board)) #f)
              (else #t))))
    (build-vector (vector-length a-board) foo)))

;consume a list of positions in the form of natural numbers, and a board
;returns a list of boards after placing queens on each of the positions
;                                                            on the board
(define (place/list alop a-board)
  (cond
    ((empty? alop) '())
    (else (cons (place (first alop) a-board)
                (place/list (rest alop) a-board)))))

;returns a possible board after placing n queens on a-board
;returns false if impossible
(define (placement n a-board)
  (cond
    ((zero? n) a-board)
    (else (local ((define available-posn (get-available-posn a-board)))
            (cond
              ((empty? available-posn) #f)
              (else (or (placement (sub1 n) 
                          (place (first available-posn) a-board))
                        (placement/list (sub1 n) 
                          (place/list (rest available-posn) a-board)))))))))

;returns a possible board after placing n queens on a list of boards
;returns false if all the boards are not valid
(define (placement/list n boards)
  (cond
    ((empty? boards) #f)
    ((zero? n) (first boards))
    ((not (boolean? (placement n (first boards)))) (first boards))
    (else (placement/list n (rest boards)))))

Answer 1

这不是最快的方案实现，但它非常简洁。我确实独立提出了它，但我怀疑它是独一无二的。它在 PLT Scheme 中，因此需要更改一些函数名称才能使其在 R6RS 中运行。解决方案列表和每个解决方案都是用缺点构建的，所以它们是相反的。最后的反转和映射重新排序所有内容并将行添加到解决方案中以获得漂亮的输出。大多数语言都有折叠类型功能，请参阅:
http://en.wikipedia.org/wiki/Fold_%28higher-order_function%29

#lang scheme/base
(define (N-Queens N)  

  (define (attacks? delta-row column solution)
    (and (not (null? solution))
         (or (= delta-row (abs (- column (car solution))))
             (attacks? (add1 delta-row) column (cdr solution)))))  

  (define (next-queen safe-columns solution solutions)
    (if (null? safe-columns)
        (cons solution solutions)
        (let move-queen ((columns safe-columns) (new-solutions solutions))
          (if (null? columns) new-solutions
              (move-queen
                (cdr columns)
                (if (attacks? 1 (car columns) solution) new-solutions
                    (next-queen (remq (car columns) safe-columns)  
                                (cons (car columns) solution)  
                                new-solutions)))))))

  (unless (exact-positive-integer? N)
    (raise-type-error 'N-Queens "exact-positive-integer" N))
  (let ((rows (build-list N (λ (row) (add1 row)))))
    (reverse (map (λ (columns) (map cons rows (reverse columns)))
                  (next-queen (build-list N (λ (i) (add1 i))) null null)))))

如果你考虑这个问题，列表确实是这个问题的自然数据结构。由于每行只能放置一个皇后，因此需要做的就是将安全或未使用的列的列表传递给下一行的迭代器。这是通过在 cond 子句中调用 remq 来完成的，该调用对 next-queen 进行回溯调用。

foldl 函数可以重写为命名的 let:

(define (next-queen safe-columns solution solutions)
  (if (null? safe-columns)
      (cons solution solutions)
      (let move-queen ((columns safe-columns) (new-solutions solutions))
        (if (null? columns) new-solutions
            (move-queen

这要快得多，因为它避免了 foldl 中内置的参数检查开销。在查看 PLT Scheme N-Queens 基准测试时，我想到了使用隐式行的想法。从一个 delta-row 开始并在检查解决方案时增加它是非常光滑的。出于某种原因，PLT 方案中的 abs 很昂贵，所以有一种更快的攻击形式吗？

在 PLT Scheme 中，您必须使用可变列表类型来实现最快的实现。除了初始列列表之外，可以在不创建任何 cons 单元的情况下编写计算解决方案而不返回它们的基准。这避免了在 N = 17 之前收集垃圾，此时 gc 花费了 618 毫秒，而程序花费了 1 小时 51 分钟找到了 95,815,104 个解。