<< Previous exercise (4.43) | Index | Next exercise (4.45) >>


 ;; 4.44 
 (define (enumerate-interval low high) 
   (if (> low high) 
       (cons low (enumerate-interval (+ low 1) high)))) 
 (define (attack? row1 col1 row2 col2) 
   (or (= row1 row2) 
       (= col1 col2) 
       (= (abs (- row1 row2)) (abs (- col1 col2))))) 
 ;; positions is the list of row of former k-1 queens 
 (define (safe? k positions) 
   (let ((kth-row (list-ref positions (- k 1)))) 
     (define (safe-iter p col) 
       (if (>= col k) 
           (if (attack? kth-row k (car p) col) 
               (safe-iter (cdr p) (+ col 1))))) 
     (safe-iter positions 1))) 
 (define (list-amb li) 
   (if (null? li) 
       (amb (car li) (list-amb (cdr li))))) 
 (define (queens board-size) 
   (define (queen-iter k positions) 
     (if (= k board-size) 
         (let ((row (list-amb (enumerate-interval 1 board-size)))) 
           (let((new-pos (append positions (list row)))) 
             (require (safe? k new-pos)) 
             (queen-iter (+ k 1) new-pos))))) 
   (queen-iter 1 '())) 


 ;; a simpler version. 
 (define (an-integer-between a b) 
     (require (<= a b)) 
     (amb a (an-integer-between (+ a 1) b))) 
 ;;check if (car solution) is compatible with any of (cdr solution) 
 (define (safe? solution)  
     (let ((p (car solution))) 
         (define (conflict? q i) 
                 (= p q) 
                 (= p (+ q i)) 
                 (= p (- q i)))) 
         (define (check rest i) 
                 ((null? rest) #t) 
                 ((conflict? (car rest) i) #f) 
                 (else (check (cdr rest) (inc i))))) 
         (check (cdr solution) 1))) 
 (define (queens n) 
     (define (iter solution n-left) 
         (if (= n-left 0) 
                 (display solution) 
                 (let ((x-solution (cons (an-integer-between 1 n) solution))) 
                     (require (safe? x-solution)) 
                     (iter x-solution (- n-left 1)))))) 
     (iter '() n)) 
 (queens 8) 


 ;;use the original method 
 (define (enumerate-interval l h) 
   (if (> l h) 
       (cons l (enumerate-interval (+ l 1) h)))) 
 (define empty-board '()) 
 (define (adjoin-position row col rest) 
   (cons (list row col) rest)) 
 (define (extract item lst) 
   (define (scan items) 
     (cond ((null? items) 
           ((equal? item (car items)) 
            (scan (cdr items))) 
           (else (cons (car items) (scan (cdr items)))))) 
   (scan lst)) 
 (define (safe? col positions) 
   (define (iter l) 
     (if (null? l) 
         (and (car l) (iter (cdr l))))) 
   (let ((row (caar (filter (lambda (p) 
                              (eq? col (cadr p))) 
     (iter (map (lambda (p) 
                  (not (or (eq? row (car p)) 
                           (eq? (- row col) (- (car p) (cadr p))) 
                           (eq? (+ row col) (+ (car p) (cadr p)))))) 
                (extract (list row col) positions))))) 
 (define (queens board-size) 
   (define (queen-cols k) 
     (if (= k 0) 
         (list empty-board) 
         (map (lambda (positions) 
                (require (safe? k positions))) 
              (flatmap (lambda (rest-of-queens) 
                         (adjoin-position new-row (amb (enumerate-interval 1 board-size)) 
                       (queen-cols (- k 1)))))) 
   (queen-cols board-size))