SICP 問題 4.43

まずは素直に問題文に出てくる通りに書いてみる．

(define (kansas-state-enginner)
  (let ((moore (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                     (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)))
        (downing (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                       (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)))
        (hall (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                    (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)))
        (barnacle-hood (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                    (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)))
        (parker (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                      (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)))
        (daughter car)
        (yacht cdr))
    (let ((father-list moore hall downing barnacle-hood parker))
      (require (distinct? father-list))
      (require (fold-left (lambda (x y) (and (not (eq? (daughter x) (yacht x))) y))
                     #t father-list))
      (require (eq? (daughter moore) 'mary))
      (require (eq? (yocht barnacle-hood) 'gabrielle))
      (require (eq? (yocht moore) 'Lorna))
      (require (eq? (yocht hall) 'rosalind))
      (require (eq? (yocht downing) 'melissa))
      (require (eq? (daughter barnacle-hood) 'melissa))
      (require (eq? (daughter parker)
                    (yocht (car (filter (lambda (x) (eq? (daughter x) 'gabrielle))
                                        father-list)))))
      (list 'moore moore 'downing downing 'hall hall 'barnacle-hood barnacle-hood 'parker parker))))

次はこれを効率的になるように並び替える．

(define (kansas-state-enginner)
  (let ((moore (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                     (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)))
        (daughter car)
        (yacht cdr))
    (require (eq? (daughter moore) 'mary))
    (require (eq? (yocht moore) 'Lorna))
    (let ((downing (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                         (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa))))
      (require (distinct? (list moore downing)))
      (require (eq? (yocht downing) 'melissa))
      (require (not (eq? (daughter downing) (yocht downing))))
      (let ((hall (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                        (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa))))
        (require (distinct? (list moore downing hall)))
        (require (not (eq? (daughter hall) (yocht hall))))
        (require (eq? (yocht hall) 'rosalind))
        (let ((barnacle-hood (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                                   (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa))))
          (require (distinct? moore downing hall barnacle-hood))
          (require (not (eq? (daughter barnacle-hood) (yocht barnacle-hood))))
          (require (eq? (daughter barnacle-hood) 'melissa))
          (require (eq? (yocht barnacle-hood) 'gabrielle))
          (let ((parker (cons (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa)
                              (amb 'mary 'gabrielle 'lorna 'rosalind 'melissa))))
            (require (distinct? (list moore downing hall barnacle-hood parker)))
            (require (not (eq? (daughter parker) (yocht parker))))
            (require (eq? (daughter parker)
                    (yocht (car (filter (lambda (x) (eq? (daughter x) 'gabrielle))
                                        father-list)))))
            (list 'moore moore 'downing downing 'hall hall 'barnacle-hood barnacle-hood 'parker parker)))))))