我被困在扩展的exercise 28.2 of How to Design Programs上。我使用了一个true或false值的向量来表示板而不是使用列表。这就是我所得到的不起作用：
#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)))))
答案 0 :(得分：2)
这不是最快的方案实现，但它非常简洁。我确实独立提出了它，但我怀疑它是独一无二的。它在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行开始，并在检查解决方案时递增它是非常光滑的。出于某种原因，PLT方案中的ABS价格昂贵，因此攻击形式更快？
在PLT Scheme中，您必须使用可变列表类型来实现最快的实现。除了初始列列表之外，可以在不创建任何缺陷单元的情况下编写计算解决方案而不返回它们的基准。这样可以避免收集垃圾，直到N = 17，当gc花费618毫秒时，程序花费1小时，51分钟找到95,815,104个解决方案。
答案 1 :(得分：1)
这又是我。过去几天我一直在思考和痛苦地回答这个问题，最终得到了答案。
因为没有人回答这个问题。我会在这里发帖给那些可能会觉得有帮助的人。
对于那些好奇的人，我正在使用DrScheme。
以下是代码。
#lang scheme
;the code between the lines is a graph problem
;it is adapted into the n-queens problem later
;-------------------------------------------------------------------------------------------------------------------------
(define (neighbors node graph)
(cond
((empty? graph) '())
((symbol=? (first (first graph)) node)
(first (rest (first graph))))
(else (neighbors node (rest graph)))))
;; find-route : node node graph -> (listof node) or false
;; to create a path from origination to destination in G
;; if there is no path, the function produces false
(define (find-route origination destination G)
(cond
[(symbol=? origination destination) (list destination)]
[else (local ((define possible-route
(find-route/list (neighbors origination G) destination G)))
(cond
[(boolean? possible-route) false]
[else (cons origination possible-route)]))]))
;; find-route/list : (listof node) node graph -> (listof node) or false
;; to create a path from some node on lo-Os to D
;; if there is no path, the function produces false
(define (find-route/list lo-Os D G)
(cond
[(empty? lo-Os) false]
[else (local ((define possible-route (find-route (first lo-Os) D G)))
(cond
[(boolean? possible-route) (find-route/list (rest lo-Os) D G)]
[else possible-route]))]))
(define Graph
'((A (B E))
(B (E F))
(C (D))
(D ())
(E (C F))
(F (D G))
(G ())))
;test
(find-route 'A 'G Graph)
;-------------------------------------------------------------------------------------------------------------------------
; the chess board is represented by a vector (aka array) of #t/#f/'q values
; #t represents a position that is not occupied nor threatened by a queen
; #f represents a position that is threatened by a queen
; 'q represents a position that is occupied by a queen
; an empty chess board of n x n can be created by (build-vector (* n n) (lambda (x) #t))
; returns the board length of a-board
; eg. returns 8 if the board is an 8x8 board
(define (board-length a-board)
(sqrt (vector-length a-board)))
; returns the row of the index on a-board
(define (get-row a-board index)
(floor (/ index (board-length a-board))))
; returns the column of the index on a-board
(define (get-column a-board index)
(remainder index (board-length a-board)))
; returns true if the position refered to by index n1 threatens the position refered to by index n2 and vice-versa
; true if n1 is on the same row/column/diagonal as n2
(define (threatened? a-board n1 n2)
(cond
((= (get-row a-board n1) (get-row a-board n2)) #t)
((= (get-column a-board n1) (get-column a-board n2)) #t)
((= (abs (- (get-row a-board n1) (get-row a-board n2)))
(abs (- (get-column a-board n1) (get-column a-board n2)))) #t)
(else #f)))
;returns a board after placing a queen on index n on a-board
(define (place-queen-on-n a-board n)
(local ((define (foo x)
(cond
((= n x) 'q)
((eq? (vector-ref a-board x) 'q) 'q)
((eq? (vector-ref a-board x) #f) #f)
((threatened? a-board n x ) #f)
(else #t))))
(build-vector (vector-length a-board) foo)))
; returns the possitions that are still available on a-board
; basically returns positions that has the value #t
(define (get-possible-posn a-board)
(local ((define (get-ava index)
(cond
((= index (vector-length a-board)) '())
((eq? (vector-ref a-board index) #t)
(cons index (get-ava (add1 index))))
(else (get-ava (add1 index))))))
(get-ava 0)))
; returns a list of boards after placing a queen on a-board
; this function acts like the function neighbors in the above graph problem
(define (place-a-queen a-board)
(local ((define (place-queen lop)
(cond
((empty? lop) '())
(else (cons (place-queen-on-n a-board (first lop))
(place-queen (rest lop)))))))
(place-queen (get-possible-posn a-board))))
; main function
; this function acts like the function find-route in the above graph problem
(define (place-n-queens origination destination a-board)
(cond
((= origination destination) a-board)
(else (local ((define possible-steps
(place-n-queens/list (add1 origination)
destination
(place-a-queen a-board))))
(cond
((boolean? possible-steps) #f)
(else possible-steps))))))
; this function acts like the function find-route/list in the above graph problem
(define (place-n-queens/list origination destination boards)
(cond
((empty? boards) #f)
(else (local ((define possible-steps
(place-n-queens origination
destination
(first boards))))
(cond
((boolean? possible-steps)
(place-n-queens/list origination
destination
(rest boards)))
(else possible-steps))))))
;test
;place 8 queens on an 8x8 board
(place-n-queens 0 8 (build-vector (* 8 8) (lambda (x) #t)))
答案 2 :(得分：1)
这是从大约11年前我有一个函数式编程类，我认为这是使用MIT方案或mzScheme。大多数情况下，它只是我们使用的Springer / Friedman文本的修改，刚刚解决了8个皇后。这个练习是为N皇后推广它，这个代码就是这样。
;_____________________________________________________
;This function tests to see if the next attempted move (try)
;is legal, given the list that has been constructed thus far
;(if any) - legal-pl (LEGAL PLacement list)
;N.B. - this function is an EXACT copy of the one from
;Springer and Friedman
(define legal?
(lambda (try legal-pl)
(letrec
((good?
(lambda (new-pl up down)
(cond
((null? new-pl) #t)
(else (let ((next-pos (car new-pl)))
(and
(not (= next-pos try))
(not (= next-pos up))
(not (= next-pos down))
(good? (cdr new-pl)
(add1 up)
(sub1 down)))))))))
(good? legal-pl (add1 try) (sub1 try)))))
;_____________________________________________________
;This function tests the length of the solution to
;see if we need to continue "cons"ing on more terms
;or not given to the specified board size.
;
;I modified this function so that it could test the
;validity of any solution for a given boardsize.
(define solution?
(lambda (legal-pl boardsize)
(= (length legal-pl) boardsize)))
;_____________________________________________________
;I had to modify this function so that it was passed
;the boardsize in its call, but other than that (and
;simply replacing "fresh-start" with boardsize), just
;about no changes were made. This function simply
;generates a solution.
(define build-solution
(lambda (legal-pl boardsize)
(cond
((solution? legal-pl boardsize) legal-pl)
(else (forward boardsize legal-pl boardsize)))))
;_____________________________________________________
;This function dictates how the next solution will be
;chosen, as it is only called when the last solution
;was proven to be legal, and we are ready to try a new
;placement.
;
;I had to modify this function to include the boardsize
;as well, since it invokes "build-solution".
(define forward
(lambda (try legal-pl boardsize)
(cond
((zero? try) (backtrack legal-pl boardsize))
((legal? try legal-pl) (build-solution (cons try legal-pl) boardsize))
(else (forward (sub1 try) legal-pl boardsize)))))
;_____________________________________________________
;This function is used when the last move is found to
;be unhelpful (although valid) - instead it tries another
;one until it finds a new solution.
;
;Again, I had to modify this function to include boardsize
;since it calls "forward", which has boardsize as a
;parameter due to the "build-solution" call within it
(define backtrack
(lambda (legal-pl boardsize)
(cond
((null? legal-pl) '())
(else (forward (sub1 (car legal-pl)) (cdr legal-pl) boardsize)))))
;_____________________________________________________
;This is pretty much the same function as the one in the book
;with just my minor "boardsize" tweaks, since build-solution
;is called.
(define build-all-solutions
(lambda (boardsize)
(letrec
((loop (lambda (sol)
(cond
((null? sol) '())
(else (cons sol (loop (backtrack sol boardsize))))))))
(loop (build-solution '() boardsize)))))
;_____________________________________________________
;This function I made up entirely myself, and I only
;made it really to satisfy the syntactical limitations
;of the laboratory instructions. This makes it so that
;the input of "(queens 4)" will return a list of the
;two possible configurations that are valid solutions,
;even though my modifiend functions would return the same
;value by simply inputting "(build-all-solutions 4)".
(define queens
(lambda (n)
(build-all-solutions n)))
答案 3 :(得分：0)
观看大师（Hal Ableson）这样做：