Exercise 4.67

I’ll come back to this after section 4.4.4

UPDATE: I’ve finally solved the elusive 4.67 loop detector.

Query evaluator with loop detector
Exercise 4.67 tests

Since we need to prevent rules being applied to the same query pattern it makes sense to add a query pattern history. To do this, we instantiate the query pattern and any duplicates result in an empty stream of frames in response.

In the query evaluator add:

;;; Loop detection history
(define history (make-hash))
(define (reset-history!)
  (set! history (make-hash)))
(define (history-ref key)
  (hash-ref history key #f))
(define (history-add! key)
  (hash-set! history key #t))
;; Get the canonical name for a variable
;; when rules are applied new variables are generated - see:
;;    apply-a-rule -> rename-variable-in -> make-new-variable
;; so ?who becomes the variable (? who) which becomes (? 1 who) then (? 2 who) ...
;; the canonical name is (? who)
(define (canonical-name var)
  (if (number? (mcadr var))
      (mlist (mcar var) (mcaddr var))
      var))

Change apply-a-rule:

(define (apply-a-rule rule query-pattern query-frame)
  (let* [(clean-rule (rename-variables-in rule))
         (unify-result (unify-match query-pattern
                                    (conclusion clean-rule)
                                    query-frame))]
      (if (eq? unify-result 'failed)
          the-empty-stream
          (let ([instance (instantiate query-pattern
                            query-frame
                            (lambda (var frame)
                              (canonical-name var)))])
            (if (history-ref instance)
                (loop-detected instance)
                (begin
                  (history-add! instance)
                  (qeval (rule-body clean-rule)
                         (singleton-stream unify-result))))))))

Also add a call to reset the query pattern history to the driver loop.
I added a convenient interpret-query method to save typing into the driver loop which needs the call too.

(define (interpret-query query)
  (reset-history!)
  (let ((q (query-syntax-process query)))
    (cond ((assertion-to-be-added? q)
           (add-rule-or-assertion! (add-assertion-body q))
           (newline)
           (display "Assertion added to data base."))
          (else
           (newline)
           ; (display-stream
           (stream->list
            (stream-map
             (lambda (frame)
               (mlist->exp (instantiate q
                             frame
                             (lambda (v f)
                               (contract-question-mark v)))))
             (qeval q (singleton-stream '()))))))))

Time to test outranked-by and Louis’ version outranked-by-loop

(run-query
   '(outranked-by ?person ?who))

'((outranked-by (Aull DeWitt) (Warbucks Oliver))
  (outranked-by (Cratchet Robert) (Warbucks Oliver))
  (outranked-by (Cratchet Robert) (Scrooge Eben))
  (outranked-by (Reasoner Louis) (Bitdiddle Ben))
  (outranked-by (Scrooge Eben) (Warbucks Oliver))
  (outranked-by (Reasoner Louis) (Warbucks Oliver))
  (outranked-by (Bitdiddle Ben) (Warbucks Oliver))
  (outranked-by (Reasoner Louis) (Hacker Alyssa P))
  (outranked-by (Tweakit Lem E) (Bitdiddle Ben))
  (outranked-by (Fect Cy D) (Bitdiddle Ben))
  (outranked-by (Hacker Alyssa P) (Bitdiddle Ben)))

;; Louis Reasoner version which couldn't be run without the loop detector.
(run-query
 '(assert!
   (rule (outranked-by-loop ?staff-person ?boss)
         (or (supervisor ?staff-person ?boss)
             (and (outranked-by-loop ?middle-manager ?boss)
                  (supervisor ?staff-person ?middle-manager))))))

'((outranked-by-loop (Aull DeWitt) (Warbucks Oliver))
  (outranked-by-loop (Cratchet Robert) (Warbucks Oliver))
  (outranked-by-loop (Cratchet Robert) (Scrooge Eben))
  (outranked-by-loop (Tweakit Lem E) (Warbucks Oliver))
  (outranked-by-loop (Scrooge Eben) (Warbucks Oliver))
  (outranked-by-loop (Reasoner Louis) (Bitdiddle Ben))
  (outranked-by-loop (Bitdiddle Ben) (Warbucks Oliver))
  (outranked-by-loop (Fect Cy D) (Warbucks Oliver))
  (outranked-by-loop (Reasoner Louis) (Hacker Alyssa P))
  (outranked-by-loop (Hacker Alyssa P) (Warbucks Oliver))
  (outranked-by-loop (Tweakit Lem E) (Bitdiddle Ben))
  (outranked-by-loop (Fect Cy D) (Bitdiddle Ben))
  (outranked-by-loop (Hacker Alyssa P) (Bitdiddle Ben)))

Finally what about Mickey?

(run-query
 '(assert! (married Minnie Mickey)))
(run-query
 '(assert! (rule (married ?x ?y)
                 (married ?y ?x))))

(run-query '(married Mickey ?who))
'((married Mickey Minnie) (married Mickey Minnie))
Advertisements

Exercise 4.66

Ben has realised that query results can contain duplicates – as exemplified by the wheel rule. To find the sum of the salaries of every wheel:

(run-query '(sum ?amount 
                   (and (wheel ?who)
                        (salary ?who ?amount))))


(and (wheel ?who)
     (salary ?who ?amount))

(and (wheel (Warbucks Oliver)) (salary (Warbucks Oliver) 150000))
(and (wheel (Warbucks Oliver)) (salary (Warbucks Oliver) 150000))
(and (wheel (Bitdiddle Ben)) (salary (Bitdiddle Ben) 60000))
(and (wheel (Warbucks Oliver)) (salary (Warbucks Oliver) 150000))
(and (wheel (Warbucks Oliver)) (salary (Warbucks Oliver) 150000))

(sum ?amount) => 660000

To overcome this, some method of checking for unique values is needed, perhaps storing the intermediate results in a hash table or simple association list, keyed by sub-query and associated with the current frame. This takes account of the rules of unification – for example the parallel evaluation of or and serial nature of and – because the handling of frames already explicitly captures those rules.

Exercise 4.65

(rule (wheel ?person)
      (and (supervisor ?middle-manager ?person)
           (supervisor ?x ?middle-manager)))

f0 : []
(wheel ?who) matches the rule conclusion (wheel ?person) and creates a new frame:
f1 : [?person : ?who]


The rule body is evaluated using f1
(and (supervisor ?middle-manager ?person)
     (supervisor ?x ?middle-manager)))

The first part of the and is evaluated against f1
(supervisor ?middle-manager ?who) creates a new frame with 8 bindings
f2 :

  1. [?middle-manager : (Aull DeWitt) ?who : (Warbucks Oliver)]
  2. [?middle-manager : (Cratchet Robert) ?who : (Scrooge Eben)]
  3. [?middle-manager : (Scrooge Eben) ?who : (Warbucks Oliver)]
  4. [?middle-manager : (Bitdiddle Ben) ?who : (Warbucks Oliver)]
  5. [?middle-manager : (Reasoner Louis) ?who : (Hacker Alyssa P)]
  6. [?middle-manager : (Tweakit Lem E) ?who : (Bitdiddle Ben)]
  7. [?middle-manager : (Fect Cy D) ?who : (Bitdiddle Ben)]
  8. [?middle-manager : (Hacker Alyssa P) ?who : (Bitdiddle Ben)]

The second part of the and query is evaluated against f2
(supervisor ?x ?middle-manager) creates a frame with 5 bindings:
f3 :
[?x : (Cratchet Robert) ?middle-manager : (Scrooge Eben)] f3,3[?who : (Warbucks Oliver)]
[?x : (Tweakit Lem E) ?middle-manager : (Bitdiddle Ben)] f3,4[?who : (Warbucks Oliver)]
[?x : (Fect Cy D) ?middle-manager : (Bitdiddle Ben)] f3,4[?who : (Warbucks Oliver)]
[?x : (Hacker Alyssa P) ?middle-manager : (Bitdiddle Ben)] f3,4[?who : (Warbucks Oliver)]
[?x : (Reasoner Louis) ?middle-manager : (Hacker Alyssa P)] f3,7[?who : (Bitdiddle Ben)]

The query has now been evaluated with 5 results and so 5 answers are reported – but the original query asked for the bindings of the variable ?who which are traced back from f3 as shown above giving the result:

(wheel? (Warbucks Oliver))
(wheel? (Warbucks Oliver))
(wheel? (Warbucks Oliver))
(wheel? (Warbucks Oliver))
(wheel? (Bitdiddle Ben))

Exercise 4.64

The book explains that the query evaluator unifies the rule conclusion and rule body using an initial empty frame, f0, in which to bind the variables.
(outranked-by (Bitdiddle Ben) ?who) matches the rule (outranked-by ?staff-person ?boss). The empty frame, f0, is extended by creating a new frame, f1, binding ?staff-person to (Bitdiddle Ben) and ?boss to ?who

[?staff-person:(Bitdiddle Ben)  ?boss:?who]

and the body of the rule is unified against f1

(or (supervisor (Bitdiddle Ben) ?who)
          (and (outranked-by ?middle-manager ?who)
               (supervisor (Bitdiddle Ben) ?middle-manager))))

or queries are unified in parallel:

  • the first part of is a simple query using f1 which creates another frame extension, f2 [?who:(Warbucks Oliver)]
  • the second part is also a simple query which is unified using f1. Since it is an and query it is evaluated in series starting with (outranked-by ?middle-manager ?who) – note this is a separate variable ?who as the two branches of the or query are evaluated in parallel and have not yet been merged.

(outranked-by ?middle-manager ?who) will now be evaluated and the whole process repeats, creating an infinite loop.

Exercise 4.63

Source code for Exercise 4.63.

(run-query '(assert! (son Adam Cain)))
(run-query '(assert! (son Cain Enoch)))
(run-query '(assert! (son Enoch Irad)))
(run-query '(assert! (son Irad Mehujael)))
(run-query '(assert! (son Mehujael Methushael)))
(run-query '(assert! (son Methushael Lamech)))
(run-query '(assert! (wife Lamech Ada)))
(run-query '(assert! (son Ada Jabal)))
(run-query '(assert! (son Ada Jubal)))

(run-query '(assert! (rule (grandson ?x ?y)
                           (and (son ?x ?z)
                                (son ?z ?y)))))

(run-query '(assert! (rule (son ?x ?y)
                           (and (wife ?z ?y)
                                (son ?x ?z)))))

(run-query '(son ?x ?y))
(son Ada Jubal)
(son Ada Jabal)
(son Methushael Lamech)
(son Mehujael Methushael)
(son Irad Mehujael)
(son Enoch Irad)
(son Cain Enoch)
(son Adam Cain)
(son Methushael Ada)


(run-query '(grandson Cain ?y))
(grandson Cain Irad)

(run-query '(grandson ?y Methushael))
(grandson Irad Methushael)

(run-query '(grandson ?x ?y))
(grandson Mehujael Lamech)
(grandson Irad Methushael)
(grandson Mehujael Ada)
(grandson Enoch Mehujael)
(grandson Cain Irad)
(grandson Adam Enoch)
(grandson Methushael Jubal)
(grandson Methushael Jabal)

Exercise 4.62

Source code for Exercise 4.62.
Weird – adding rules by running assert! against the query evaluator works fine for this exercise.
There are two parts to defining last pair:
last-pair (x) (x) – by definition, and
last-pair (x . y) (z)
last-pair y (z)

(run-query '(assert! 
             (rule (last-pair (?x) (?x)))))
(run-query '(assert! 
             (rule (last-pair (?x . ?y) (?z))
                   (last-pair ?y (?z)))))

(run-query '(last-pair (3) ?x))
(last-pair (3) (3))

(run-query '(last-pair (1 2 3) ?x))
(last-pair (1 2 3) (3))

(run-query '(last-pair (2 ?x) (3)))
(last-pair (2 3) (3))

(last-pair ?x (3)) is not possible to solve – there are an infinite number of solutions.

Exercise 4.61

Source code for Exercise 4.61.
For some reason the queries in the question won’t evaluate if I assert! the rules directly before executing the query. After a little testing, I found that adding the rule to the microshaft database, which is defined in the same file as the query evaluator, and initialising the database as usual works as expected. I have no idea why it works one way and not the other. Of course for this question the results are easy to work out without evaluating them, but that is half the fun.

(run-query '(?x next-to ?y in (1 (2 3) 4)))
((2 3) next-to 4 in (1 (2 3) 4))
(1 next-to (2 3) in (1 (2 3) 4))
(run-query '(?x next-to 1 in (2 1 3 1)))
(3 next-to 1 in (2 1 3 1))
(2 next-to 1 in (2 1 3 1))