exerise 4.44

日記が長いのか知らんが昨日の分が上手く見れないので、今日の分として再掲。
なんぞこれー・・・。

exercise 4.44

ambを用いて2.42のeight-queens puzzleを解く問題。

(define (require p)
  (if (not p) (amb)))

(define (enumerate-interval m n)
  (if (> m n)
      '()
      (cons m (enumerate-interval (+ m 1) n))))

(define (map2 proc seq1 seq2)
  (if (null? seq1)
      '()
      (cons (proc (car seq1) (car seq2)) (map2 proc (cdr seq1) (cdr seq2)))))

(define (an-integer-between a b)
  (require (not (> a b)))
  (amb a (an-integer-between (+ a 1) b)))

(define (queens board-size)
  (define (queen-cols k qs)
    (if (> k board-size)
        qs
        (begin
          (let ((q (an-integer-between 1 board-size)))
            (map2 (lambda (pos dist)
                   (require (not (= (cadr pos) q)))
                   (require (not (= (- (cadr pos) dist) q)))
                   (require (not (= (+ (cadr pos) dist) q))))
                 qs
                 (enumerate-interval 1 k))
            (queen-cols (+ k 1) (cons (list k q) qs))))))
  (queen-cols 1 '()))

queen-colsを回していって、失敗してればamb。
実行結果は

;;; Amb-Eval input:
(queens 8)

;;; Starting a new problem 
;;; Amb-Eval value:
((8 4) (7 2) (6 7) (5 3) (4 6) (3 8) (2 5) (1 1))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((8 5) (7 2) (6 4) (5 7) (4 3) (3 8) (2 6) (1 1))

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
((8 3) (7 5) (6 2) (5 8) (4 6) (3 4) (2 7) (1 1))