(wat-aro)

無職から有職者にランクアップしました

SICP 問題 4.44

eight-queenをamb評価器を用いて解く.
ただし,まだamb評価器は実装していないのでコードだけ.

(define (eight-queen)
  (define (cross? a b)
    (= (/ (/ (car a) (car b))
          (abs (- (cdr a) (cdr b))))
       1))
  (let ((chess (iota 8 1)))
    (let ((one (cons 1 (amb chess))))
      (let ((two (cons 2 (amb chess))))
        (require (distinct (list one two)))
        (require (not (cross? two one)))
        (let ((three (cons 3 (amb chess))))
          (require (distince (list one two three)))
          (require (fold (lambda (x y) (and (not (cross? three x)) y)) #t (list one two)))
          (let ((four (cons 4 (amb chess))))
            (require (distinct? (list one two three four)))
            (require (fold (lambda (x y) (and (not (cross? four x)) y)) #t (list one two three)))
            (let ((five (cons 5 (amb chess))))
              (require (distinct? (list one two three four five)))
              (require (fold (lambda (x y) (and (not (cross? five x)) y)) #t (list one two three four)))
              (let ((six (cons 6 (amb chess))))
                (require (distinct? (list one two three four five six)))
                (require (fold (lambda (x y) (and (not (cross? six x)) y)) #t (list one two three four five)))
                (let ((seven (cons 7 (amb chess))))
                  (require (distinct? (list one two three four five six seven)))
                  (require (fold (lambda (x y) (and (not (cross? seven x)) y)) #t (list one two three four five six)))
                  (let ((eight (cons 8 (amb chess))))
                    (require (distinct? (lsit one two three four five six seven eight)))
                    (require (fold (lambda (x y) (and (not (cross? eight x)) y)) #t (list one two three four five six seven)))
                    (list one two three four five six seven eight)))))))))))