Exercise 4.68

Read Exercise 4.68 ~ Solution


;; from the book
(run-query '(assert! (rule (append-to-form () ?y ?y))))
(run-query '(assert! (rule (append-to-form (?u . ?v) ?y (?u . ?z))
                           (append-to-form ?v ?y ?z))))

;; base case an empty list
(run-query '(assert! (rule (reverse () ()))))
; reverse a list
; a list, L,  has a head and tail, H . T
; reversing the list is (reverse T) . H
(run-query '(assert! (rule (reverse (?h . ?t) ?y)
                           (and (reverse ?t ?reversed-t)
                                (append-to-form ?reversed-t (?h) ?y)))))

(run-query '(reverse (1 2 3) ?x))
;; ==> (reverse (1 2 3) (3 2 1))

So (reverse (1 2 3) ?x) works as expected, but (reverse ?x (1 2 3)) won’t.
To see why let’s look at the behaviour of reverse.

(reverse ?x (1 2 3))
(reverse (?hx . ?tx) y?)
(and (reverse ?tx ?reversed-tx)
     (append-to-form ?reversed-tx (?hx) ?y))
; but since ?x isn't bound
(reverse ?tx ?reversed-tx)
(reverse (?htx . ?ttx) ?reversed-tx)
(and (reverse ?htx ?reversed-htx)
     (append-to-form ?reversed-htx (?htx) ?reversed-tx))
; but since ?tx isn't bound
(reverse ?htx ?reversed-htx)
...
...
...

UPDATE:
However, using the evaluator with the loop detector results in an empty-stream of results.
Once the rule has been applied to all the frames, the duplicate query patterns all result in the empty-stream, and no recursive call is made to query-eval.
As soon as the reverse rule been applied to the possible frames, it will end.

Advertisements

Exercise 4.67

Read Exercise 4.67 ~ Solution ~ Some tests


I’ll come back to this after section 4.4.4
UPDATE: I’ve finally solved the elusive 4.67 loop detector.

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.

Add history management to the query evaluator using a hash table. The key is the queries with a canonical name for each variable. A canonical name is used because as query evaluation evolves new frames use numbers to distinguish identical variable names.

Update: Add history-remove! (see Grisha’s comment about why queries need to be removed from history after the rule body has been evaluated.)

;;; 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))
(define (history-remove! key)
  (hash-remove! history key))
;; 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:

  • Unify the rule’s conclusion.
  • Create a new instance of the query using the new frames created unifying the conclusion.
  • Save the new query instance in the history to avoid looping when evaluating the rule’s body.
  • Recursively evaluate the rule’s body and save the result.
  • Remove the new query instance from history.
  • Return the result of the evaluated rule’s body.
(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)
                  (let ((evaluated-rule
                         (qeval (rule-body clean-rule)
                                (singleton-stream unify-result))))
                    (history-remove! instance)
                    evaluated-rule)))))))

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

Exercise 4.66

Read Exercise 4.66 ~ Solution


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

Read Exercise 4.65 ~ Solution


(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

Read Exercise 4.64 ~ Solution


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

Read Exercise 4.63 ~ Solution


(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

Read Exercise 4.62 ~ Solution


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.