sicp-ex-4.60

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)) 

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

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

  
  
 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))))  

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.

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. 

I haven't implemented the query language yet, so not sure if this actually does what I think it does, but I believe this re-implementation of lives-near should work for all possible inputs:

 (rule (lives-near ?person-1 ?person-2) 
       (or 
         (and 
           (lisp-value person-alphabetical-lt? ?person-2 ?person-1) 
           (lives-near ?person-2 ?person-1)) 
         (and (address ?person-1 (?town . ?rest-1)) 
              (address ?person-2 (?town . ?rest-2)) 
              (not (same ?person-1 ?person-2))))) 
  

Assuming that person-alphabetical-lt? is some comparison method that does exactly what it sounds like it should.