Implement 4.77

ex-4_70-79.scm

@@ -152,33 +152,103 @@
 (eval-query '(big-shot ?x))
 (newline)
 
-(display "\nex-4.77 - improved-not\n")
+(display "\nex-4.77 - improved-filter\n")
 
-; Exercise 4.77.  In section 4.4.3 we saw that not and lisp-value can cause the
+; I am simply putting conjucts with unbound-variables to the end. We could do
-; query language to give ``wrong'' answers if these filtering operations are
+; better by inserting the conjunct after the next conjunct that has all
-; applied to frames in which variables are unbound. Devise a way to fix this
+; variables binded, but this implementation works well enough.
-; shortcoming.
 
-; One idea is to perform the filtering in a ``delayed'' manner by
+(define (conjoin3 conjuncts frame-stream)
-; appending to the frame a ``promise'' to filter that is fulfilled only when
+  (if (empty-conjunction? conjuncts)
-; enough variables have been bound to make the operation possible. We could
+      frame-stream
-; wait to perform filtering until all other operations have been performed.
+      (let ((first (first-conjunct conjuncts))
-; However, for efficiency's sake, we would like to perform filtering as soon as
+            (rest (rest-conjuncts conjuncts)))
-; possible so as to cut down on the number of intermediate frames generated.
+        (if (filter-with-unbound-var? first frame-stream)
+          (conjoin3 (append rest (list first)) frame-stream)
+          (conjoin3 rest (qeval first frame-stream))))))
+
+(define (filter-with-unbound-var? operands frame-stream)
+  (and (or (tagged-list? operands 'not)
+           (tagged-list? operands 'lisp-value))
+       (unbound-variables? operands frame-stream)))
+
+(define (unbound-variables? operands frame-stream)
+  (define (tree-walk e)
+    (cond ((var? e) (list e))
+          ((pair? e) (append (tree-walk (car e))
+                             (tree-walk (cdr e))))
+          (else '())))
+  (let ((vars (tree-walk operands))
+        (frame (stream-car frame-stream)))
+    (define (iter vars)
+      (cond ((null? vars) #f)
+            ((binding-in-frame (car vars) frame) (iter (cdr vars)))
+            (else #t)))
+    (iter vars)))
+
+(put 'and3 'qeval conjoin3)
+
+;(eval-query
+;  '(and3 (supervisor ?x ?y)
+;         (not (job ?x (computer programmer)))))
+;
+;(eval-query
+;  '(and3 (not (job ?x (computer programmer)))
+;         (supervisor ?x ?y)))
 
-(display "--")
 (eval-query
-  '(and (supervisor ?x ?y)
+  '(rule (can-replace ?p1 ?p2)
-        (not (job ?x (computer programmer)))))
+         (and (or (and (job ?p1 ?j) (job ?p2 ?j))
-(display "\n--\n")
+                  (and (job ?p1 ?j1)
-
+                       (job ?p2 ?j2)
-(display "--")
+                       (can-do-job ?j1 ?j2)))
+              (not (same ?p1 ?p2)))))
 (eval-query
-  '(and (not (job ?x (computer programmer)))
+  '(and3 (lisp-value < ?s1 ?s2)
-        (supervisor ?x ?y)))
+         (can-replace ?p1 ?p2)
-(display "\n--\n")
+         (salary ?p1 ?s1)
+         (salary ?p2 ?s2)))
+(newline)
 
-(display "\nex-4.78\n")
+(display "\nex-4.78 - non-deterministic-query\n")
 
-(display "\nex-4.79\n")
+; Exercise 4.78.  Redesign the query language as a nondeterministic program to
+; be implemented using the evaluator of section 4.3, rather than as a stream
+; process. In this approach, each query will produce a single answer (rather
+; than the stream of all answers) and the user can type try-again to see more
+; answers. You should find that much of the mechanism we built in this section
+; is subsumed by nondeterministic search and backtracking. You will probably
+; also find, however, that your new query language has subtle differences in
+; behavior from the one implemented here. Can you find examples that illustrate
+; this difference?
+
+(display "\nex-4.79 - rule-application-environment\n")
+
+; Exercise 4.79.  When we implemented the Lisp evaluator in section 4.1, we saw
+; how to use local environments to avoid name conflicts between the parameters
+; of procedures. For example, in evaluating
+
+; (define (square x)
+;   (* x x))
+; (define (sum-of-squares x y)
+;   (+ (square x) (square y)))
+; (sum-of-squares 3 4)
+
+; there is no confusion between the x in square and the x in sum-of-squares,
+; because we evaluate the body of each procedure in an environment that is
+; specially constructed to contain bindings for the local variables. In the
+; query system, we used a different strategy to avoid name conflicts in
+; applying rules. Each time we apply a rule we rename the variables with new
+; names that are guaranteed to be unique. The analogous strategy for the Lisp
+; evaluator would be to do away with local environments and simply rename the
+; variables in the body of a procedure each time we apply the procedure.
+
+; Implement for the query language a rule-application method that uses
+; environments rather than renaming. See if you can build on your environment
+; structure to create constructs in the query language for dealing with large
+; systems, such as the rule analog of block-structured procedures. Can you
+; relate any of this to the problem of making deductions in a context (e.g.,
+; ``If I supposed that P were true, then I would be able to deduce A and B.'')
+; as a method of problem solving? (This problem is open-ended. A good answer is
+; probably worth a Ph.D.)