1 665c255d 2023-08-04 jrmu (define (test-case actual expected)
3 665c255d 2023-08-04 jrmu (display "Actual: ")
4 665c255d 2023-08-04 jrmu (display actual)
6 665c255d 2023-08-04 jrmu (display "Expected: ")
7 665c255d 2023-08-04 jrmu (display expected)
10 665c255d 2023-08-04 jrmu (define (flatmap proc seq)
11 665c255d 2023-08-04 jrmu (fold-right append '() (map proc seq)))
13 665c255d 2023-08-04 jrmu (define (queens board-size)
14 665c255d 2023-08-04 jrmu (define (queen-cols k)
16 665c255d 2023-08-04 jrmu (list empty-board)
18 665c255d 2023-08-04 jrmu (lambda (positions) (safe? k positions))
20 665c255d 2023-08-04 jrmu (lambda (rest-of-queens)
21 665c255d 2023-08-04 jrmu (map (lambda (new-row)
22 665c255d 2023-08-04 jrmu (adjoin-position new-row k rest-of-queens))
23 665c255d 2023-08-04 jrmu (enumerate-interval 1 board-size)))
24 665c255d 2023-08-04 jrmu (queen-cols (- k 1))))))
25 665c255d 2023-08-04 jrmu (queen-cols board-size))
27 665c255d 2023-08-04 jrmu ;; 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.
28 665c255d 2023-08-04 jrmu (define empty-board '())
30 665c255d 2023-08-04 jrmu ;; take positions and append new-queen-row in the (new-queen-col - 1)st position in the list
31 665c255d 2023-08-04 jrmu (define (adjoin-position new-queen-row new-queen-col positions)
32 665c255d 2023-08-04 jrmu (append positions
33 665c255d 2023-08-04 jrmu (list new-queen-row)))
35 665c255d 2023-08-04 jrmu (define (same-row? row other-positions)
36 665c255d 2023-08-04 jrmu (fold-left (lambda (result next-row)
38 665c255d 2023-08-04 jrmu (= next-row row)))
40 665c255d 2023-08-04 jrmu other-positions))
42 665c255d 2023-08-04 jrmu (define (enumerate-interval low high)
43 665c255d 2023-08-04 jrmu (if (> low high)
45 665c255d 2023-08-04 jrmu (cons low (enumerate-interval (1+ low) high))))
47 665c255d 2023-08-04 jrmu (define (same-positive-diagonal? row col other-positions)
48 665c255d 2023-08-04 jrmu (fold-left (lambda (result row-col-sum)
50 665c255d 2023-08-04 jrmu (= (+ row col) row-col-sum)))
52 665c255d 2023-08-04 jrmu (map + other-positions (enumerate-interval 1 (- col 1)))))
53 665c255d 2023-08-04 jrmu (define (same-negative-diagonal? row col other-positions)
54 665c255d 2023-08-04 jrmu (fold-left (lambda (result row-col-dif)
56 665c255d 2023-08-04 jrmu (= (- row col) row-col-dif)))
58 665c255d 2023-08-04 jrmu (map - other-positions (enumerate-interval 1 (- col 1)))))
60 665c255d 2023-08-04 jrmu (define (safe? col positions)
61 665c255d 2023-08-04 jrmu (let ((row (list-ref positions (- col 1)))
62 665c255d 2023-08-04 jrmu (all-but-last (exclude-last positions)))
63 665c255d 2023-08-04 jrmu (not (or (same-row? row all-but-last)
64 665c255d 2023-08-04 jrmu (same-positive-diagonal? row col all-but-last)
65 665c255d 2023-08-04 jrmu (same-negative-diagonal? row col all-but-last)))))
67 665c255d 2023-08-04 jrmu (define (exclude-last list)
68 665c255d 2023-08-04 jrmu (cond ((null? list) (error "empty list"))
69 665c255d 2023-08-04 jrmu ((null? (cdr list)) '())
70 665c255d 2023-08-04 jrmu (else (cons (car list) (exclude-last (cdr list))))))
71 665c255d 2023-08-04 jrmu ;; ;;(test-case (exclude-last '()) "error: empty list")
72 665c255d 2023-08-04 jrmu ;; (test-case (exclude-last '(1)) '())
73 665c255d 2023-08-04 jrmu ;; (test-case (exclude-last '(1 2 3 4)) '(1 2 3))
75 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 1 1 '()) '(1))
76 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 2 1 '()) '(2))
77 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 3 1 '()) '(3))
78 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 4 1 '()) '(4))
79 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 1 4 '(2 4 1)) '(2 4 1 1))
80 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 2 4 '(2 4 1)) '(2 4 1 2))
81 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 3 4 '(2 4 1)) '(2 4 1 3))
82 665c255d 2023-08-04 jrmu ;; (test-case (adjoin-position 4 4 '(2 4 1)) '(2 4 1 4))
84 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 1 '()) #f)
85 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 1 '(2 4 1)) #t)
86 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 2 '(2 4 1)) #t)
87 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 3 '(2 4 1)) #f)
88 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 4 '(2 4 1)) #t)
89 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 4 '(2 4 1)) #t)
90 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 1 '(2 4 6 8 3 1)) #t)
91 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 2 '(2 4 6 8 3 1)) #t)
92 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 3 '(2 4 6 8 3 1)) #t)
93 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 4 '(2 4 6 8 3 1)) #t)
94 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 5 '(2 4 6 8 3 1)) #f)
95 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 6 '(2 4 6 8 3 1)) #t)
96 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 7 '(2 4 6 8 3 1)) #f)
97 665c255d 2023-08-04 jrmu ;; (test-case (same-row? 8 '(2 4 6 8 3 1)) #t)
100 665c255d 2023-08-04 jrmu ;; '((2 4 1))
101 665c255d 2023-08-04 jrmu ;; '((1 2 3 4))
102 665c255d 2023-08-04 jrmu ;; '(((2 4 1 1) (2 4 1 2) (2 4 1 3) (2 4 1 4)))
103 665c255d 2023-08-04 jrmu ;; take '(2 4 1) and append new-queen-row in the (new-queen-col - 1)st position in the list
104 665c255d 2023-08-04 jrmu ;; (define (adjoin-position new-queen-row new-queen-col positions)
106 665c255d 2023-08-04 jrmu ;; '(2 4 1)
107 665c255d 2023-08-04 jrmu ;;+ '(1 2 3)
108 665c255d 2023-08-04 jrmu ;;==========
109 665c255d 2023-08-04 jrmu ;; '(3 6 4)
110 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 1 1 '()) #f)
111 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 1 4 '(2 4 1)) #f)
112 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 2 4 '(2 4 1)) #t)
113 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 3 4 '(2 4 1)) #f)
114 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 4 4 '(2 4 1)) #f)
115 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 1 7 '(2 4 6 8 3 1)) #t)
116 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 2 7 '(2 4 6 8 3 1)) #t)
117 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 3 7 '(2 4 6 8 3 1)) #f)
118 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 4 7 '(2 4 6 8 3 1)) #f)
119 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 5 7 '(2 4 6 8 3 1)) #t)
120 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 6 7 '(2 4 6 8 3 1)) #f)
121 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 7 7 '(2 4 6 8 3 1)) #f)
122 665c255d 2023-08-04 jrmu ;; (test-case (same-positive-diagonal? 8 7 '(2 4 6 8 3 1)) #f)
123 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 1 1 '()) #f)
124 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 1 4 '(2 4 1)) #f)
125 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 2 4 '(2 4 1)) #t)
126 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 3 4 '(2 4 1)) #f)
127 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 4 4 '(2 4 1)) #f)
128 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 1 7 '(2 4 6 8 3 1)) #f)
129 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 2 7 '(2 4 6 8 3 1)) #t)
130 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 3 7 '(2 4 6 8 3 1)) #f)
131 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 4 7 '(2 4 6 8 3 1)) #f)
132 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 5 7 '(2 4 6 8 3 1)) #t)
133 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 6 7 '(2 4 6 8 3 1)) #f)
134 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 7 7 '(2 4 6 8 3 1)) #f)
135 665c255d 2023-08-04 jrmu ;; (test-case (same-negative-diagonal? 8 7 '(2 4 6 8 3 1)) #t)
137 665c255d 2023-08-04 jrmu ;; (test-case (safe? 1 '(1)) #t)
138 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 1)) #f)
139 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 2)) #f)
140 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 3)) #t)
141 665c255d 2023-08-04 jrmu ;; (test-case (safe? 4 '(2 4 1 4)) #f)
142 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 1)) #f)
143 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 2)) #f)
144 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 3)) #f)
145 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 4)) #f)
146 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 5)) #f)
147 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 6)) #f)
148 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 7)) #t)
149 665c255d 2023-08-04 jrmu ;; (test-case (safe? 7 '(2 4 6 8 3 1 8)) #f)
152 665c255d 2023-08-04 jrmu ;; 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.
154 665c255d 2023-08-04 jrmu ;; 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.
157 665c255d 2023-08-04 jrmu ;; 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.)
