Working on 4.76
parent
823f0e34dd
commit
751e20229c
|
@ -65,23 +65,94 @@
|
|||
|
||||
(display "\nex-4.75 - unique\n")
|
||||
|
||||
;(eval-query
|
||||
; '(unique (job ?x (computer wizard))))
|
||||
;(newline)
|
||||
;
|
||||
;(eval-query
|
||||
; '(unique (job ?x (computer programmer))))
|
||||
;(newline)
|
||||
;
|
||||
;(eval-query
|
||||
; '(and (job ?x ?j) (unique (job ?anyone ?j))))
|
||||
;(newline)
|
||||
;
|
||||
;(eval-query
|
||||
; '(and (job ?p ?j) (unique (supervisor ?s ?p))))
|
||||
;(newline)
|
||||
|
||||
; Implementation of uniquely-asserted in sicp-query.
|
||||
(display "[answered]\n")
|
||||
|
||||
(display "\nex-4.76 - more-efficient-and\n")
|
||||
|
||||
; Exercise 4.76. Our implementation of and as a series combination of queries
|
||||
; (figure 4.5) is elegant, but it is inefficient because in processing the
|
||||
; second query of the and we must scan the data base for each frame produced by
|
||||
; the first query. If the data base has N elements, and a typical query
|
||||
; produces a number of output frames proportional to N (say N/k), then scanning
|
||||
; the data base for each frame produced by the first query will require N2/k
|
||||
; calls to the pattern matcher. Another approach would be to process the two
|
||||
; clauses of the and separately, then look for all pairs of output frames that
|
||||
; are compatible. If each query produces N/k output frames, then this means
|
||||
; that we must perform N2/k2 compatibility checks -- a factor of k fewer than
|
||||
; the number of matches required in our current method.
|
||||
|
||||
; Devise an implementation of and that uses this strategy. You must implement a
|
||||
; procedure that takes two frames as inputs, checks whether the bindings in the
|
||||
; frames are compatible, and, if so, produces a frame that merges the two sets
|
||||
; of bindings. This operation is similar to unification.
|
||||
|
||||
(define (stream-combinations s1 s2)
|
||||
(stream-flatmap
|
||||
(lambda (x1) (stream-map (lambda (x2) (append x1 x2)) s2))
|
||||
s1))
|
||||
|
||||
(define (conjoin conjuncts frame-stream)
|
||||
(define (unify-bindings bindings)
|
||||
(define (go-unify bindings frame)
|
||||
(if (null? bindings)
|
||||
frame
|
||||
(let* ((binding (car bindings))
|
||||
(var (predicate binding))
|
||||
(val (args binding)))
|
||||
(go-unify (cdr bindings) (unify-match var val frame)))))
|
||||
(go-unify bindings '()))
|
||||
|
||||
(define (unify-frame-streams frame-stream-1 frame-stream-2)
|
||||
(display "UNIFY-FRAME-STREAMS\n")
|
||||
(let ((potential-bindings (stream-combinations frame-stream-1 frame-stream-2)))
|
||||
(stream-filter
|
||||
(lambda (f) (not (eq? f 'failed)))
|
||||
(stream-map unify-bindings potential-bindings))))
|
||||
|
||||
(define (unify-frame-stream-list frame-stream-list)
|
||||
(if (null? (cdr frame-stream-list))
|
||||
(car frame-stream-list)
|
||||
(let ((frame-stream (unify-frame-streams (car frame-stream-list)
|
||||
(cadr frame-stream-list))))
|
||||
(display frame-stream) (newline)
|
||||
(unify-frame-stream-list (cons frame-stream (cddr frame-stream-list))))))
|
||||
|
||||
(define (qeval-conjunction conjunction)
|
||||
(qeval conjunction frame-stream))
|
||||
|
||||
(let ((frame-stream-list (map qeval-conjunction conjuncts)))
|
||||
(unify-frame-stream-list frame-stream-list)))
|
||||
|
||||
(put 'and 'qeval conjoin)
|
||||
|
||||
(eval-query
|
||||
'(unique (job ?x (computer wizard))))
|
||||
'(rule (big-shot ?p)
|
||||
(and (job ?p (?div1 . ?rest1))
|
||||
(supervisor ?p ?boss)
|
||||
(job ?boss (?div2 . ?rest2))
|
||||
(not (same ?div1 ?div2)))))
|
||||
|
||||
(eval-query '(big-shot ?x))
|
||||
(newline)
|
||||
|
||||
(eval-query
|
||||
'(unique (job ?x (computer programmer))))
|
||||
(newline)
|
||||
|
||||
(eval-query
|
||||
'(and (job ?x ?j) (unique (job ?anyone ?j))))
|
||||
(newline)
|
||||
|
||||
(eval-query
|
||||
'(and (job ?p ?j) (unique (supervisor ?s ?p))))
|
||||
(newline)
|
||||
|
||||
(display "\nex-4.76\n")
|
||||
|
||||
(display "\nex-4.77\n")
|
||||
|
||||
|
|
|
@ -465,7 +465,6 @@
|
|||
|
||||
(define (extend variable value frame)
|
||||
(cons (make-binding variable value) frame))
|
||||
|
||||
|
||||
;;;;From Section 4.1
|
||||
|
||||
|
|
Loading…
Reference in New Issue