<< Previous exercise (2.41) | Index | Next exercise (2.43) >>
Something missing from some of the other solutions is that the book specifically tells you not to check for every queen in safe?, but just for the queen in the kth column. Also, building the rows and columns and checking if they include the placed queens or not is overkill:
With this in mind, the solution is quite straightforward.
(define empty-board nil) (define (adjoin-position new-row k rest-of-queens) (cons (list new-row k) rest-of-queens)) (define (queen-in-k k positions) (cond ((null? positions) nil) ((= (cadar positions) k) (car positions)) (else (queen-in-k k (cdr positions))))) (define (queens-not-k k positions) (cond ((null? positions) nil) ((= (cadar positions) k) (cdr positions)) (else (cons (car positions) (queens-not-k k (cdr positions)))))) (define (safe? k positions) (let ((queen-k (queen-in-k k positions)) (o-queens (queens-not-k k positions))) (null? (filter (lambda (o-q) (or (= (car o-q) (car queen-k)) (= (- (car o-q) (cadr o-q)) (- (car queen-k) (cadr queen-k))) (= (+ (car o-q) (cadr o-q)) (+ (car queen-k) (cadr queen-k))))) o-queens))))
My code may be improvable in many ways, but I'd like to submit it as it provides a solution along the lines laid down in the exercise.
Most of the sweat in this exercise comes from deciphering the code skeleton the authors provided, then working out what data structures they had in mind. That is to say, it's more of a puzzle to solve than a task to complete. I'll provide some hints based on my understanding of the exercise, followed by full code in Racket that incorporates the queens function as written in SICP.
Here's what I'm pretty sure they were driving at: the highest-level data structure is a list of board configurations. Each board configuration is a list of (x, y) coordinates locating a single queen. So the solution to (queens 1) is (((1 1)))--a single board configuration containing a single queen-coordinate. I found the word "position" really confusing, as especially in chess, "position" is often used to talk about the overall board configuration--so I used the term "coordinate" in my functions to talk about the location of an individual piece.
You will want functions to build a coordinate from a row and a column and retrieve the row or column from a coordinate, all along the lines of data structures from earlier exercises.
You might start with a dummy version of safe? that just returns #t--this will let you see that your program is building all the board combinations with one queen per column before filtering out just the ones that solve the puzzle.
When you turn your attention to safe?, what they seem to want you to do is pluck out the coordinate for the queen on a given column, and test it against each of the remaining coordinates. This can be done with an "accumulate" style function; I used the foldr that is built into Racket (and has it's parameters in a different order from standard Scheme, so beware!).
#lang racket (define (enumerate-interval low high) (cond ((> low high) null) ((= low high) (list high)) (else (cons low (enumerate-interval (+ 1 low) high))))) (define (flatmap proc seq) (foldr append null (map proc seq))) (define empty-board null) (define (safe? test-column positions) ;is the coordinate in the set of positions with the given column ;"safe" with respect to all the other coordinates (that is, does not ;sit on the same row or diagonal with any other coordinate)? ;we assume all the other coordinates are already safe with respect ;to each other (define (two-coordinate-safe? coordinate1 coordinate2) (let ((row1 (row coordinate1)) (row2 (row coordinate2)) (col1 (column coordinate1)) (col2 (column coordinate2))) (if (or (= row1 row2) (= (abs (- row1 row2)) (abs (- col1 col2)))) #f #t))) (let ((test-coordinate (get-coordinate-by-column test-column positions))) ;check the test coordinate pairwise against every other coordinate, ;rolling the results up with an "and," and seeding the and with ;an initial "true" value (because a list with one coordinate is ;always "safe" (foldr (lambda (coordinate results) (and (two-coordinate-safe? test-coordinate coordinate) results)) #t (remove test-coordinate positions)))) (define (adjoin-position new-row new-column existing-positions) (cons (make-coordinate new-row new-column) existing-positions)) (define (make-coordinate row column) (list row column)) (define (row coordinate) (car coordinate)) (define (column coordinate) (cadr coordinate)) (define (get-coordinate-by-column target-column coordinates) (cond ((null? coordinates) null) ((= target-column (column (car coordinates))) (car coordinates)) (else (get-coordinate-by-column target-column (cdr coordinates))))) (define (queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size))
You can use (length (queens x)) to easily count the number of solutions returned. There is one solution to (queens 1), zero to (queens 2) and (queens 3), two to (queens 4), and 92 to (queens 8).
Like the anonymous fellow below, I represented each row of the chessboard as a single number from 1 to 8. So a "board" would just be a list of 8 numbers.
This means adjoin-position can just `cons` a number onto a list and empty-board is just the empty list
(define (adjoin-position new-row rest-of-queens) (cons new-row rest-of-queens)) (define empty-board '())
Instead of deciding if a new row is "safe" before pushing it onto the board (as I think the authors of the SICP intended) I'm just going to push a row onto the board and then pass the whole board into `safe?`. `safe?` will then check the `car` of the board against the other rows in the board. This means our `safe?` procedure only needs to take one argument:
(define (safe? board)
; `queen` is the position of the last queen to be pushed onto the board
; Conveniently, it does not need to change during this procedure
(let ((queen (car board)))
; As we `cdr` down our board, we need to check "down" and "diagonally"
; Since "down" is always the same, we can just use `queen`
; The right diagonal is just `(- queen 1)` and the left diagonal is
; (+ queen 1). When we call `iter` again the right and left diagonals
; will be incremented and decremented.
; If we make it through the whole list, that means that neither our
; queen nor its diagonals matched a position in the board, so we return
; true.
(define (iter rest-of-board right-diagonal left-diagonal)
(cond
((null? rest-of-board) #t)
((= queen (car rest-of-board)) #f)
((= right-diagonal (car rest-of-board)) #f)
((= left-diagonal (car rest-of-board)) #f)
(else
(iter
(cdr rest-of-board)
(+ right-diagonal -1)
(+ left-diagonal 1)))))
; I'm adding -1 because I don't like non-commutative operations
(iter (cdr board) (+ queen -1) (+ queen 1))))
I didn't use k for functions `adjoin-position` or `safe?` and to be honest, I have no idea how I was supposed to use k in `adjoin-position`. This problem was like one of those disturbing Ikea furniture sets that have parts left over when you finish building it that just make you wonder "what was I supposed to do with that?" `k` is really handy for tracking the size of the board, though.
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
; All of this stuff is exactly what's in the book, sans `k`
(list empty-board)
(filter
(lambda (positions) (safe? positions))
(flatmap
(lambda (rest-of-queens)
(map (lambda (new-row)
(adjoin-position new-row rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (+ k -1))))))
(queen-cols board-size))
I got up to (queens 13). There are 73,712 solutions out of ~10^14 possible boards. I tried to do (queens 14) run but I got bored after a few minutes and stopped the program.
I'm using a representation like below:
(((row1 col1) (row2 col2) ...) ......)
It's a list of all solutions, where a solution is a list of coordinates, where a coordinate is (list row col).
So empty-board and adjoin-position can be defined as follows:
(define empty-board '()) (define (adjoin-position row col rest) (cons (list row col) rest))
The safe? procedure is a little complex:
(define (safe? k positions)
(let ((trial (car positions))
(trial-row (caar positions))
(trial-col (cadar positions))
(rest (cdr positions)))
(accumulate (lambda (pos result)
(let ((row (car pos))
(col (cadr pos)))
(and (not (= (- trial-row trial-col)
(- row col)))
(not (= (+ trial-row trial-col)
(+ row col)))
(not (= trial-row row))
result)))
true
rest)))
I'm not using any procedures that are beyond the textbook, and the parameter k is not necessary here.
This method generates all 92 solutions. It will work up to (queens 9) but runs out of memory for (queens 10).
A position is represented as an ordered list 8 numbers eg (1 3 6 8 2 4 9 7 5), which denotes queen positions row 1 col 1, row 2 col 3,...,row 8 col 5
Check-row tests a row against the succeeding rows to make sure no two queens share a diagonal.
(define (queens n)
(define (check-row p k)
(define (iter k count)
(cond ((= count (+ n 1)) true)
(else (if (or (= (abs (- count
k))
(abs (- (list-ref p (- count 1))
(list-ref p (- k 1)))))
(= (+ k
(list-ref p (- k 1)))
(+ count
(list-ref p (- count 1)))))
false
(iter k (+ count 1))))))
(iter k (+ k 1)))
(define (check p)
(define (iter p count)
(cond ((= count n) true)
(else (if (not (check-row p count))
false
(iter p (+ count 1))))))
(iter p 1))
(filter (lambda (x) (check x))
(permutations (enumerate-interval 1 n))))
(queens 8)
(just for further interest) I searched on wikipedia and it defines the "fundamental solutions" of the n queens puzzle as the solutions that cannot be converted into each other by rotation or reflection. Hence I wrote a procedure "fundamental-queens" to find the fundamental solutions. I regard a solution of the puzzle as the one ssublist of the list generated by the "queens" procedure in the textbook.
(define (member? equiv? x lst) ;use EQUIV? to determine whether X is equivalent to some element in LST (accumulate (lambda (x y) (or x y)) ;I wonder why I cannot directly use "or" here #f (map (lambda (y) (equiv? x y)) lst))) (define (select-distinct equiv? lst) ;select all the distinct elements in the LST, using EQUIV? to judge whether two elements are equivalent (define (iter set lst) (cond ((null? lst) set) ((member? equiv? (car lst) set) (iter set (cdr lst))) (else (iter (cons (car lst) set) (cdr lst))))) (iter nil lst)) (define (queens-sol-eq? sol1 sol2) ;determine whether two solutions SOL1 and SOL2 of queens problem are equivalent (define board-size (length sol1)) (define (reflect sol) (reverse-fl sol)) (define (find-col row sol) ;find which column the queen is in (define (iter k cols) (if (eq? row (car cols)) k (iter (inc k) (cdr cols)))) (iter 1 sol)) (define (rot90 sol) ;rotate by 90 degrees (map (lambda (pos) (- (+ board-size 1) (find-col pos sol))) (enumerate-interval 1 board-size))) (define (rot180 sol) (rot90 (rot90 sol))) (define (rot270 sol) (rot90 (rot180 sol))) (define (symmetry-group sol) (let ((ref (reflect sol))) (list sol (rot90 sol) (rot180 sol) (rot270 sol) ref (rot90 ref) (rot180 ref) (rot270 ref)))) (member? equal? sol1 (symmetry-group sol2))) (define (fundamental-queens board-size) (select-distinct queens-sol-eq? (queens board-size))) #|tests: > (length (fundamental-queens 8)) 12 > (length (queens 8)) 92 > (length (fundamental-queens 6)) 1 > (length (queens 6)) 4 These give the same results as in Wikipedia. |#
Assume you have all possible queens configurations for the first k-1 columns. This is represented as a list of lists of pairs. Each list of pairs is a single queens configuration for k-1 columns that contain no checks. generate-next-col-candidates uses adjoin-position to create a candidate configuration from each of the queens configurations, with one new queen position consed to the front of each existing configuration. Note that this means for an 8 row board, the number of candidates will be 8 times the previous configurations!
Each of the candidate configurations is filtered by safe?. Safe extracts the new queen position from the front. Then it uses checks? (see below) to look for checks with the remaining queens. Any candidate configuration that passes through the filter then becomes a safe'd configuration in the next recursion.
Like others above, I found no use in passing k to safe-candidate?
(define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) (define (flatmap proc seq) (accumulate append '() (map proc seq))) (define (enumerate-interval low high) (if (> low high) '() (cons low (enumerate-interval (+ 1 low) high)))) (define (check-pos-pos? p1 p2) (or (same-row? p1 p2) (same-col? p1 p2) (same-diag? p1 p2))) (define (same-diag? p1 p2) (= (abs (- (car p1) (car p2))) (abs (- (cdr p1) (cdr p2))))) (define (same-col? p1 p2) (= (cdr p1) (cdr p2))) (define (same-row? p1 p2) (= (car p1) (car p2))) ;; Add one candidate position to front of earlier ;; solution (singular) for rest-of-queens (define (adjoin-position row col queens-config) (cons (cons row col) queens-config)) ;; rest-of-queens is a list of list queens-configs. Each queens-config is a ;; solution for the columns checked so far. ;; To keep things simple, assume a 3 by 3 board with two queens-cofig and ;; last colum still to add (define rest-of-queens (list (list (cons 1 1) (cons 3 2)) (list (cons 3 1) (cons 1 2)))) ;; Note there is no 3 queen solution to t 3 by 3 board. ;; Use 3x3 for simple testing. ;; Check if a single position works with a single queens configuration: (define (check-pos-config? pos queens-config) (if (null? queens-config) #f (or (check-pos-pos? pos (car queens-config)) (check-pos-config? pos (cdr queens-config))))) (check-pos-config? (cons 2 4) (car rest-of-queens)) ;; #f ;; a candidate-config is safe if it contains no checks, hence the not ;; only need to check the new position in front (define (safe-candidate? candidate-config) (not (check-pos-config? (car candidate-config) (cdr candidate-config)))) (safe-candidate? (adjoin-position 2 4 (car rest-of-queens))) ;; #t (safe-candidate? (adjoin-position 2 4 (cadr rest-of-queens))) ;; #t ;; Test inner loop of template. Use k=3 board-size=3, as if we are adding 3rd col to a 3x3. We just want to see that the candidate configurations are created: (define k 3) (define board-size 3) (flatmap (lambda (roqs) (map (lambda (new-row) (adjoin-position new-row k roqs)) (enumerate-interval 1 board-size))) rest-of-queens) ;; (((1 . 3) (1 . 1) (3 . 2)) ((2 . 3) (1 . 1) (3 . 2)) ((3 . 3) (1 . 1) (3 . 2)) ((1 . 3) (3 . 1) (1 . 2)) ((2 . 3) (3 . 1) (1 . 2)) ((3 . 3) (3 . 1) (1 . 2))) ;; We are close enough to go for it. Add rest of template. Like others, k is not included in call to safe? (define (generate-next-col-candidates next-col board-size rest-of-queens) (flatmap (lambda (roqs) (map (lambda (row) (adjoin-position row next-col roqs)) (enumerate-interval 1 board-size))) rest-of-queens)) (define board-size 3) (generate-next-col-candidates 3 board-size rest-of-queens) ;; (((1 . 3) (1 . 1) (3 . 2)) ((2 . 3) (1 . 1) (3 . 2)) ((3 . 3) (1 . 1) (3 . 2)) ((1 . 3) (3 . 1) (1 . 2)) ((2 . 3) (3 . 1) (1 . 2)) ((3 . 3) (3 . 1) (1 . 2))) ;; watch how candidate configs grow with recursion (define board-size 3) (generate-next-col-candidates 3 board-size (list (list))) ;; (((1 . 3)) ((2 . 3)) ((3 . 3))) (generate-next-col-candidates 3 board-size (generate-next-col-candidates 3 board-size (list (list)))) ;; (((1 . 3) (1 . 3)) ((2 . 3) (1 . 3)) ((3 . 3) (1 . 3)) ((1 . 3) (2 . 3)) ((2 . 3) (2 . 3)) ((3 . 3) (2 . 3)) ((1 . 3) (3 . 3)) ((2 . 3) (3 . 3)) ((3 . 3) (3 . 3))) (define (queens board-size) (define (queen-cols k) (if (= k 0) (list (list)) (filter (lambda (candidate) (safe-candidate? candidate)) (generate-next-col-candidates k board-size (queen-cols(- k 1)))))) (queen-cols board-size)) (queens 4) ;; (((3 . 4) (1 . 3) (4 . 2) (2 . 1)) ((2 . 4) (4 . 3) (1 . 2) (3 . 1))) (length (queens 8)) ;; 92 ;; Maches others
My solution isn't the most sophisticated one but I'll post it anyway in case it may be of help. I defined queens as (column row) unlike the book because that's closer to the chess notation.
Unfortunately the "k" parameter in safe? procedure is hanging around there doing absolutely nothing. I'm sure utilizing k would make my code much better but I just couldn't find a way to use it.
(define (queen col row) (list col row)) (define (col x) (car x)) (define (row x) (cadr x)) (define (contains x list) (cond ((null? list) #f) ((equal? (car list) x) #t) (else (contains x (cdr list))))) (define (flatmap proc seq) (accumulate append nil (map proc seq))) (define empty-board nil) (define (adjoin-position k new-row rest-of-queens) (cons (queen k new-row) rest-of-queens)) (define (safe? k positions) (let ((newqueen (car positions)) (others (cdr positions))) (cond ((or (contains (row newqueen) (map row others)) (contains (- (col newqueen) (row newqueen)) (map (lambda (x) (- (col x) (row x))) others)) (contains (+ (col newqueen) (row newqueen)) (map (lambda (x) (+ (col x) (row x))) others))) #f) (else #t)))) (define (queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position k new-row rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size))
This solution doesn't need k in (safe? ...). With memory limit 128 MB I tested it up to (queens 12) in DrRacket where it produced 14200 solutions.
(define (queens board-size) (define empty-board '()) (define (safe? positions) (define (queen-not-safe? q1 q2) (or (= (car q1) (car q2)) (= (abs (- (car q1) (car q2))) (abs (- (car (cdr q1)) (car (cdr q2))))))) (define (iter position rest-of-queens) (if (null? rest-of-queens) #t (if (queen-not-safe? position (car rest-of-queens)) #f (iter position (cdr rest-of-queens))))) (iter (car positions) (cdr positions))) (define (adjoin-position new-row k rest-of-queens) (cons (list new-row k) rest-of-queens)) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size)) (queens 8) (length (queens 8)) ; 92
Not much novelty in terms of the solution itself, but this adds a display-board procedure which can be used to display solutions to the puzzle
(define nil '()) (define (enumerate-interval low high) (if (> low high) nil (cons low (enumerate-interval (+ low 1) high)))) (define empty-board nil) ; adjoins a position in row and column specified by row and col ; to the existing set of positions determined by positions ; row: integer ; col: integer ; positions: list of lists which contain two integers specifying the row ; & col occupied by each position respectively (define (adjoin-position row col positions) (append positions (list (list row col)))) ; determines for a set of positions, whether the queen in the k-th column ; is safe with respsect to the others ; how we'll tackle this: ; make one pass through positions determining which position is the k-th column position ; make another pass through the list, determining if this position is safe, defined by ; the position not being in the same row ; the position not being in the same col ; the position not being in the same diagonal (delta of row is the same as delta of col) (define (safe? column positions) ; get the k-th item in a list ; k the number of item in the list to get ; count the count of the iterations through the list, which is always 0 to start ; items the list of items (define (get-kth-item k count items) (if (= (- k 1) count) (car items) (get-kth-item k (+ count 1) (cdr items)))) (define (safe-pos? position positions) (if (null? positions) true (and (let ((cur-pos (car positions))) (or (and (= (car cur-pos) (car position)) (= (cadr cur-pos) (cadr position))) ; the position is the same as one in positions (and ; the position is not... (not (= (car cur-pos) (car position))) ; ...same row (not (= (cadr cur-pos) (cadr position))) ; ... same col (not (= (abs (- (car cur-pos) (car position))) (abs (- (cadr cur-pos) (cadr position)))))))) ; ... same diagonal (safe-pos? position (cdr positions))))) (safe-pos? (get-kth-item column 0 positions) positions)) (define (queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size)) (define (list= x y) (if (and (null? x) (null? y)) true (and (= (length x) (length y)) (and (= (car x) (car y)) (list= (cdr x) (cdr y)))))) (define (contains-list item sequence) (cond ((null? sequence) false) ((list= item (car sequence)) true) (else (contains-list item (cdr sequence))))) (define (display-board positions board-size) (map (lambda (i) (map (lambda (j) (if (contains-list (list i j) positions) (display "Q") (display "-"))) (enumerate-interval 1 board-size)) (newline)) (enumerate-interval 1 board-size)) (newline)) ; example putting it all together with displaying full set of solutions to the Queen's puzzle... ; (map (lambda (solution) (display-board solution (length solution))) (queens 4)) ; --Q- ; Q--- ; ---Q ; -Q-- ; ; -Q-- ; ; ---Q ; ; Q--- ; ; --Q-
Didn't have to use var k in the function safe?.
Not complicated once you figure out what the book's skeleton code envisions the return value of queens to be.
(((x y) * 8) * n) where n is the number of solutions.
Hope this helps.