# sicp-ex-4.44

wocanmei

``` ;;
;;
;;
;; plain and straitforward solution
(define (queens)
(let ((q1 (amb 1 2 3 4 5 6 7 8)))
(let ((q2 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q2 2 (rows->poses (list q1))))
(let ((q3 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q3 3 (rows->poses (list q1 q2))))
(let ((q4 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q4 4 (rows->poses (list q1 q2 q3))))
(let ((q5 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q5 5 (rows->poses (list q1 q2 q3 q4))))
(let ((q6 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q6 6 (rows->poses (list q1 q2 q3 q4 q5))))
(let ((q7 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q7 7 (rows->poses (list q1 q2 q3 q4 q5 q6))))
(let ((q8 (amb 1 2 3 4 5 6 7 8)))
(require (safe? q8 8 (rows->poses (list q1 q2 q3 q4 q5 q6 q7))))
(rows->poses (list q1 q2 q3 q4 q5 q6 q7 q8)))))))))))

;; helper functions
(define (and a b c d)
(cond ((not a) false)
((not b) false)
((not c) false)
((not d) false)
(else true)))

(define (or a b)
(if a
true
b))

;; 2.42
(define (same-row? p1 p2)
(= (car p1) (car p2)))

(define (same-col? p1 p2)
(= (cdr p1) (cdr p2)))

(define (same-diag? p1 p2)
(let ((row1 (car p1))
(col1 (cdr p1))
(row2 (car p2))
(col2 (cdr p2)))
(or (= (+ row1 col1) (+ row2 col2))
(= (- row1 col1) (- row2 col2)))))

(define (safe? row col positions)
(define (safe-iter kp other-positions)
(if (null? other-positions)
true
(and (not (same-row? kp (car other-positions)))
(not (same-col? kp (car other-positions)))
(not (same-diag? kp (car other-positions)))
(safe-iter kp (cdr other-positions)))))
(safe-iter (cons row col) positions))

(define (map proc items)
(if (null? items)
'()
(cons (proc (car items))
(map proc (cdr items)))))

(define (rows->poses rows)
(define count 0)
(map (lambda (row)
(begin (set! count (+ count 1))
(cons row count)))
rows))

(queens)

```

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

codybartfast

```

(define (new-queen col)
(cons col (amb 1 2 3 4 5 6 7 8)))

(define (8queens)
(define (iter queens)
(require (distinct? (map cdr queens)))
(require (distinct? (map (lambda (q) (- (car q) (cdr q))) queens)))
(require (distinct? (map (lambda (q) (+ (car q) (cdr q))) queens)))
(if (= 8 (length queens))
queens
(iter (cons (new-queen (+ 1 (length queens))) queens))))
(iter '()))

;; ((8 . 4) (7 . 2) (6 . 7) (5 . 3) (4 . 6) (3 . 8) (2 . 5) (1 . 1))

```

revc

I keep track of all the history of my solutions.

``` ;; Exercise 4.44
(define (Eight-Queen)
(require (not (= Rx Ry)))
(require (not (= (abs (- Ry Rx)) diff))))

(let ([r1 (amb 1 2 3 4 5 6 7 8)])
(let ([r2 (amb 1 2 3 4 5 6 7 8)])
(let ([r3 (amb 1 2 3 4 5 6 7 8)])
(let ([r4 (amb 1 2 3 4 5 6 7 8)])
(let ([r5 (amb 1 2 3 4 5 6 7 8)])
(let ([r6 (amb 1 2 3 4 5 6 7 8)])
(let ([r7 (amb 1 2 3 4 5 6 7 8)])
(let ([r8 (amb 1 2 3 4 5 6 7 8)])
(list r1 r2 r3 r4 r5 r6 r7 r8))))))))))

(define (Eight-Queen)
(require (not (= Rx Ry)))
(require (not (= (abs (- Ry Rx)) diff))))

;; add constraints to all two elements, both of them are from ``rows``

;; add constraints to all two elements where one is the CAR of ``rows`` and the other
;; is from the CDR ``rows``
(define (loop items diff)
(if (not (null? items))
(begin
(add-constraint (car rows) (car items) diff)
(loop (cdr items) (+ diff 1)))))

(if (not (null? (cdr rows)))
(begin
(loop (cdr rows) 1)

(let ([r1 (amb 1 2 3 4 5 6 7 8)]
[r2 (amb 1 2 3 4 5 6 7 8)]
[r3 (amb 1 2 3 4 5 6 7 8)]
[r4 (amb 1 2 3 4 5 6 7 8)]
[r5 (amb 1 2 3 4 5 6 7 8)]
[r6 (amb 1 2 3 4 5 6 7 8)]
[r7 (amb 1 2 3 4 5 6 7 8)]
[r8 (amb 1 2 3 4 5 6 7 8)])
(add-constraints (list r1 r2 r3 r4 r5 r6 r7 r8))
(list r1 r2 r3 r4 r5 r6 r7 r8)))

(define (Eight-Queen)
;; add a constraint to two elements with a specifed difference
(require (not (= Rx Ry)))                 ; not in a same column
(require (not (= (abs (- Ry Rx)) diff)))) ; not in a same diagonal

;; add constraints to all two elements where one is the CAR of ``rows`` and the other
;; is from the CDR ``rows``
;; the procedure take a list which is ordered by "descended" (from high row to low row)
(define (loop rest diff)
(if (not (null? rest))
(begin
(add-constraint (car rows) (car rest) diff)
(loop (cdr rest) (+ diff 1)))))
(loop (cdr rows) 1))

(let ([r1 (amb 1 2 3 4 5 6 7 8)])
(let ([r2 (amb 1 2 3 4 5 6 7 8)])
(let ([r3 (amb 1 2 3 4 5 6 7 8)])
(let ([r4 (amb 1 2 3 4 5 6 7 8)])
(add-constraints (list r4 r3 r2 r1))
(let ([r5 (amb 1 2 3 4 5 6 7 8)])
(add-constraints (list r5 r4 r3 r2 r1))
(let ([r6 (amb 1 2 3 4 5 6 7 8)])
(add-constraints (list r6 r5 r4 r3 r2 r1))
(let ([r7 (amb 1 2 3 4 5 6 7 8)])
(add-constraints (list r7 r6 r5 r4 r3 r2 r1))
(let ([r8 (amb 1 2 3 4 5 6 7 8)])
(add-constraints (list r8 r7 r6 r5 r4 r3 r2 r1))
(list r1 r2 r3 r4 r5 r6 r7 r8))))))))))

(define (Eight-Queen)
;; add a constraint to two elements with a specifed difference
(require (not (= Rx Ry)))                 ; not in a same column
(require (not (= (abs (- Ry Rx)) diff)))) ; not in a same diagonal

;; add constraints to all two elements where one is the CAR of ``rows`` and the other
;; is from the CDR ``rows``
;; the procedure take a list which is ordered by "descended" (from high row to low row)
(define (loop rest diff)
(if (not (null? rest))
(begin
(add-constraint (car rows) (car rest) diff)
(loop (cdr rest) (+ diff 1)))))
(loop (cdr rows) 1))

(define (get-solution r-rows stage)
(if (< stage 9)
(let ([row (amb 1 2 3 4 5 6 7 8)])
(let ([new-rows (cons row r-rows)])
(get-solution new-rows (+ stage 1))))
(reverse r-rows)))

(get-solution (list (amb 1 2 3 4 5 6 7 8)) 2))

(define (N-Queen n)
;; add a constraint to two elements with a specifed difference
(require (not (= Rx Ry)))                 ; not in a same column
(require (not (= (abs (- Ry Rx)) diff)))) ; not in a same diagonal

;; add constraints to all two elements where one is the CAR of ``rows`` and the other
;; is from the CDR ``rows``
;; the procedure take a list which is ordered by "descended" (from high row to low row)
(define (loop rest diff)
(if (not (null? rest))
(begin
(add-constraint (car rows) (car rest) diff)
(loop (cdr rest) (+ diff 1)))))
(loop (cdr rows) 1))

(define (get-solution r-rows stage)
(if (< stage n)
(let ([row (an-integer-between 1 n)])
(let ([new-rows (cons row r-rows)])
(get-solution new-rows (+ stage 1))))
(reverse r-rows)))

(get-solution (list (an-integer-between 1 n)) 1))

;;; represent Queens as a list of columns in the order of the rows
(define (N-Queen n)
;; check if two queens coexist with each other
(define (offensive? Rx Ry diff)
(if (= Rx Ry)                       ; in a same column
true
(= (abs (- Ry Rx)) diff)))      ; in a same diagonal

;; check if (car solution) is compatible with any of (cdr solution)
(define (safe? rows)
(define (check rest diff)
(if (not (null? rest))
(if (offensive? (car rows) (car rest) diff)
false
(check (cdr rest) (+ diff 1)))
true))
(check (cdr rows) 1))

(define (queen-iter r-rows stage)
(if (< stage n)
(let ([row (an-integer-between 1 n)])
(let ([new-rows (cons row r-rows)])
(require (safe? new-rows))
(queen-iter new-rows (+ stage 1))))
(reverse r-rows)))

(queen-iter (list (an-integer-between 1 n)) 1))
```