1 (define (test-case actual expected)
10 (define (flatmap proc seq)
11 (fold-right append '() (map proc seq)))
12 (define (enumerate-interval low high)
15 (cons low (enumerate-interval (1+ low) high))))
18 (define (queens board-size)
19 (define (queen-cols k)
23 (lambda (positions) (safe? k positions))
25 (lambda (rest-of-queens)
26 (map (lambda (new-row)
27 (adjoin-position new-row k rest-of-queens))
28 (enumerate-interval 1 board-size)))
29 (queen-cols (- k 1))))))
30 (queen-cols board-size))
32 ;; For example, '((2 4 1 3)) might represent a solution to the 4-queens problem. This represents having queens in col#1 row#2, col#2 row#4, col#3 row#1, col#4 row#3.
33 (define empty-board '())
35 ;; take positions and append new-queen-row in the (new-queen-col - 1)st position in the list
36 (define (adjoin-position new-queen-row new-queen-col positions)
38 (list new-queen-row)))
40 (define (same-row? row other-positions)
41 (fold-left (lambda (result next-row)
48 (define (same-positive-diagonal? row col other-positions)
49 (fold-left (lambda (result row-col-sum)
51 (= (+ row col) row-col-sum)))
53 (map + other-positions (enumerate-interval 1 (- col 1)))))
54 (define (same-negative-diagonal? row col other-positions)
55 (fold-left (lambda (result row-col-dif)
57 (= (- row col) row-col-dif)))
59 (map - other-positions (enumerate-interval 1 (- col 1)))))
61 (define (safe? col positions)
62 (let ((row (list-ref positions (- col 1)))
63 (all-but-last (exclude-last positions)))
64 (not (or (same-row? row all-but-last)
65 (same-positive-diagonal? row col all-but-last)
66 (same-negative-diagonal? row col all-but-last)))))
68 (define (exclude-last list)
69 (cond ((null? list) (error "empty list"))
70 ((null? (cdr list)) '())
71 (else (cons (car list) (exclude-last (cdr list))))))
72 ;; ;;(test-case (exclude-last '()) "error: empty list")
73 ;; (test-case (exclude-last '(1)) '())
74 ;; (test-case (exclude-last '(1 2 3 4)) '(1 2 3))
76 ;; (test-case (adjoin-position 1 1 '()) '(1))
77 ;; (test-case (adjoin-position 2 1 '()) '(2))
78 ;; (test-case (adjoin-position 3 1 '()) '(3))
79 ;; (test-case (adjoin-position 4 1 '()) '(4))
80 ;; (test-case (adjoin-position 1 4 '(2 4 1)) '(2 4 1 1))
81 ;; (test-case (adjoin-position 2 4 '(2 4 1)) '(2 4 1 2))
82 ;; (test-case (adjoin-position 3 4 '(2 4 1)) '(2 4 1 3))
83 ;; (test-case (adjoin-position 4 4 '(2 4 1)) '(2 4 1 4))
85 ;; (test-case (same-row? 1 '()) #f)
86 ;; (test-case (same-row? 1 '(2 4 1)) #t)
87 ;; (test-case (same-row? 2 '(2 4 1)) #t)
88 ;; (test-case (same-row? 3 '(2 4 1)) #f)
89 ;; (test-case (same-row? 4 '(2 4 1)) #t)
90 ;; (test-case (same-row? 4 '(2 4 1)) #t)
91 ;; (test-case (same-row? 1 '(2 4 6 8 3 1)) #t)
92 ;; (test-case (same-row? 2 '(2 4 6 8 3 1)) #t)
93 ;; (test-case (same-row? 3 '(2 4 6 8 3 1)) #t)
94 ;; (test-case (same-row? 4 '(2 4 6 8 3 1)) #t)
95 ;; (test-case (same-row? 5 '(2 4 6 8 3 1)) #f)
96 ;; (test-case (same-row? 6 '(2 4 6 8 3 1)) #t)
97 ;; (test-case (same-row? 7 '(2 4 6 8 3 1)) #f)
98 ;; (test-case (same-row? 8 '(2 4 6 8 3 1)) #t)
103 ;; '(((2 4 1 1) (2 4 1 2) (2 4 1 3) (2 4 1 4)))
104 ;; take '(2 4 1) and append new-queen-row in the (new-queen-col - 1)st position in the list
105 ;; (define (adjoin-position new-queen-row new-queen-col positions)
111 ;; (test-case (same-positive-diagonal? 1 1 '()) #f)
112 ;; (test-case (same-positive-diagonal? 1 4 '(2 4 1)) #f)
113 ;; (test-case (same-positive-diagonal? 2 4 '(2 4 1)) #t)
114 ;; (test-case (same-positive-diagonal? 3 4 '(2 4 1)) #f)
115 ;; (test-case (same-positive-diagonal? 4 4 '(2 4 1)) #f)
116 ;; (test-case (same-positive-diagonal? 1 7 '(2 4 6 8 3 1)) #t)
117 ;; (test-case (same-positive-diagonal? 2 7 '(2 4 6 8 3 1)) #t)
118 ;; (test-case (same-positive-diagonal? 3 7 '(2 4 6 8 3 1)) #f)
119 ;; (test-case (same-positive-diagonal? 4 7 '(2 4 6 8 3 1)) #f)
120 ;; (test-case (same-positive-diagonal? 5 7 '(2 4 6 8 3 1)) #t)
121 ;; (test-case (same-positive-diagonal? 6 7 '(2 4 6 8 3 1)) #f)
122 ;; (test-case (same-positive-diagonal? 7 7 '(2 4 6 8 3 1)) #f)
123 ;; (test-case (same-positive-diagonal? 8 7 '(2 4 6 8 3 1)) #f)
124 ;; (test-case (same-negative-diagonal? 1 1 '()) #f)
125 ;; (test-case (same-negative-diagonal? 1 4 '(2 4 1)) #f)
126 ;; (test-case (same-negative-diagonal? 2 4 '(2 4 1)) #t)
127 ;; (test-case (same-negative-diagonal? 3 4 '(2 4 1)) #f)
128 ;; (test-case (same-negative-diagonal? 4 4 '(2 4 1)) #f)
129 ;; (test-case (same-negative-diagonal? 1 7 '(2 4 6 8 3 1)) #f)
130 ;; (test-case (same-negative-diagonal? 2 7 '(2 4 6 8 3 1)) #t)
131 ;; (test-case (same-negative-diagonal? 3 7 '(2 4 6 8 3 1)) #f)
132 ;; (test-case (same-negative-diagonal? 4 7 '(2 4 6 8 3 1)) #f)
133 ;; (test-case (same-negative-diagonal? 5 7 '(2 4 6 8 3 1)) #t)
134 ;; (test-case (same-negative-diagonal? 6 7 '(2 4 6 8 3 1)) #f)
135 ;; (test-case (same-negative-diagonal? 7 7 '(2 4 6 8 3 1)) #f)
136 ;; (test-case (same-negative-diagonal? 8 7 '(2 4 6 8 3 1)) #t)
138 ;; (test-case (safe? 1 '(1)) #t)
139 ;; (test-case (safe? 4 '(2 4 1 1)) #f)
140 ;; (test-case (safe? 4 '(2 4 1 2)) #f)
141 ;; (test-case (safe? 4 '(2 4 1 3)) #t)
142 ;; (test-case (safe? 4 '(2 4 1 4)) #f)
143 ;; (test-case (safe? 7 '(2 4 6 8 3 1 1)) #f)
144 ;; (test-case (safe? 7 '(2 4 6 8 3 1 2)) #f)
145 ;; (test-case (safe? 7 '(2 4 6 8 3 1 3)) #f)
146 ;; (test-case (safe? 7 '(2 4 6 8 3 1 4)) #f)
147 ;; (test-case (safe? 7 '(2 4 6 8 3 1 5)) #f)
148 ;; (test-case (safe? 7 '(2 4 6 8 3 1 6)) #f)
149 ;; (test-case (safe? 7 '(2 4 6 8 3 1 7)) #t)
150 ;; (test-case (safe? 7 '(2 4 6 8 3 1 8)) #f)
153 ;; The ``eight-queens puzzle'' asks how to place eight queens on a chessboard so that no queen is in check from any other (i.e., no two queens are in the same row, column, or diagonal). One way to solve the puzzle is to work across the board, placing a queen in each column. Once we have placed k - 1 queens, we must place the kth queen in a position where it does not check any of the queens already on the board. We can formulate this approach recursively: Assume that we have already generated the sequence of all possible ways to place k - 1 queens in the first k - 1 columns of the board. For each of these ways, generate an extended set of positions by placing a queen in each row of the kth column. Now filter these, keeping only the positions for which the queen in the kth column is safe with respect to the other queens. This produces the sequence of all ways to place k queens in the first k columns. By continuing this process, we will produce not only one solution, but all solutions to the puzzle.
155 ;; We implement this solution as a procedure queens, which returns a sequence of all solutions to the problem of placing n queens on an n× n chessboard. Queens has an internal procedure queen-cols that returns the sequence of all ways to place queens in the first k columns of the board.
158 ;; In this procedure rest-of-queens is a way to place k - 1 queens in the first k - 1 columns, and new-row is a proposed row in which to place the queen for the kth column. Complete the program by implementing the representation for sets of board positions, including the procedure adjoin-position, which adjoins a new row-column position to a set of positions, and empty-board, which represents an empty set of positions. You must also write the procedure safe?, which determines for a set of positions, whether the queen in the kth column is safe with respect to the others. (Note that we need only check whether the new queen is safe -- the other queens are already guaranteed safe with respect to each other.)
