sicp-ex-4.60



<< Previous exercise (4.5) | Index | Next exercise (4.61) >>


woofy

A version that actually works with the book's evaluator implementation:

  
  
  
 (assert! (rule (before ?x ?y) 
             (lisp-value 
                 (lambda (s1 s2) 
                     (define (list->string s) 
                         (fold-right 
                             string-append 
                             "" 
                             (map symbol->string s))) 
                     (string<? (list->string s1) (list->string s2))) 
                 ?x 
                 ?y))) 
  
 (assert! (rule (lives-near ?person-1 ?person-2) 
             (and (address ?person-1 (?town . ?rest-1)) 
                  (address ?person-2 (?town . ?rest-2)) 
                  (before ?person-1 ?person-2)))) 
  
 ; Tests: 
  
 ;;; Query input: 
 (lives-near ?x ?y) 
  
 ;;; Query results: 
 (lives-near (aull dewitt) (reasoner louis)) 
 (lives-near (aull dewitt) (bitdiddle ben)) 
 (lives-near (fect cy d) (hacker alyssa p)) 
 (lives-near (bitdiddle ben) (reasoner louis)) 

The problem with this approach is that it changes the rule to say that (lives-near ?x ?y) is only true if they live in the same town and the first name comes before the second alphabetically, which can cause problems with queries where only one name is left unspecified. As an example, take this query:

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

Changing the definition of lives-near will change the result to the following:

 ;;; Query input: 
 (lives-near ?person (Bitdiddle Ben)) 
  
 ;;; Query results: 
 (lives-near (Aull DeWitt) (Bitdiddle Ben)) 

Since "Reasoner" comes after "Bitdiddle" alphabetically, the second result no longer satisfies the rule.



meteorgan

  
  
 because all the answers satisfy the rule. 
 we can sort the person in alphabetic order, then get only one pair. 
 (define (person->string person) 
   (if (null? person) 
       "" 
       (string-append (symbol->string (car person)) (person->string (cdr person))))) 
 (define (person>? p1 p2) 
   (string>? (person->sring p1) (person->string p2))) 
  
 (assert! (rule (asy-lives-near ?person1 ?person2) 
                (and (address ?person1 (?town . ?rest-1)) 
                        (address ?person2 (?town . ?rest-2)) 
                        (lisp-value person>? ?person1 ?person2))))  

yd

It seems that you cannot have a "lives-near" function that satisfy both: 1. doesn't print both pair (x y) and (y x) 2.worked both with query (x ?any) and (?any x)

Here is the reason: when 1. is preserved (e.g. (x y) is chosen), that means the other one (y x) doesn't satisfy the query, thus one of (x ?any) and (?any x) will be dropped.

when 2 is preserved, there is no reason for you to choose which one to drop in (x y) and (y x), even you cannot find they are the same one (in terms of meaning), unless using some built-in method to keep saving pairs that have been found during the evaluating.

in general case, to implement this feature, we need some kind of method that find a group of sentences that are the same in terms of meaning. It could be very hard because it's almost like the provable problem in pure math.


SteeleDynamics

It appears to me that there is a much simpler way to implement this: by constructing a predicate procedure and passing it as the predicate argument to a 'lisp-value' query. You can have alphabetical ordering by surname as a constraint, which will eliminate "commutative" frames. Below is the query evaluator input and output:

 1 |=> (initialize-data-base microshaft-data-base) 
 ;Value: done 
  
 1 |=> (query-driver-loop) 
  
 ;;; Query input: 
 (lives-near ?person (Hacker Alyssa P)) 
 ;;; Query results: 
 (lives-near (fect cy d) (hacker alyssa p)) 
  
 ;;; Query input: 
 (lives-near ?person-1 ?person-2) 
 ;;; Query results: 
 (lives-near (aull dewitt) (reasoner louis)) 
 (lives-near (aull dewitt) (bitdiddle ben)) 
 (lives-near (reasoner louis) (aull dewitt)) 
 (lives-near (reasoner louis) (bitdiddle ben)) 
 (lives-near (hacker alyssa p) (fect cy d)) 
 (lives-near (fect cy d) (hacker alyssa p)) 
 (lives-near (bitdiddle ben) (aull dewitt)) 
 (lives-near (bitdiddle ben) (reasoner louis)) 
  
 ;;; Query input: 
 (and (lives-near ?person-1 ?person-2) 
      (lisp-value (lambda (a b) (symbol<? (car a) (car b))) 
                  ?person-1 
                  ?person-2)) 
 ;;; Query results: 
 (and (lives-near (aull dewitt) (reasoner louis)) (lisp-value (lambda (a b) (symbol<? (car a) (car b))) (aull dewitt) (reasoner louis))) 
 (and (lives-near (aull dewitt) (bitdiddle ben)) (lisp-value (lambda (a b) (symbol<? (car a) (car b))) (aull dewitt) (bitdiddle ben))) 
 (and (lives-near (fect cy d) (hacker alyssa p)) (lisp-value (lambda (a b) (symbol<? (car a) (car b))) (fect cy d) (hacker alyssa p))) 
 (and (lives-near (bitdiddle ben) (reasoner louis)) (lisp-value (lambda (a b) (symbol<? (car a) (car b))) (bitdiddle ben) (reasoner louis))) 
  
 ;;; Query input: 
 End of input stream reached. 
 Post proelium, praemium.