sicp-ex-4.76



<< Previous exercise (4.75) | Index | Next exercise (4.77) >>


donald

  
 (define (new-conjoin conjuncts frame-stream) 
   (if (empty-conjunction? conjuncts) 
       frame-stream 
       (merge (qeval (first-conjunct conjuncts) 
                     frame-stream) 
              (new-conjoin (rest-conjuncts conjuncts) 
                           frame-stream)))) 
 (define (merge s1 s2) 
   (cond ((stream-null? s1) s2) 
         ((stream-null? s2) s1) 
         (else 
          (stream-flatmap (lambda (frame1) 
                            (stream-flatmap (lambda (frame2) 
                                              (merge-frame frame1 frame2)) 
                                            s2)) 
                          s1)))) 
 (define (merge-frame f1 f2) 
   (if (null? f1) 
       (singleton-stream f2) 
       (let ((b1 (car f1))) 
         (let ((b2 (assoc (car b1) f2))) 
           (if b2 
               (if (equal? (cdr b1) (cdr b2)) 
                   (merge-frame (cdr f1) f2) 
                   the-empty-stream) 
               (merge-frame (cdr f1) (cons b1 f2))))))) 

poly

Actually my solution is not complete. There are still some bugs to be improved and I have no enough time to improve it.

First of all, I don't think that changing the implementation of 'and' into the way that the problem 4.76 describes will always improve the efficiency. But I still implement it......

Second, if we just consider the each clause of 'and' are disjunct, and just separate the evaluation of each clause of 'and' just like the above one solution provided by donald (simply compare the cdr part of two different bindings with same variable in two frames), some input will not be seen as 'legal'.Take an instance:

 (and (append-to-form (1 2) (3 4) ?x) 
      (append-to-form (1) ?y ?x)) 

The implementation of append-to-form is the same as textbook's.

the value of '?y' is based on '?x'. But the '?x' in the second clause is apparently not bound. Its value should be seen as the same as '?x' in the first clause. But we just separate the two clauses. So it won't work and the input above will get nothing. The detail is kind of complicated.

The evaluation of first clause will get:

(((? 12 z) 3 4) ((? 14 y) 3 4) ((? 11 z) (? 12 u) ? 12 z) ((? 12 y) 3 4) ((? 12 v)) ((? 12 u) . 2) ((? x) (? 11 u) ? 11 z) ((? 11 y) 3 4) ((? 11 v) 2) ((? 11 u) . 1))

second is:

(((? 15 z) ? 17 y) ((? 15 y) ? 17 y) ((? x) (? 15 u) ? 15 z) ((? y) ? 15 y) ((? 15 v)) ((? 15 u) . 1))

As we can see, the '?x' binding in first one is ((? x) (? 11 u)), which is ((? x) (? 15 u) ? 15 z) in the second one. Apparently it will not be seen as the same if we simply compare its cdr part.

Actually, in some complex case, the value of bindings in the frame will always also be variables as above situation. So I think we need to find its final actual binding just like the procedure 'instantiate' in the query system do.

 (define (bind-final-value bind frame) 
   (define (copy exp) 
     (cond ((var? exp) 
            (let ((binding (binding-in-frame exp frame))) 
              (if binding 
                  (copy (binding-value binding)) 
                  exp))) 
           ((pair? exp) 
            (cons (copy (car exp)) (copy (cdr exp)))) 
           (else exp))) 
   (copy (binding-value bind))) 

Actually just using the 'instantiate' is also ok.

But after we use this to find the final binding value of '?x'. we will find the value of '?x' is not the same either.

first one: '(1 2 3 4)

second one: '(1 ? 17 y)

Actually, (? 17 y) is binded to (? 15 y), while (? 15 y) to (? y) (the one in the second clause). Now we just need to deside the value (? 17 y) so that we can get the values of (? y) and (? x) in the second clause.

the procedure is as follow, use the above two value of '?x' as arguments:

 (define (bind-pair-or-var var val) 
   ;; var can be (? 12 x) or (1 ? 12 x) 
   ;; or some more complex combination 
   (cond ((null? var) '()) 
         ((var? var) 
          (list (cons var val))) 
         ((pair? var) 
          (let ((1st (bind-pair-or-var (car var) (car val)))) 
            (if (not 1st) 
                (bind-pair-or-var (cdr var) (cdr val)) 
                (append 1st (bind-pair-or-var (cdr var) (cdr val)))))) 
         (else false))) 

After this we will get binding: ((? 17 y) 2 3 4). Just add it into the frame, then the original procedure provided by the text book will do the rest work.

My whole solution is as follows, it is kind of ugly...

 (define (conjoin conjuncts frame-stream) 
   (if (empty-conjunction? (rest-conjuncts conjuncts)) 
       (qeval (first-conjunct conjuncts) frame-stream) 
       (merge (qeval (first-conjunct conjuncts) frame-stream) 
              (conjoin (rest-conjuncts conjuncts) 
                       frame-stream)))) 
  
 (define (merge frame-stream-1 frame-stream-2) 
   (stream-flatmap 
    (lambda (frame-1) 
      (stream-flatmap 
       (lambda (frame-2) (check-bindings frame-1 frame-2)) 
       frame-stream-2)) 
    frame-stream-1)) 
  
 (define (check-bindings frame-1 frame-2) 
   (let ((match-result 
          (merge-match frame-1 frame-2))) 
     (if (eq? match-result 'failed) 
         the-empty-stream 
         (singleton-stream match-result)))) 
  
 (define (merge-match frame-1 frame-2) 
   ;; I haven't use the merge-match for recursion because I need to keep 
   ;; full version of frame-1 and frame-2 
   (define (iter f-1 f-2 res) 
     (if (null? f-1) 
         (append res f-2) 
         (let ((first (car f-1))) 
           (let ((match (binding-in-frame (binding-variable first) f-2))) 
             (if match 
                 (let ((val1 (bind-final-value first frame-1)) 
                       (val2 (bind-final-value match frame-2))) 
                   (cond ((and (has-var? val1) (not (has-var? val2))) 
                          (iter (cdr f-1) 
                                f-2 
                                (append (bind-pair-or-var val1 val2) 
                                        (cons first res)))) 
                         ((and (not (has-var? val1)) (has-var? val2)) 
                          (iter (cdr f-1) 
                                (append (bind-pair-or-var val2 val1) 
                                        f-2) 
                                (cons first res))) 
                         ((eq? val1 val2) 
                          (iter (cdr f-1) f-2 res)) 
                         (else 'failed))) 
                 (iter (cdr f-1) f-2 (cons first res))))))) 
   (iter frame-1 frame-2 '())) 
  
 (define (bind-final-value bind frame) 
   (define (copy exp) 
     (cond ((var? exp) 
            (let ((binding (binding-in-frame exp frame))) 
              (if binding 
                  (copy (binding-value binding)) 
                  exp))) 
           ((pair? exp) 
            (cons (copy (car exp)) (copy (cdr exp)))) 
           (else exp))) 
   (copy (binding-value bind))) 
  
 (define (has-var? exp) 
   (cond ((null? exp) false) 
         ((var? exp) true) 
         ((pair? exp) 
          (or (has-var? (car exp)) 
              (has-var? (cdr exp)))) 
         (else false))) 
  
 (define (bind-pair-or-var var val) 
   ;; var can be (? 12 x) or (1 ? 12 x) 
   ;; or some more complex combination 
   (cond ((null? var) '()) 
         ((var? var) 
          (list (cons var val))) 
         ((pair? var) 
          (let ((1st (bind-pair-or-var (car var) (car val)))) 
            (if (not 1st) 
                (bind-pair-or-var (cdr var) (cdr val)) 
                (append 1st (bind-pair-or-var (cdr var) (cdr val)))))) 
         (else false))) 
 ;;; Query input: 
 (and (append-to-form (1 2) (3 4) ?x) 
      (append-to-form (1) ?y ?x)) 
  
 ;;; Quary results: 
 (and (append-to-form (1 2) (3 4) (1 2 3 4))  
      (append-to-form (1) (2 3 4) (1 2 3 4))) 

Actually, if there are two variables in the clause and the first one is unknown, then the system will not find out the result even if the value of another one variable is given by the other clauses. Like:

 (and (append-to-form (3) (4) ?y) 
      (append-to-form ?x ?y (1 2 3 4))) 

If you just unfold the process of (append-to-form ?x ?y (1 2 3 4)), you will find that the '?x' has nothing to bound.

The above one is just one bug. Another one is for the consideration of 'not' and 'unique' procedure we define before. As we know this two is for filtering the result we find out. But there will be no frame to filter if we separate the evaluation of each clauses of 'and'.

That's all.