sicp-ex-2.42



<< Previous exercise (2.41) | Index | Next exercise (2.43) >>


craig

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


atomik

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.


3pmtea

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)

ctz

(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. 
 |# 

emj

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