如何解决Scheme中的N皇后问题？

发布于 2024-08-28 12:55:22 字数 3266 浏览 5 评论 0原文

我陷入了扩展练习 28.2如何设计程序。我使用真值或假值向量来表示棋盘，而不是使用列表。这是我所得到的，但不起作用：

#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)))))

原文

I'm stuck on the extended exercise 28.2 of How to Design Programs. I used a vector of true or false values to represent the board instead of using a list. This is what I've got which doesn't work:

#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)))))

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

亽野灬性zι浪 2024-09-04 12:55:22

这不是最快的方案实现，但它非常简洁。我确实独立想出了它，但我怀疑它是否独特。它采用 PLT 方案，因此需要更改一些函数名称才能使其在 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 方案 N-Queens 基准时想到了使用隐式行的想法。从增量行 1 开始，并在检查解决方案时递增它，这是非常巧妙的。由于某种原因，abs在PLT方案中很昂贵，所以有更快的攻击形式吗？

在PLT方案中，您必须使用可变列表类型才能实现最快的实现。可以编写对解决方案进行计数而不返回解决方案的基准，而无需创建除初始列列表之外的任何缺点单元格。这可以避免收集垃圾，直到 N = 17，此时 gc 花费了 618 毫秒，而程序花费了 1 小时 51 分钟找到 95,815,104 个解决方案。

This isn't the fastest scheme implementation possible, but it's pretty concise. I did come up with it independently, but I doubt it's unique. It's in PLT Scheme, so some function names need to be changed to get it running in R6RS. The list of solutions and each solution are built with cons, so they're reversed. The reverses and maps at the end reorder everything and add rows to the solutions for a pretty output. Most languages have a fold type function, see:
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)))))

If you think about the problem, a list is really the natural data structure for this problem. Since only one queen can be placed on each row, all that needs to be done is pass a list of safe or unused columns to the iterator for the next row. This is done with the call to remq in the cond clause that makes the backtracking call to next-queen.

The foldl function can be rewritten as a named 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

This is considerably faster, since it avoids the argument checking overhead built into foldl. I came across the idea of using implicit rows while looking at the PLT Scheme N-Queens benchmark. Starting with a delta-row of one and incrementing it as the solution is checked is pretty slick. For some reason, abs is expensive in PLT Scheme, so there is a faster form for attacks?

In PLT Scheme, you have to use the mutable list type for the fastest implementation. A benchmark that counts solutions without returning them can be written without creating any cons cells, other than the initial column list. This avoids collecting garbage until N = 17, when 618 milliseconds were spent in gc while the program spent 1 hour, 51 minutes finding the 95,815,104 solutions.

回复收藏 0 原文

情栀口红 2024-09-04 12:55:22

又是我。这几天我一直在思考和苦恼这个问题，终于得到了答案。

由于没有人回答这个问题。我只是将其发布在这里，以供那些可能认为它有帮助的人使用。

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

It's me again. I've been thinking and agonizing over the question for the past few days and finally got the answer.

Since no one has answered the question. I'll just post it here for those who might find it helpful.

For those who are curious, I'm using DrScheme.

Below is the code.

#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)))

回复收藏 0 原文

流绪微梦 2024-09-04 12:55:22

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

This is from about 11 years ago when I had a functional programming class, and I think this was using either MIT scheme or mzScheme. Mostly it's just modifications from the Springer/Friedman text that we used which just solved for 8 queens. The exercise was to generalize it for N queens, which this code does.

;_____________________________________________________
;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)))

回复收藏 0 原文