sicp-ex-2.11



<< Previous exercise (2.10) | Index | Next exercise (2.12) >>


jz

Ben Bitdiddle should stick to diddling his own bits. His comment just obfuscates the code. But, if we know the signs of the endpoints, we have 3 possible cases for each interval: both ends positive, both negative, or an interval spanning zero; therefore, there are 3x3 = 9 possible cases to test for, which reduces the number of multiplications, except when both intervals span zero.

  
 ;; ex 2.7 
 (define (make-interval a b) (cons a b)) 
 (define (upper-bound interval) (max (car interval) (cdr interval))) 
 (define (lower-bound interval) (min (car interval) (cdr interval))) 
  
 (define (print-interval name i) 
   (newline) 
   (display name) 
   (display ": [") 
   (display (lower-bound i)) 
   (display ",") 
   (display (upper-bound i)) 
   (display "]")) 
  
 ;; Old multiplication (given) 
 (define (old-mul-interval x y) 
   (let ((p1 (* (lower-bound x) (lower-bound y))) 
         (p2 (* (lower-bound x) (upper-bound y))) 
         (p3 (* (upper-bound x) (lower-bound y))) 
         (p4 (* (upper-bound x) (upper-bound y)))) 
     (make-interval (min p1 p2 p3 p4) 
                    (max p1 p2 p3 p4)))) 
  
  
 ;; This looks a *lot* more complicated to me, and with the extra 
 ;; function calls I'm not sure that the complexity is worth it. 
 (define (mul-interval x y) 
   ;; endpoint-sign returns: 
   ;;     +1 if both endpoints non-negative, 
   ;;     -1 if both negative, 
   ;;      0 if opposite sign 
   (define (endpoint-sign i) 
     (cond ((and (>= (upper-bound i) 0) 
                 (>= (lower-bound i) 0)) 
            1) 
           ((and (< (upper-bound i) 0) 
                 (< (lower-bound i) 0)) 
            -1) 
           (else 0))) 
  
   (let ((es-x (endpoint-sign x)) 
         (es-y (endpoint-sign y)) 
         (x-up (upper-bound x)) 
         (x-lo (lower-bound x)) 
         (y-up (upper-bound y)) 
         (y-lo (lower-bound y))) 
  
     (cond ((> es-x 0) ;; both x endpoints are +ve or 0 
            (cond ((> es-y 0) 
                   (make-interval (* x-lo y-lo) (* x-up y-up))) 
                  ((< es-y 0) 
                   (make-interval (* x-up y-lo) (* x-lo y-up))) 
                  (else 
                   (make-interval (* x-up y-lo) (* x-up y-up))))) 
  
           ((< es-x 0) ;; both x endpoints are -ve 
            (cond ((> es-y 0) 
                   (make-interval (* x-lo y-up) (* x-up y-lo))) 
                  ((< es-y 0) 
                   (make-interval (* x-up y-up) (* x-lo y-lo))) 
                  (else 
                   (make-interval (* x-lo y-up) (* x-up y-lo))))) 
  
           (else  ;; x spans 0 
            (cond ((> es-y 0) 
                   (make-interval (* x-lo y-up) (* x-up y-up))) 
                  ((< es-y 0) 
                   (make-interval (* x-up y-lo) (* x-lo y-lo))) 
                  (else 
                   ;; Both x and y span 0 ... need to check values 
                   (make-interval (min (* x-lo y-up) (* x-up y-lo)) 
                                  (max (* x-lo y-lo) (* x-up y-up))))))))) 
  
  

The above is so gross I tested it out. Yes, I'm a keener.

  
 (define (eql-interval? a b) 
   (and (= (upper-bound a) (upper-bound b)) 
        (= (lower-bound a) (lower-bound b)))) 
  
 ;; Fails if the new mult doesn't return the same answer as the old 
 ;; naive mult. 
 (define (ensure-mult-works aH aL bH bL) 
   (let ((a (make-interval aL aH)) 
         (b (make-interval bL bH))) 
   (if (eql-interval? (old-mul-interval a b) 
                      (mul-interval a b)) 
       true 
       (error "new mult returns different value!"  
              a  
              b  
              (old-mul-interval a b) 
              (mul-interval a b))))) 
  
  
 ;; The following is overkill, but it found some errors in my 
 ;; work.  The first two #s are the endpoints of one interval, the last 
 ;; two are the other's.  There are 3 possible layouts (both pos, both 
 ;; neg, one pos one neg), with 0's added for edge cases (pos-0, 0-0, 
 ;; 0-neg). 
  
 (ensure-mult-works  +10 +10   +10 +10) 
 (ensure-mult-works  +10 +10   +00 +10) 
 (ensure-mult-works  +10 +10   +00 +00) 
 (ensure-mult-works  +10 +10   +10 -10) 
 (ensure-mult-works  +10 +10   -10 +00) 
 (ensure-mult-works  +10 +10   -10 -10) 
  
 (ensure-mult-works  +00 +10   +10 +10) 
 (ensure-mult-works  +00 +10   +00 +10) 
 (ensure-mult-works  +00 +10   +00 +00) 
 (ensure-mult-works  +00 +10   +10 -10) 
 (ensure-mult-works  +00 +10   -10 +00) 
 (ensure-mult-works  +00 +10   -10 -10) 
  
 (ensure-mult-works  +00 +00   +10 +10) 
 (ensure-mult-works  +00 +00   +00 +10) 
 (ensure-mult-works  +00 +00   +00 +00) 
 (ensure-mult-works  +00 +00   +10 -10) 
 (ensure-mult-works  +00 +00   -10 +00) 
 (ensure-mult-works  +00 +00   -10 -10) 
  
 (ensure-mult-works  +10 -10   +10 +10) 
 (ensure-mult-works  +10 -10   +00 +10) 
 (ensure-mult-works  +10 -10   +00 +00) 
 (ensure-mult-works  +10 -10   +10 -10) 
 (ensure-mult-works  +10 -10   -10 +00) 
 (ensure-mult-works  +10 -10   -10 -10) 
  
 (ensure-mult-works  -10 +00   +10 +10) 
 (ensure-mult-works  -10 +00   +00 +10) 
 (ensure-mult-works  -10 +00   +00 +00) 
 (ensure-mult-works  -10 +00   +10 -10) 
 (ensure-mult-works  -10 +00   -10 +00) 
 (ensure-mult-works  -10 +00   -10 -10) 
  
 (ensure-mult-works  -10 -10   +10 +10) 
 (ensure-mult-works  -10 -10   +00 +10) 
 (ensure-mult-works  -10 -10   +00 +00) 
 (ensure-mult-works  -10 -10   +10 -10) 
 (ensure-mult-works  -10 -10   -10 +00) 
 (ensure-mult-works  -10 -10   -10 -10) 
  
 ;; All of these run without any errors now. 
  
  

jsdalton

Yeah, Ben certainly has an evil streak.

I was able to reduce a bit of the clutter by reworking the way the conditional logic is framed. I observed that there were certain patterns in where values were getting passed to the call to make-interval. So rather than working through the conditions and calling make-interval accordingly, I set it up to select the appropriate value for each "slot".

For clarity everything else is the same as jz's solution above. The testing procedures he came up with were also invaluable in working out kinks. Ultimately I'm not sure my solution is any clearer or better -- it's quite possibly neither. It is a tiny bit more concise though:

 (define (mul-interval x y) 
      (define (endpoint-sign i)  
        (cond ((and (>= (upper-bound i) 0) 
                    (>= (lower-bound i) 0)) 
               1) 
              ((and (< (upper-bound i) 0) 
                    (< (lower-bound i) 0)) 
               -1) 
              (else 0))) 
  
      (let ((es-x (endpoint-sign x)) 
            (es-y (endpoint-sign y)) 
            (x-up (upper-bound x)) 
            (x-lo (lower-bound x)) 
            (y-up (upper-bound y)) 
            (y-lo (lower-bound y))) 
  
        (if (and (= es-x 0) (= es-y 0)) 
          ; Take care of the exceptional condition where we have to test 
          (make-interval (min (* x-lo y-up) (* x-up y-lo)) 
                         (max (* x-lo y-lo) (* x-up y-up))) 
  
          ; Otherwise, select which value goes in which "slot". I'm not sure 
          ; whether there is an intuitive way to explain *why* these 
          ; selections work. 
          (let ((a1 (if (and (<= es-y 0) (<= (- es-y es-x) 0)) x-up x-lo)) 
                (a2 (if (and (<= es-x 0) (<= (- es-x es-y) 0)) y-up y-lo)) 
                (b1 (if (and (<= es-y 0) (<= (+ es-y es-x) 0)) x-lo x-up)) 
                (b2 (if (and (<= es-x 0) (<= (+ es-x es-y) 0)) y-lo y-up))) 
            (make-interval (* a1 a2) (* b1 b2))))))