Eight-queens puzzle

Question

Figure 2.8: A solution to the eight-queens puzzle. 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 possible solution is shown in figure 2.8. 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.

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.

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

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

I found this task to be especially difficult. I think I have a working answer, but I'm sure that there is a much better way. My current solution feels like a popsicle-stick bridge held together with duct tape, poised to fall apart at any moment. I know it's messy, so I must apologize in advance. If you can't follow it let me know and I'll try to rewrite it a bit if possible. For now, though, I need to take a break! How can I improve my code?

(define (enumerate-interval i j) (if (= i j) (list j) (cons i (enumerate-interval (+ i 1) j))))
(define (filter f seq) (if (null? seq) null (if (f (car seq)) (cons (car seq) (filter f (cdr seq))) (filter f (cdr seq)))))
(define (flatmap op seq)
  (foldr append null (map op seq)))

(define (queens board-size)
  (define (empty-board) 
    (map (lambda (row)
           (map (lambda (col) 0) 
                (enumerate-interval 1 board-size))) 
         (enumerate-interval 1 board-size)))
  (define (adjoin-position new-row k rest-of-queens)
    (cond ((and (= new-row 1)
                (= k 1)) (cons (cons 1 
                                     (cdar rest-of-queens)) 
                               (cdr rest-of-queens)))
          ((> k 1) (cons (car rest-of-queens)
                         (adjoin-position new-row 
                                          (- k 1) 
                                          (cdr rest-of-queens))))
          (else (let ((adjoined (adjoin-position (- new-row 1) 
                                                 k 
                                                 (cons (cdar rest-of-queens)                 
                                                       (cdr rest-of-queens)))))
                  (cons (cons (caar rest-of-queens) 
                              (car adjoined)) 
                        (cdr adjoined))))))
  (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 col car)
(define row cdr)

(define (indexOf x seq)
  (define (rec i remains)
    (cond ((null? remains) (error "No x found in seq." x seq))
          ((= (car remains) x) i)
          (else (rec (+ i 1) (cdr remains)))))
  (rec 0 seq))

(define (nth n seq)
  (cond ((null? seq) (error "Sequence shorter than n" seq n))
        ((= n 1) (car seq))
        (else (nth (- n 1) (cdr seq)))))

(define (all-true seq) 
  (cond ((null? seq) true)
        ((car seq) (all-true (cdr seq)))
        (else false)))

(define (upto k rows) 
  (if (or (= k 0) 
          (null? rows)) 
      null
      (cons (car rows) (upto (- k 1) (cdr rows)))))

(define (safe? k positions)
  (let ((uptok-positions (upto (- k 1) positions))
        (kth-position (nth k positions)))  
    (define (col-row-coords pos)
      (define (process-row rownum rows)
        (define (process-col colnum row)
          (cond ((null? row) null)
                ((= (car row) 1) (cons rownum colnum))
                (else (process-col (+ colnum 1) (cdr row)))))
        (if (null? rows)
            null
            (cons (process-col 1 (car rows))
                  (process-row (+ rownum 1) (cdr rows)))))
      (process-row 1 pos))
    (let ((col-and-row (filter (lambda (x) (not (null? x))) (col-row-coords uptok-positions)))
          (k-coord (cons k (indexOf 1 kth-position))))
      (define (diagonal? p1 p2)
        (= (abs (- (col p1) (col p2)))
           (abs (- (row p1) (row p2)))))
      (all-true (map (lambda (pos) 
                  (and (not (= (col k-coord)
                               (col pos)))
                       (not (= (row k-coord)
                               (row pos)))
                       (not (diagonal? k-coord pos)))) col-and-row)))))

EDIT: Thanks for the feedback! I have a new version here. I would appreciate any feedback you have.

(define (enumerate-interval i j) (if (> i j) null (cons i (enumerate-interval (+ i 1) j))))
(define (filter f seq) (if (null? seq) null (if (f (car seq)) (cons (car seq) (filter f (cdr seq))) (filter f (cdr seq)))))
(define (flatmap op seq)
  (foldr append null (map op seq)))

(define (queens board-size)
  (define (empty-board) '())
  (define (adjoin-position new-row k rest-of-queens) 
    (append  rest-of-queens (list (cons new-row k))))

  (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 col car)
(define row cdr)

(define (threatens? q1 q2)
  (define (diagonal? q1 q2)
    (= (abs (- (col q1) (col q2)))
       (abs (- (row q1) (row q2)))))
  (or (= (col q1) (col q2))
      (= (row q1) (row q2))
      (diagonal? q1 q2)))

(define (nth n seq) (if (= n 1) (car seq) (nth (- n 1) (cdr seq))))
(define (except-nth n seq) 
  (cond ((null? seq) '())
        ((= n 1) (cdr seq))
        (else (cons (car seq) (except-nth (- n 1) (cdr seq))))))

(define (safe? k positions)
  (define (rec me threats)
    (or (null? threats)
        (and (not (threatens? me (car threats)))
             (rec me (cdr threats)))))
  (rec (nth k positions) 
    (except-nth k positions)))

Answer 1

As we are looking for a subset of positions where each column is occupied by exactly one queen, we can represent an NxN board setup in a simpler way - as a list of N numbers, each ranging from 1 to N, representing row number taken by the queen in the 1st ... Nth columns. Empty board would still be an emplty list.

Then we can use cons as adjoin-position, and check particular k-queens position by taking the first queen position and iterating over remaining k-1 queens, checking if the delta between positions equals zero or the number of iteration. With this approach safe? doesn't even need an explicit k as an argument - it is just the length of the position passed to safe? and is used implicity by iterating over the (cdr position):

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list '())
        (filter
          (lambda (position) (safe? position))
          (flatmap
            (lambda (rest-of-queens)
              (map (lambda (new-row)
                      (cons new-row rest-of-queens))
                   (enumerate-interval 1 board-size)))
            (queen-cols (- k 1))))))
  (define (safe? position)
    (safe-iter? (car position) 1 (cdr position)))
  (define (safe-iter? fst n rest-position)
    (cond ((null? rest-position) true)
          ((= fst (car rest-position)) false)
          ((= (abs (- fst (car rest-position))) n) false)
          (else (safe-iter? fst (+ n 1) (cdr rest-position)))))
  (queen-cols board-size))

Answer 2

Well, an empty board should be represented by an empty list.

  (define (empty-board) '())

You can represent the board state just as a list of pairs that contain the coordinates of the queens. Using 0..7 as the coordinates, you get

  (define (adjoin-position x y board) (cons (cons x y) board))

Ok, so now you need to have a way to check if the queen on row k is safe with respect to the others. If you take advantage of the structure of the "queens" procedure, you can do this easier (because the queen you are checking on is the queen added last to the board, so it is at the beginning of the list of positions). Assuming you don't take a shortcut like this, you need to do two things: fetch the location of the queen on row k and then perform the arithmetics. You can use the Scheme procedure assv for this, i.e.

  (define (get-queen row board) (assv row board))

This returns the pair, or #f if nothing is found.

You can write a procedure that checks if two queens at (x, y) and (a, b) threaten each other:

  (define (threatens? x y a b)
     ... ;; left as an exercise to the reader
     )

After which the procedure (safe? row board) can be implemented easily by iterating the queen positions from the board list (another exercise).

Answer 3

I do not know scheme that much that I be able to read this code, but I have idea how to avoid counting rotations and reflections (if you have not implement it yourself)

1. Place 1st queen on A1 to A4
2. Queen placed on H column should have row number higher that column number of A queen.
3. Queen placed on 1 row should have column letter higher than row number of A queen.

I might be missing something