(The solution presented below uses the sicp and amb eggs written for Chicken Scheme 4.)
The N-queens problem asks to place N queens on an N x N chessboard so that no two queens threaten each other. We follow closely SICP , exercise 2.42:
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 k-th 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 k-th column. Now filter these, keeping only the positions for which the queen in the k-th 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 recursively. The procedure queens returns a sequence of all solutions as function of the board size N. The internal procedure queen-cols returns the sequence of all ways to place queens in the first k columns of the board, rest-of-queens is a way to place k-1 queens in the first k-1 columns, new-row is a proposed row in which to place the queen for the k-th column, and adjoin-position adjoins a new row-column position to a set of positions. Finally, the procedure safe? determines for a set of positions, whether the queen in the k-th column is safe with respect to the others.
(use sicp)
;; `queens' finds all the solutions for a given N. The comments within
;; the procedure refer to the following items:
;;
;; [1] Add new positions as all the possible rows combined with
;; column k, creating a new list for each row. E.g.:
;; (((1 k) (r2 k-1) (r3 k-2) ...)
;; ((2 k) (r2 k-1) (r3 k-2) ...)
;; ...)
;; [2] Recursive call over all columns (map over
;; `(queen-cols (- k 1))'), starting from the last one
;; and going back until k=0 (see the `if' condition above).
;; This generates the set of all possible board positions.
;; A position here indicates a list of `(row column)' pairs
;; for all possible queens.
;; [3] Filter all possible positions keeping only the safe
;; ones. It is enough to test the queen in column k and assume
;; that those at k-1, k-2, ... are already placed (they will
;; actually be generated recursively).
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
;; [3]
(filter
(lambda (positions) (safe? positions))
;; [2]
(flatmap
(lambda (rest-of-queens)
;; [1]
(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 empty-board '())
;; We represent a queen as a pair (row . column).
(define (make-queen row col) (cons row col))
(define (queen-row queen) (car queen))
(define (queen-col queen) (cdr queen))
;; A position is a list of queens (no column repetitions
;; allowed). Last column appear first in the list. The following
;; procedure adds a queen at the beginning of the queens list.
(define (adjoin-position new-row k rest-of-queens)
(append (list (make-queen new-row k)) rest-of-queens))
; A position in column k is safe if rows are different and not on
; diagonal (i.e., different vertical and horizontal distance) with
; respect to queens already placed.
(define (safe-row? queen-a queen-b)
(not (= (queen-row queen-a) (queen-row queen-b))))
(safe-row? (make-queen 1 1) (make-queen 1 2))
;=> #f
(safe-row? (make-queen 1 1) (make-queen 3 2))
;=> #t
(define (safe-diagonal? queen-a queen-b)
(let ((h-dist (abs (- (queen-row queen-a) (queen-row queen-b))))
(v-dist (abs (- (queen-col queen-a) (queen-col queen-b)))))
(not (= h-dist v-dist))))
(safe-diagonal? (make-queen 1 1) (make-queen 2 2))
;=> #f
(safe-diagonal? (make-queen 1 1) (make-queen 1 2))
;=> #t
;; Finally, check recursively the list of all positions.
(define (safe? positions)
;; Test if the queen at column k (i.e., the car of the list) is safe
;; compared to those at columns k-1, k-2, ...
(define (safe-position? queen rest-of-queens)
(if (null? rest-of-queens)
#t
(let ((other-queen (car rest-of-queens)))
(and (safe-row? queen other-queen)
(safe-diagonal? queen other-queen)
(safe-position? queen (cdr rest-of-queens))))))
(safe-position? (car positions) (cdr positions)))
;; (Note that in the original SICP exercise the `safe?` procedure
;; depends on two arguments `(safe? k positions)'. Since we adjoin new
;; queens in order, the column k argument is redundant as the
;; corresponding queen is extracted by the helper procedure
;; `safe-position?' as the car of the position list.)
;;
;; Let's get all the solutions for N=4.
(queens 4)
;=> (((3 . 4) (1 . 3) (4 . 2) (2 . 1))
; ((2 . 4) (4 . 3) (1 . 2) (3 . 1)))
;; As N gets large it is convenient to show a solution graphically.
(define (show-queens solution)
(when (null? solution) 'no-solution)
(let ((board-size (length solution)))
(map
(lambda (i)
(map (lambda (j)
(if (member (cons i j) solution)
(write-string "Q ")
(write-string ". ")))
(enumerate-interval 1 board-size))
(write-string "\n"))
(enumerate-interval 1 board-size)))
'done)
;; Show the first of the 92 solutions for the N=8 case.
(length (queens 8))
;=> 92
(show-queens (car (queens 8)))
;;=> Q . . . . . . .
;; . . . . . . Q .
;; . . . . Q . . .
;; . . . . . . . Q
;; . Q . . . . . .
;; . . . Q . . . .
;; . . . . . Q . .
;; . . Q . . . . .
Alternatively, we can implement a non-deterministic solution using the amb operator (see SICP Section 4.3) such that (amb e1 e2 ... en) returns the value of one of the n expressions ei ambiguously. For example, the expression (list (amb 1 2 3) (amb 'a 'b)) can have six possible values: (1 a) (1 b) (2 a) (2 b) (3 a) (3 b).
The structure of the solution follows the queens procedure introduced above, except that we replace points [1] and [3] described in the code above with amb.
(use amb)
;; Require predicate expression p to be true.
(define (amb-require p)
(if (not p) (amb)))
;;; Ambiguously returns an element from the list.
(define (amb-element-of items)
(amb-require (not (null? items)))
(amb (car items) (amb-element-of (cdr items))))
(define (queens-amb board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(map (lambda (rest-of-queens)
;; Instead of mapping over all the possible rows
;; combined with column k [1], get an element of the
;; enumeration with amb.
(let ((positions (adjoin-position
(amb-element-of (enumerate-interval 1 board-size))
k
rest-of-queens)))
;; Instead of filtering [3], require safe positions
;; with amb.
(amb-require (safe? positions))
positions))
(queen-cols (- k 1)))))
;; Collect all possible solutions.
(amb-collect (queen-cols board-size)))
(queens-amb 4)
;=> (((3 . 4) (1 . 3) (4 . 2) (2 . 1))
; ((2 . 4) (4 . 3) (1 . 2) (3 . 1)))