如何在计划中解决N皇后问题？

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

这是我再次。过去几天我一直在思考和苦苦思索这个问题，最终得到了答案。

由于没有人回答这个问题。我会在这里发布给那些可能会发现它有帮助的人。

对于那些好奇的人，我正在使用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))) 

Answer 2

这是大约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))) 

Answer 3

这不是最快的方案实现可能，但它非常简洁。我确实独立了，但我怀疑它是独一无二的。它在PLT方案中，因此需要更改一些函数名称以使其在R6RS中运行。解决方案和每个解决方案的列表均以cons为基础构建，因此它们被颠倒过来。最后的反转和贴图重新排列所有内容，并向解决方案添加行以获得漂亮的输出。大多数语言都有一个折叠式的功能，请参阅：
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来完成的，该调用使回拨呼叫到下一个皇后。

的与foldl函数可以被改写为一个名为令：

(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基准时，我遇到了使用隐式行的想法。从一个增量行开始，在检查解决方案时递增它非常灵活。由于某些原因，PLT计划中ABS的价格昂贵，所以攻击的形式更快？

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

Answer 4

观看主（HAL Ableson）做到这一点：

http://www.youtube.com/watch?v=skd-nyVyzBQ