sicp-ex-2.11

First things first, let's pre-empt some headaches by redefining our `make-interval` constructor.

 (define (make-interval a b) 
         (if (< a b) 
                 (cons a b) 
                 (cons b a))) 

Now we can be certain that the lower-bound of any interval will be ALWAYS be less than its upper-bound. You can also place this test inside of the `upper-bound` and `lower-bound` procedures but since we'll be calling those functions more often than our constructor, I figure we should just put it in the constructor.

The next thing we want to do is define some kind of test to ensure correctness of our new `mul-interval` operation. This part took me longer than the rest of the exercise, but once I had some good tests set up I was able to get through the problem very quickly.

The tricky part was generating test data. I abused the `for-each` `map` and `append` procedures to make a procedure which takes two lists and produces a list of all intervals which could be produced from elements of each list. e.g. If you gave it '(a b) '(c d) it would give back '(ac ad bc bd). Because our interval constructor automatically orders the upper and lower bounds, (make-interval a c) and (make-interval c a) are equivalent.

 ; Warning. This is a hack. It makes no promises 
 ; of performance, comprehension, or maintainability. 
 ; It simply does what it needs to do. 
  
 (define (generate-intervals) 
         (define test-list '()) 
  
         ; These lists can be edited by hand to produce different 
         ; interval sets. I try to make sure both lists contain 
         ; at least one 0 and some negative/positive numbers 
         ; with same/different values to ensure a variety of 
         ; intervals. 
  
         (define test-data 
                 (cons (list 0 1 2 3 4 5 -6 -7 -8 -9 -10) 
                       (list 5 4 3 2 1 0 -1 -2 -3 -4 -5))) 
         (for-each 
                 (lambda (x) (set! test-list (append test-list x))) 
                 (map    (lambda (x)     (map    (lambda (y) (make-interval x y)) 
                                                 (cdr test-data))) 
                         (car test-data))) 
  
         ; Our testing procedure will also be abusing for-each 
         ; and map to make combinations, so we take our test list 
         ; and pair it with its reverse ensure more varied 
         ; combinations of pairs. 
  
         (cons test-list (reverse test-list))) 
  
 ; Capture the result of `generate-intervals` so we don't have to 
 ; run it again. 
  
 (define test-intervals 
         (generate-intervals)) 
  

Now that nasty business is over we can write out our test.

  
 ; `test` will take two procedures, call each one 
 ; with the same data and compare their results. 
 ; We will hard-code the test-data because the 
 ; alternative is more than my job's worth. If 
 ; you want to use a different data-set, alter 
 ; the `generate-intervals` procedure. 
  
 (define (test f g) 
  
         ; We need to define a special kind 
         ; of equality operator for intervals 
  
         (define (interval-equals a b) 
                 (and (= (lower-bound a) (lower-bound b)) (= (upper-bound a) (upper-bound b)))) 
  
         ; We will test every single possible combination 
         ; of pairs from either list. Thanks to the 
         ; commutativity of multiplication, this is fairly 
         ; straightforward. 
         ; If a pair passes the test, nothing gets printed 
         ; to the console, but if a pair fails, then both 
         ; the original intervals, as well as the results 
         ; of applying f and g to said intervals will be printed. 
  
         (for-each (lambda (x) 
                         (for-each (lambda (y) 
                                         (cond   ((interval-equals (f x y) (g x y)) #t) 
                                                 (else 
                                                         (newline) 
                                                         (display "failed on inputs: " 
                                                         (display x) (display y) 
                                                         (newline) 
                                                         (display (f x y)) (display (g x y)) 
                                                         (newline)))) 
                                   (cdr test-intervals))) 
                   (car test-intervals)))) 

We still need more tests, but nothing as awful as what we've already done. These next tests will be used in the body of our new mul-interval procedure. We want to define some procedures to tell us when a pair of numbers are both negative, both positive, or have opposite signs. I decided to start by testing for opposite-ness and then I defined the other two tests in terms of the opposite test.

 (define (opposite-pair? a b) 
         (if (positive? a) 
                 (negative? b) 
                 (positive? b))) 
  
 (define (positive-pair? a b) 
         (if (opposite-pair? a b) 
                 #f 
                 (positive? a))) 
  
 (define (negative-pair? a b) 
         (if (opposite-pair? a b) 
                 #f 
                 (negative? a))) 

NOW we can start writing our new interval multiplication procedure, with the help of our `test` procedure. We will keep the old `mul-interval` procedure in scope of our new one, so we can call it during the course of designing our case analysis. This ensures that we're never breaking any more than we need to at any given time.

 (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)))) 
  
 (define (mul-interval x y) 
  
         ; We will capture the boundaries 
         ; of each interval as variables 
         ; to avoid repeated function calls 
  
         (let        ((x0 (lower-bound x)) 
                      (x1 (upper-bound x)) 
                      (y0 (lower-bound y)) 
                      (y1 (upper-bound y))) 
  
                 ; At the moment, mul-interval just 
                 ; passes its arguments on to 
                 ; `old-mul-interval` 
  
                 (cond (else (old-mul-interval x y))))) 
  
 ; nothing will be printed as both procedures are basically the same. 
  
 (test old-mul-interval mul-interval) 

Now we can design our cases one at a time. For instance:

 (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)))) 
  
 (define (mul-interval x y) 
         (let        ((x0 (lower-bound x)) 
                      (x1 (upper-bound x)) 
                      (y0 (lower-bound y)) 
                      (y1 (upper-bound y))) 
  
                 (cond   ((negative-pair? x0 x1) 
                                 (make-interval (* x0 x1) (* y0 y1))) 
                         (else (old-mul-interval x y))))) 
  
 (test old-mul-interval mul-interval) 

The above code will only fail and print results for multiplications in which the first pair is negative. If we add a nested cond block we can narrow even further:

 (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)))) 
  
 (define (mul-interval x y) 
         (let        ((x0 (lower-bound x)) 
                      (x1 (upper-bound x)) 
                      (y0 (lower-bound y)) 
                      (y1 (upper-bound y))) 
  
                 (cond   ((negative-pair? x0 x1) 
                                 (cond   ((negative-pair? y0 y1) 
                                                 (make-interval (* x0 y0) (* x1 y1)) 
                                         (else (old-mul-interval x y))))) 
  
                         (else (old-mul-interval x y))))) 
  
 (test old-mul-interval mul-interval) 

Now it will only fail and print results for multiplications in which the first pair is negative and the second pair is negative.

I'm gonna skip to the answer now. If you're reading this because you're stuck, I encourage you to take what I wrote, try to solve the rest of the problem and then come back.

 (define (make-interval a b) 
         (if (< a b) 
                 (cons a b) 
                 (cons b a))) 
  
 (define (lower-bound interval) (car interval)) 
 (define (upper-bound interval) (cdr interval)) 
  
 (define (mul-interval x y) 
         (define (opposite-pair? a b) 
                 (if (positive? a) 
                         (negative? b) 
                         (positive? b))) 
  
         (define (positive-pair? a b) 
                 (if (opposite-pair? a b) 
                         #f 
                         (positive? a))) 
  
         (define (negative-pair? a b) 
                 (if (opposite-pair? a b) 
                         #f 
                         (negative? a))) 
         (let        ((x0 (lower-bound x)) 
                      (x1 (upper-bound x)) 
                      (y0 (lower-bound y)) 
                      (y1 (upper-bound y))) 
                 (cond   ((negative-pair? x0 x1) 
                                 (cond   ((opposite-pair? y0 y1) 
                                                 (make-interval (* x0 y0) (* x0 y1))) 
                                         ((negative-pair? y0 y1) 
                                                 (make-interval (* x1 y1) (* x0 y0))) 
                                         (else 
                                                 (make-interval (* x1 y0) (* x0 y1))))) 
                         ((positive-pair? x0 x1) 
                                 (cond   ((opposite-pair? y0 y1) 
                                                 (make-interval (* x1 y0) (* x1 y1))) 
                                         ((negative-pair? y0 y1) 
                                                 (make-interval (* x1 y0) (* x0 y1))) 
                                         (else 
                                                 (make-interval (* x0 y0) (* x1 y1))))) 
                         (else 
                                 (cond   ((positive-pair? y0 y1) 
                                                 (make-interval (* x0 y1) (* x1 y1))) 
                                         ((negative-pair? y0 y1) 
                                                 (make-interval (* x1 y0) (* x0 y0))) 
                                         (else    
                                                 (make-interval 
                                                         ((lambda (a b) (if (< a b) a b)) (* x0 y1) (* x1 y0)) 
                                                         ((lambda (a b) (if (> a b) a b)) (* x0 y0) (* x1 y1)))))))))  
  
 (define (generate-intervals) 
         (define test-list '()) 
         (define test-data 
                 (cons (list 0 1 2 3 4 5 -6 -7 -8 -9 -10) 
                       (list 5 4 3 2 1 0 -1 -2 -3 -4 -5))) 
         (for-each 
                 (lambda (x) (set! test-list (append test-list x))) 
                 (map    (lambda (x)     (map    (lambda (y) (make-interval x y)) 
                                                 (cdr test-data))) 
                         (car test-data))) 
         (cons test-list test-list)) 
  
 (define test-intervals 
         (generate-intervals)) 
  
 (define (test f g) 
         (define (interval-equals a b) 
                 (and (= (lower-bound a) (lower-bound b)) (= (upper-bound a) (upper-bound b)))) 
         (for-each (lambda (x) 
                         (for-each (lambda (y) 
                                         (cond   ((interval-equals (f x y) (g x y)) #t) 
                                                 (else 
                                                         (newline) 
                                                         (display x) (display y) 
                                                         (newline) 
                                                         (display (f x y)) (display (g x y)) 
                                                         (newline)))) 
                                   (cdr test-intervals))) 
                   (car test-intervals))) 
  
 (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)))) 
  
 (test old-mul-interval mul-interval) 

The new mul-interval procedure is WAY longer than the old one. Maybe some day I'll come back to it and check to see if all this optimization was really worth it. Let me know if I made any mistakes. I know the testing procedures don't completely combine the sets (each set should be able to combine with itself). Plus I notice everyone else was fussing about intervals which span 0 or have 0 as one or both boundaries. I think those cases were automatically generated and thus covered in my tests but I could be wrong.

I agree with everyone else here, Ben is very mean, this took a long time to answer.

First I split intervals into three groups using this interval sign:

 ; Signs for Intervals: 
 ; 
 ; +1: Sits only in the positives 
 ;  0: Contains 0, or includes 0 in it's bounds 
 ; -1: Sits only in the negatives 
 ; 
 ; To see how this works draw a chart of the operator, along side a 
 ; chart of s. 
 (define (sign-interval iv) 
   (let* ((l (lower-bound-interval iv)) 
         (u (upper-bound-interval iv)) 
         (s (sign (* u l)))) 
     (if (= s -1) 
         0 
         (* (sign l) s)))) 

Then I went through every combination of sign of two intervals, discarding with respect commutating (when switching the signs around gives you the same result as something else you have worked out), on paper, working out the combinations of multiplications needed, I resulted with this:

 (define (symbol->sign s) 
   (cond 
     ((eq? s  0)  0) 
     ((eq? s '+)  1) 
     ((eq? s '-) -1))) 
  
 ; This took me a long time to do. 
 ; I hope you appreciate this imagined reader of my code. 
 (define (mul-interval a b) 
   (let ((sa (sign-interval a)) 
         (sb (sign-interval b))) 
     ; Signs: Returns true if the signs given match the intervals 
     (define (signs a b) 
         (and (= sa (symbol->sign a)) (= sb (symbol->sign b)))) 
     ; Pos: Retrieves the (p)osition of the (i)nterval 
     (define (pos i p) 
       (if (eq? p 'u) (upper-bound-interval i) (lower-bound-interval i))) 
     ; Mult: Multiplies the value of the position of a (pa) by the value of the position of b (pb) 
     (define (mult pa pb) ; (u)pper or (l)ower for pa and pb 
       (* (pos a pa) (pos b pb))) 
     ; This is the core of the function:  
     (cond 
       ((signs '+ '+) (make-interval (mult 'l 'l) (mult 'u 'u))) 
       ((signs '- '+) (make-interval (mult 'l 'u) (mult 'u 'l))) 
       ((signs  0 '+) (make-interval (mult 'l 'u) (mult 'u 'u))) 
       ((signs '+ '-) (mul-interval b a)) 
       ((signs '- '-) (make-interval (mult 'u 'u) (mult 'l 'l))) 
       ((signs  0 '-) (make-interval (mult 'u 'l) (mult 'l 'l))) 
       ((signs '+  0) (mul-interval b a)) 
       ((signs '-  0) (mul-interval b a)) 
       ((signs  0  0) (make-interval 
                       (min (mult 'l 'u) (mult 'u 'l)) 
                       (max (mult 'l 'l) (mult 'u 'u)))) 
       ) 
     ) 
   ) 

Then I built some code to test it:

 (define (random-interval) 
   (define width 5) 
   (define granularity 0.25) 
   (define (random-point) 
     (let* ((num-granules (inexact->exact (/ width granularity))) 
            (a-granule (random (+ num-granules 1))) 
            (scaled-granule (* a-granule granularity)) 
            (scaled-and-shifted-granule (- scaled-granule (/ width 2)))) 
       scaled-and-shifted-granule)) 
   (let ((p1 (random-point)) 
         (p2 (random-point))) 
          (make-interval (min p1 p2) (max p1 p2)))) 
  
 (define (format-interval iv) 
   (define $ number->string) 
   (string-append 
    "[" ($ (lower-bound-interval iv)) "," ($ (upper-bound-interval iv)) "]")) 
  
 (define (repeat-call f n) 
   (f) 
   (if (= n 1) 
       nil 
       (repeat-call f (- n 1))) 
   ) 
  
 (define (equal?-interval a b) 
   (and 
    (= 
     (upper-bound-interval a) 
     (upper-bound-interval b)) 
    (= 
     (lower-bound-interval a) 
     (lower-bound-interval b)))) 
  
 (define (test-new-mul-interval) 
   (define number-of-tests 1000) 
   (define (error i1 i2) 
     (newline) 
     (display "Failed Match: ") 
     (display (format-interval i1)) 
     (display " , ") 
     (display (format-interval i2)) 
     (display " => ") 
     (display (format-interval (old-mul-interval i1 i2))) 
     (display " != ") 
     (display (format-interval (mul-interval i1 i2))) 
     (newline)) 
   (define (test) 
     (let ((i1 (random-interval)) 
           (i2 (random-interval))) 
       (if  
        (equal?-interval (old-mul-interval i1 i2) (mul-interval i1 i2)) 
        (display ".") 
        (error i1 i2)) 
       )) 
   (repeat-call test number-of-tests) 
   ) 

And everything seems to pass, so I think it is working :)

Contact me at (join-with-dots jared b ross) on gmail

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-lo 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. 
  
  

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

This solutions has 9 cases, exactly as it is required by the problem statement, and all of them are clearly visible (although I wouldn't say readable). I had to redefine positive? predicate that is provided by my scheme interpreter. It also passes all of jz's test cases.

  
 (define (mul-interval x y) 
   (define (positive? x) (>= x 0)) 
   (define (negative? x) (< x 0)) 
   (let ((xl (lower-bound x)) 
         (xu (upper-bound x)) 
         (yl (lower-bound y)) 
         (yu (upper-bound y))) 
     (cond ((and (positive? xl) (positive? yl)) 
            (make-interval (* xl yl) (* xu yu))) 
           ((and (positive? xl) (negative? yl)) 
            (make-interval (* xu yl) (* (if (negative? yu) xl xu) yu))) 
           ((and (negative? xl) (positive? yl)) 
            (make-interval (* xl yu) (* xu (if (negative? xu) yl yu)))) 
           ((and (positive? xu) (positive? yu)) 
            (let ((l (min (* xl yu) (* xu yl))) 
                  (u (max (* xl yl) (* xu yu)))) 
              (make-interval l u))) 
           ((and (positive? xu) (negative? yu)) 
            (make-interval (* xu yl) (* xl yl))) 
           ((and (negative? xu) (positive? yu)) 
            (make-interval (* xl yu) (* xl yl))) 
           (else 
            (make-interval (* xu yu) (* xl yl)))))) 
  

This was a mess, and I agree that Ben is extremely unhelpful. I worked out the nine combinations of legal interval signs (eg, an interval cannot be +- because any positive number is greater than any negative. Having worked out those combinations, I generated some test intervals to see what the max and min products for each possible combination were. (I actually did this in python, as im much more fluent in that, and wasn't really sure how to do it in scheme. atomik did it up top, but used for-each and map, but since I'm working through the book in order, i haven't got to those yet).

This got me which bounds to multiply for the min and max for each. I then realized I had the problem of zeros. So, I systematically tested effects of a zero as an endpoint for each type of interval (++, -+, --) and came to the conclusion that i could treat zeros as positive, as they would behave in that way, or push the multiplication into the trouble case of -+*-+.

What followed was the cond block to end all cond blocks. My next challenge would be to make a procedure that simplifies those ands at least, but I want to move on.

 ; patt |  min  |  max 
 ; ++++ | al bl | ah bh 
 ; ++-+ | ah bl | ah bh 
 ; ++-- | ah bl | al bh 
 ; -+++ | al bh | ah bh 
 ; -+-+ | trouble case 
 ; -+-- | ah bl | al bl 
 ; --++ | al bh | ah bl 
 ; ---+ | al bh | al bl 
 ; ---- | ah bh | al bl 
  
 (define (pos? n) (>= 0)) 
 (define (neg? n) (not (pos? n))) 
  
 (define (mul-interval a b) 
   (let ((al (lower-bound a)) 
         (ah (upper-bound a)) 
         (bl (lower-bound b)) 
         (bh (upper-bound b))) 
     (cond ((and (pos? al) (pos? ah) (pos? bl) (pos? bh)) 
            (make-interval (* al bl) (* ah bh))) 
           ((and (pos? al) (pos? ah) (neg? bl) (pos? bh)) 
            (make-interval (* ah bl) (* ah bh))) 
           ((and (pos? al) (pos? ah) (neg? bl) (neg? bh)) 
            (make-interval (* ah bl) (* al bh))) 
           ((and (neg? al) (pos? ah) (pos? bl) (pos? bh)) 
            (make-interval (* al bh) (* ah bh))) 
           ((and (neg? al) (pos? ah) (neg? bl) (neg? bh)) 
            (make-interval (* ah bl) (* al bl))) 
           ((and (neg? al) (neg? ah) (pos? bl) (pos? bh)) 
            (make-interval (* al bh) (* ah bl))) 
           ((and (neg? al) (neg? ah) (neg? bl) (pos? bh)) 
            (make-interval (* al bh) (* al bl))) 
           ((and (neg? al) (neg? ah) (neg? bl) (neg? bh)) 
            (make-interval (* ah bh) (* al bl))) 
           ((and (neg? al) (pos? ah) (neg? bl) (pos? bh)) 
            ; our trouble case 
            (let ((p1 (* al bl)) 
                  (p2 (* al bh)) 
                  (p3 (* ah bl)) 
                  (p4 (* ah bh))) 
              (make-interval (min p1 p2 p3 p4) 
                             (max p1 p2 p3 p4))))))) 

What a mess. It might save on multiplications but it certainly didn't on programmer work, headaches, or readability.

Here is my code. It is a little simpler. But I still agree that Ben's advice is awful...

  
 (define (mul-interval x y) 
   (let ((x1 (lower x)) 
         (x2 (upper x)) 
         (y1 (lower y)) 
         (y2 (upper y))) 
     (let ((x-neg (< x2 0)) 
           (x-pos (> x1 0)) 
           (y-neg (< y2 0)) 
           (y-pos (> y1 0))) 
       (cond (x-neg (cond (y-neg (make-interval (* x2 y2) (* x1 y1))) 
                          (y-pos (make-interval (* x1 y2) (* x2 y1))) 
                          (else (make-interval (* x1 y2) (* x1 y1))))) 
             (x-pos (cond (y-neg (make-interval (* x2 y1) (* x1 y2))) 
                          (y-pos (make-interval (* x1 y1) (* x2 y2))) 
                          (else (make-interval (* x2 y1) (* x2 y2))))) 
             (else (cond (y-neg (make-interval (* x2 y1) (* x1 y1))) 
                         (y-pos (make-interval (* x1 y2) (* x2 y2))) 
                         (else (make-interval (min (* x1 y2) (* x2 y1)) 
                                              (max (* x1 y1) (* x2 y2)))))))))) 

Here's a slightly cleaned up solution of what rjk had. You'll notice it has 7 cond statements because the solution for -x1, -x2, +y1, +y2, is equivalent to -x1, -x2, -y1, +y2.

  
 (define (pos? x) (< 0 x)) 
 (define (neg? x) (> 0 x)) 
  
 (define (mul-interval x y) 
   (let ((x1 (lower-bound x)) 
         (x2 (upper-bound x)) 
         (y1 (lower-bound y)) 
         (y2 (upper-bound y))) 
     (cond ((and (pos? x1) (pos? y1)) 
            (make-interval (* x1 y1) (* x2 y2))) 
           ((and (pos? x2) (pos? y1)) 
            (make-interval (* x1 y2) (* x2 y2))) 
           ((and (pos? x1) (pos? y2)) 
            (make-interval (* x2 y1) (* x2 y2))) 
           ((and (neg? x2) (pos? y2)) 
            (make-interval (* x1 y2) (* x2 y1))) 
           ((and (pos? x2) (neg? y2)) 
            (make-interval (* x1 y2) (* x2 y1))) 
           ((and (neg? x2) (neg? y2)) 
            (make-interval (* x1 y1) (* x2 y2))) 
           ((and (pos? x2) (pos? y2)) 
            (let ((i1 (* x1 y1)) 
                  (i2 (* x1 y2)) 
                  (i3 (* x2 y1)) 
                  (i4 (* x2 y2))) 
              (make-interval (min i1 i2 i3 i4) 
                             (max i1 i2 i3 i4))))))) 

Here's an attempt of a more readable version by using an auxiliary procedure to test for the signs:

  
 (define (mul-interval x y) 
   (let ((+? positive?) 
         (-? negative?) 
         (lx (lower-bound x)) 
         (ly (lower-bound y)) 
         (ux (upper-bound x)) 
         (uy (upper-bound y))) 
     (cond ((test-signs +? +? +? +? x y) 
            (make-interval  (* lx ly) (* ux uy))) 
           ((test-signs +? +? -? +? x y) 
            (make-interval (* ux ly) (* ux uy) )) 
           ((test-signs -? +? +? +? x y) 
            (make-interval (* lx uy) (* ux uy) )) 
           ((test-signs -? -? +? +? x y) 
            (make-interval (* lx uy) (* ux ly) )) 
           ((test-signs +? +? -? -? x y) 
            (make-interval (* ux ly) (* lx uy) )) 
           ((test-signs -? +? -? -? x y) 
            (make-interval (* ux ly) (* lx ly) )) 
           ((test-signs -? -? -? +? x y) 
            (make-interval (* lx uy) (* lx ly) )) 
           ((test-signs -? -? -? -? x y) 
            (make-interval (* ux uy) (* lx ly) )) 
           ((test-signs -? +? -? +? x y) 
            (let ((p1 (* lx ly)) 
                  (p2 (* lx uy)) 
                  (p3 (* ux ly)) 
                  (p4 (* ux uy))) 
              (make-interval (min p1 p2 p3 p4) 
                             (max p1 p2 p3 p4))))))) 
  
 (define (test-signs lx-test ux-test ly-test uy-test x y) 
   (and (lx-test (lower-bound x)) 
        (ux-test (upper-bound x)) 
        (ly-test (lower-bound y)) 
        (uy-test (upper-bound y))))