問題4.75 – SICP(計算機プログラムの構造と解釈)その246

問題4.75

(define (unique-query exps) (car exps))

(define (uniquely-asserted operands frame-stream)
  (stream-flatmap
    (lambda (frame)
            (let ((result (qeval (unique-query operands) (singleton-stream frame))))
                 (if (and (not (stream-null? result))
                          (stream-null? (stream-cdr result)))
                     result ;; 唯一個の結果を持つストリームの場合
                     the-empty-stream))) ;; 結果が無いか、2個以上の結果を持つ場合
    frame-stream))

(put 'unique 'qeval uniquely-asserted)

唯一人を監督する人全てをリストする質問の実行結果

;;; Query input:
(and (supervisor ?x ?j)
     (unique (supervisor ?anyone ?j)))

;;; Query results:
(and (supervisor (Cratchet Robert) (Scrooge Eben)) (unique (supervisor (Cratchet Robert) (Scrooge Eben))))
(and (supervisor (Reasoner Louis) (Hacker Alyssa P)) (unique (supervisor (Reasoner Louis) (Hacker Alyssa P))))

p291 の例の実行結果

;;; Query input:
(unique (job ?x (computer wizard)))

;;; Query results:
(unique (job (Bitdiddle Ben) (computer wizard)))

;;; Query input:
(unique (job ?x (computer programmer)))

;;; Query results:

;;; Query input:
(and (job ?x ?j)
     (unique (job ?anyone ?j)))

;;; Query results:
(and (job (Aull DeWitt) (administration secretary)) (unique (job (Aull DeWitt) (administration secretary))))
(and (job (Cratchet Robert) (accounting scrivener)) (unique (job (Cratchet Robert) (accounting scrivener))))
(and (job (Scrooge Eben) (accounting chief accountant)) (unique (job (Scrooge Eben) (accounting chief accountant))))
(and (job (Warbucks Oliver) (administration big wheel)) (unique (job (Warbucks Oliver) (administration big wheel))))
(and (job (Reasoner Louis) (computer programmer trainee)) (unique (job (Reasoner Louis) (computer programmer trainee))))
(and (job (Tweakit Lem E) (computer technician)) (unique (job (Tweakit Lem E) (computer technician))))
(and (job (Bitdiddle Ben) (computer wizard)) (unique (job (Bitdiddle Ben) (computer wizard))))
計算機プログラムの構造と解釈
ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542
«
»