sicp-ex-4.44



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


xdavidliu

 ;; 
 ;; 
 ;; 
 (define (vulnerable? queen1-position queen2-position column-separation) 
   (let ((row-separation (abs (- queen1-position queen2-position)))) 
     (or (= row-separation 0) 
         (= row-separation column-separation)))) 
  
 ;; first element of previous-queens is the position of the queen 
 ;; in the column immediately adjacent to next-queen 
 (define (next-queen-vulnerable? next-queen previous-queens) 
   (define (iter prev-qs column-separation) 
     (if (null? prev-qs) 
         false 
         (or (vulnerable? next-queen (car prev-qs) column-separation) 
             (iter (cdr prev-qs) (1+ column-separation))))) 
   (iter previous-queens 1)) 
  
 ;; use let* even though bindings are independent in order to guarantee efficient nesting with respect to amb. 
 (define (eight-queens) 
   (define (nnqv? next-queen previous-queens) 
     (not (next-queen-vulnerable? next-queen previous-queens))) 
   (let* ((prev0 '()) 
          (q1 (amb 1 2 3 4 5 6 7 8))) 
     (require (nnqv? q1 prev0)) ;; trivially never fails 
     (let* ((prev1 (cons q1 prev0)) 
            (q2 (amb 1 2 3 4 5 6 7 8))) 
       (require (nnqv? q2 prev1)) 
       (let* ((prev2 (cons q2 prev1)) 
              (q3 (amb 1 2 3 4 5 6 7 8))) 
         (require (nnqv? q3 prev2)) 
         (let* ((prev3 (cons q3 prev2)) 
                (q4 (amb 1 2 3 4 5 6 7 8))) 
           (require (nnqv? q4 prev3)) 
           (let* ((prev4 (cons q4 prev3)) 
                  (q5 (amb 1 2 3 4 5 6 7 8))) 
             (require (nnqv? q5 prev4)) 
             (let* ((prev5 (cons q5 prev4)) 
                    (q6 (amb 1 2 3 4 5 6 7 8))) 
                (require (nnqv? q6 prev5)) 
                (let* ((prev6 (cons q6 prev5)) 
                       (q7 (amb 1 2 3 4 5 6 7 8))) 
                  (require (nnqv? q7 prev6)) 
                  (let* ((prev7 (cons q7 prev6)) 
                         (q8 (amb 1 2 3 4 5 6 7 8))) 
                    (require (nnqv? q8 prev7)) 
                    (cons q8 prev7)))))))))) 
 ;; use try-again to go through all the solutions. 

meteorgan

  
  
  
 ;; 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) 
           true 
           (if (attack? kth-row k (car p) col) 
               false 
               (safe-iter (cdr p) (+ col 1))))) 
     (safe-iter positions 1))) 
  
 (define (list-amb li) 
   (if (null? li) 
       (amb) 
       (amb (car li) (list-amb (cdr li))))) 
  
 (define (queens board-size) 
   (define (queen-iter k positions) 
     (if (= k board-size) 
         positions 
         (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 '())) 

Felix021

  
 ;; 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) 
             (or 
                 (= p q) 
                 (= p (+ q i)) 
                 (= p (- q i)))) 
         (define (check rest i) 
             (cond  
                 ((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) 
             (begin 
                 (display solution) 
                 (newline)) 
             (begin 
                 (let ((x-solution (cons (an-integer-between 1 n) solution))) 
                     (require (safe? x-solution)) 
                     (iter x-solution (- n-left 1)))))) 
     (iter '() n)) 
  
 (queens 8) 
  

donald

 ;;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) 
         true 
         (and (car l) (iter (cdr l))))) 
   (let ((row (caar (filter (lambda (p) 
                              (eq? col (cadr p))) 
                            positions)))) 
     (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)) 
                                          rest-of-queens)) 
                       (queen-cols (- k 1)))))) 
   (queen-cols board-size))