Exercise 4.74

a) simple-flatten‘s argument is a stream whose elements are either the empty stream or a singleton stream. We need to filter out elements that are the empty stream and then take the first element of each resulting stream.

(define (simple-flatten stream)
  (stream-map stream-car
              (stream-filter (λ (s)
                               (not (stream-null? s)))

b) There is no difference in behaviour (as long as Alyssa’s assertions are correct.)

Exercise 4.71

(define (simple-query query-pattern frame-stream)
   (lambda (frame)
     (stream-append (find-assertions query-pattern frame)
                    (apply-rules query-pattern frame)))

Using the regular stream-append will evaluate both operands at call time. We’ve already seen the problems that rules can have in particular with rules that cause infinite loops, for example the rule for reverse in Exercise 4.68.
Using stream-append-delayed with the delayed second operand at least displays matching assertions and individual rule results as they are discovered while diving down the potentially infinite rabbit hole of rules. It’s not a 100% satisfactory but it’s better than the alternative.

Exercise 4.70

When we investigated streams we saw the constructor, cons-stream only evaluates the first item, not the second. That led to the surprising (at the time) infinite list of 1s (define ones (cons-stream 1 ones). To see why this is infinite look at the box and pointer diagrams.

infinite stream of ones
The dotted lines show how the value of ones will be evaluated once forced.
The exact same pattern and result is in the implementation of add-assertion! in this question.

(define (add-assertion! assertion)
  (store-assertion-in-index assertion)
        (cons-stream assertion THE-ASSERTIONS))

THE-ASSERTIONS becomes an infinite, self-referential stream.
Using let in add-assertion! and add-rules! forces their delayed values and avoids the infinite stream.
I’m glad we weren’t asked to implement these primitives. I’m not sure I would have spotted that problem and it could be a headache to find and fix.

Exercise 4.69

Source code for Exercise 4.69.

First, a relationship ends-in-grandson when it is grandson or it’s a list starting with a something ?greats followed by something that ends-in-grandson

 ; base case
   (rule (ends-in-grandson (grandson)))))
 ; other cases
   (rule (ends-in-grandson (?greats . ?rel))
         (ends-in-grandson ?rel))))

Note this doesn’t enforce that the relationship starts with great just that it starts with something
Some obvious tests:

(run-query '(ends-in-grandson (great great great son)))
; ==> '()
(run-query '(ends-in-grandson (great great great grandson)))
; ==> '((ends-in-grandson (great great great grandson)))

Next enforcing that a relationship starting with great ends in grandson

; great ... grandson x y
 ; x must be someone's son
 ; there must be a chain of relationships linking y and with x
   (rule ((great . ?rel) ?x ?y)
         (and (ends-in-grandson ?rel)
              (son ?x ?other)
              (?rel ?other ?y)))))

; Irad is Adam's grandson
   ((great grandson) Adam Irad)))

Finally the queries from the book and a couple of others

(run-query '((great grandson) ?g ?ggs))
; ==> '(((great grandson) Adam Irad))
(run-query '(?rel Adam Irad))
; ==> '(((great grandson) Adam Irad))

(run-query '(?rel Adam ?y))
; ==> '(((great grandson) Adam Irad)
;       (son Adam Cain))

(run-query '(?rel ?x Irad))
; ==> '(((great grandson) Adam Irad)
;       (son Enoch Irad))

Note: to avoid infinite loops we need to use the query evaluator that has the loop detector.

Exercise 4.68

Source code for Exercise 4.68.

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

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.