sicp/mceval/amb-8-queens.rkt

50 lines
1.8 KiB
Racket

(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (list-ref l n)
(if (= n 0) (car l)
(list-ref (cdr l) (- n 1))))
;; Not sure how to get a procedure to create (amb 1 ... n) for
;; arbitrary n without doing quasiquote, unsplice, etc, so fix for
;; n=8.
(define (queens)
(define (position row col) (cons row col))
(define (row position) (car position))
(define (col position) (cdr position))
(define (positive-intercept position)
(- (row position) (col position)))
(define (negative-intercept position)
(+ (row position) (col position)))
(define (safe? k positions)
(if (< k 2) true
(let ((kth-position (list-ref positions (- k 1)))
(pre-kth-positions (cdr (reverse positions))))
;; If the row, positive or negative intercept of the k-th position
;; is equal to any of the first k-1 positions, then the k-th
;; position is not safe.
(if (memv (row kth-position) (map row pre-kth-positions))
false
(if (memv (positive-intercept kth-position)
(map positive-intercept pre-kth-positions))
false
(if (memv (negative-intercept kth-position)
(map negative-intercept pre-kth-positions))
false
true))))))
(define (queens-add-columns current-queens column)
(if (> column 8) current-queens
(let ((new-queens
(append current-queens
(list (position (amb 1 2 3 4 5 6 7 8) column)))))
(require (safe? column new-queens))
(queens-add-columns new-queens (+ column 1)))))
(queens-add-columns '() 1))