Serendip

Web Studio

問題4.76

;; 新しい conjoin 手続き
(define (conjoin conjuncts frame-stream)
  (if (empty-conjunction? conjuncts)
      frame-stream
      (merge-frame-streams
        (qeval (first-conjunct conjuncts) frame-stream)
        (conjoin (rest-conjuncts conjuncts) frame-stream))))

;; 2つのフレームのストリームをマージする手続き
(define (merge-frame-streams s1 s2)
  (stream-flatmap (lambda (frame1)
                          (stream-filter
                            (lambda (frame) (not (equal? frame 'failed)))
                            (stream-map
                              (lambda (frame2)
                                      (merge-frames frame1 frame2))
                              s2)))
                  s1))

;; 2つのフレームをマージする手続き
(define (merge-frames frame1 frame2)
  (if (null? frame1)
      frame2
      (let ((var (caar frame1))
            (val (cdar frame1)))
           (let ((extension (extend-if-possible var val frame2)))
                (if (equal? extension 'failed)
                    'failed
                    (merge-frames (cdr frame1) extension))))))

(put 'and 'qeval conjoin)

実行結果

;;; Query input:
(and (address ?x ?y) (supervisor ?x ?z))

;;; Query results:
(and (address (Aull DeWitt) (Slumerville (Onion Square) 5)) (supervisor (Aull DeWitt) (Warbucks Oliver)))
(and (address (Cratchet Robert) (Allston (N Harvard Street) 16)) (supervisor (Cratchet Robert) (Scrooge Eben)))
(and (address (Scrooge Eben) (Weston (Shady Lane) 10)) (supervisor (Scrooge Eben) (Warbucks Oliver)))
(and (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)) (supervisor (Reasoner Louis) (Hacker Alyssa P)))
(and (address (Tweakit Lem E) (Boston (Bay State Road) 22)) (supervisor (Tweakit Lem E) (Bitdiddle Ben)))
(and (address (Fect Cy D) (Cambridge (Ames Street) 3)) (supervisor (Fect Cy D) (Bitdiddle Ben)))
(and (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)) (supervisor (Hacker Alyssa P) (Bitdiddle Ben)))
(and (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)) (supervisor (Bitdiddle Ben) (Warbucks Oliver)))

;;; Query input:
(assert! (rule (lives-near ?person-1 ?person-2)
               (and (address ?person-1 (?town . ?rest-1))
                    (address ?person-2 (?town . ?rest-2))
                    (not (same ?person-1 ?person-2)))))

Assertion added to data base.

;;; Query input:
(lives-near ?x (Bitdiddle Ben))

;;; Query results:
(lives-near (Aull DeWitt) (Bitdiddle Ben))
(lives-near (Reasoner Louis) (Bitdiddle Ben))
(lives-near (Bitdiddle Ben) (Bitdiddle Ben))

問題4.77、問題4.78、問題4.79

パス

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る