sicp-ex-4.75

  
  
 ;; add those code 
 (define (uniquely-asserted pattern frame-stream) 
  (stream-flatmap 
   (lambda (frame) 
    (let ((stream (qeval (negated-query pattern) 
                                         (singleton-stream frame)))) 
         (if (singleton-stream? stream) 
             stream 
             the-empty-stream))) 
   frame-stream)) 
 (put 'unique 'qeval uniquely-asserted) 
  
 (define (singleton-stream? s) 
  (and (not (stream-null? s)) 
       (stream-null? (stream-cdr s)))) 
  
 ;;; Query input: 
 (and (supervisor ?person ?boss) (unique (supervisor ?other ?boss))) 
  
 ;;; Query output: 
 (and (supervisor (Cratchet Robert) (Scrooge Eben)) (unique (supervisor (Cratchet Robert) (Scrooge Eben)))) 
 (and (supervisor (Reasoner Louis) (Hacker Alyssa P)) (unique (supervisor (Reasoner Louis) (Hacker Alyssa P)))) 

I don't know whether there is a mistake in the text book. It asks for finding the people with only one superior. But meteorgan just found those with only one subordinate.

I figure that the supervisor of A's supervisor is also A's supervisor. So my solution is as follows.

 (assert! (rule (staff-with-one-supervisor ?p1 ?p2) 
                (and (or (supervisor ?p1 ?p2) 
                         (and (supervisor ?p1 ?p3) 
                              (supervisor ?p3 p2))) 
                     (unique (all-supervisors ?p1 ?p))))) 
  
 ;;; Query input: 
 (staff-with-one-supervisor ?x ?y) 
  
 ;;; Quary results: 
 (staff-with-one-supervisor (aull dewitt) (warbucks oliver)) 
 (staff-with-one-supervisor (scrooge eben) (warbucks oliver)) 
 (staff-with-one-supervisor (bitdiddle ben) (warbucks oliver)) 

Use the `outranked-by` defined before exercise 4.57.

 ;;; Query input: 
 (and (supervisor ?person ?boss) (unique (outranked-by ?person ?bosses))) 
  
 ;;; Query results: 
 (and (supervisor (Aull DeWitt) (Warbucks Oliver)) (unique (outranked-by (Aull DeWitt) (Warbucks Oliver)))) 
 (and (supervisor (Scrooge Eben) (Warbucks Oliver)) (unique (outranked-by (Scrooge Eben) (Warbucks Oliver)))) 
 (and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (unique (outranked-by (Bitdiddle Ben) (Warbucks Oliver))))