SICP/ex-2_07-16.scm

(display "ex-2.7 - Start of extended exercise interval arithmetic\n")

(define (make-interval a b) (cons (min a b) (max a b)))
(define (lower-bound i) (min (car i) (cdr i)))
(define (upper-bound i) (max (car i) (cdr i)))
(define (print-interval i)
  (display "[")
  (display (lower-bound i))
  (display ", ")
  (display (upper-bound i))
  (display "]"))

(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

(define (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 (div-interval x y)
  (mul-interval x
                (make-interval (/ 1.0 (upper-bound y))
                               (/ 1.0 (lower-bound y)))))

(define i (make-interval 2. 3.))
(print-interval i) (newline)
(print-interval (add-interval i i))
(newline)

(display "\nex-2.8\n")

; For subtraction the lower bound could be the lower bound of the first
; interval minus the upper bound of the second interval. The upper bound
; is the upper bound of the first interval minux the lower bound of the second
; interval.

(define (sub-interval x y)
  (make-interval (- (lower-bound x) (upper-bound y))
                 (- (upper-bound x) (lower-bound y))))
(print-interval (sub-interval i i))
(newline)

(display "\nex-2.9\n")

(define (width-interval i)
  (/ (abs (- (upper-bound i) (lower-bound i))) 2.))

(define i (make-interval 2. 3.))
(define j (make-interval 6. 7.))
(display "Width of i and j:\n")
(display (width-interval i)) (newline)
(display (width-interval j)) (newline)

(display "Width after addition and subtraction:\n")
(display (width-interval (add-interval i j))) (newline)
(display (width-interval (sub-interval j i))) (newline)

(display "Width after multiplication and division\n")
(display (width-interval (mul-interval i j))) (newline)
(display (width-interval (div-interval j i))) (newline)

; For addition and subtraction the width is the sum of the widths of the input
; intervals.  For multiplication and division there is no simple arithmetic
; operation to get the width of the result.

; Moreover, when two intervals width the same width are multiplied the
; resulting width may be different to two other intervals with the same widths
; being multiplied.

(display "\nex-2.10\n")

(define i (make-interval 12 18))
(define j (make-interval -6 6))

(print-interval (div-interval i j)) (newline)

(define (div-interval x y)
  (if (and (< (lower-bound y) 0) (> (upper-bound y) 0))
    (error "Divider interval spans zero")
    (mul-interval x
                  (make-interval (/ 1.0 (upper-bound y))
                                 (/ 1.0 (lower-bound y))))))
; (div-interval i j) -> Error

(display "\nex-2.11\n")

(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 ((lx (lower-bound x))
        (ux (upper-bound x))
        (ly (lower-bound y))
        (uy (upper-bound y))
        (p? (lambda (x) (>= x 0)))
        (n? (lambda (x) (<  x 0))))
    (cond
      ((and (p? lx) (p? ux) (p? ly) (p? uy)) (make-interval (* lx ly) (* ux uy))) ; 1
      ((and (n? lx) (n? ux) (n? ly) (n? uy)) (make-interval (* ux uy) (* lx ly))) ; 2
      ((and (n? lx) (p? ux) (n? ly) (p? uy)) (make-interval (min (* lx uy) (* ux ly))
                                                            (max (* lx ly) (* ux uy)))) ; 3 - hard case
      ((and (p? lx) (p? ux) (n? ly) (n? uy)) (make-interval (* ux uy) (* lx ly))) ; 4
      ((and (p? lx) (p? ux) (n? ly) (p? uy)) (make-interval (* ux ly) (* ux uy))) ; 5
      ((and (n? lx) (n? ux) (p? ly) (p? uy)) (make-interval (* lx uy) (* ux ly))) ; 6
      ((and (n? lx) (n? ux) (n? ly) (p? uy)) (make-interval (* ux uy) (* ux ly))) ; 7
      ((and (n? lx) (p? ux) (n? ly) (n? uy)) (make-interval (* ux uy) (* lx uy))) ; 8
      ((and (n? lx) (p? ux) (p? ly) (p? uy)) (make-interval (* lx uy) (* ux uy))) ; 9
      (else (error "Missing implementation.")))))

(print-interval (mul-interval (make-interval 1 3) (make-interval 3 5))) (newline)
(print-interval (mul-interval (make-interval -1 -3) (make-interval -3 -5))) (newline)

; I copied the following from http://community.schemewiki.org/?sicp-ex-2.11 to test
; my implementation. The internet is amazing. Thanks jz!
(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)

(display "Run mul-interval tests successfully") (newline)

(display "\nex-2.12\n")

(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))

(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))

(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

(define (make-center-percent c p)
  (make-center-width c (* c (/ p 100))))

(define (percent i)
  (abs (* (/ (width-interval i) (center i)) 100)))

(define i (make-center-percent -10 10.0))
(print-interval i) (newline)
(display (percent i)) (newline)

(display "\nex-2.13\n")

; Show that under the assumption of small percentage tolerances there is a
; simple formula for the approximate percentage tolerance of the product of two
; intervals in terms of the tolerances of the factors. You may simplify the
; problem by assuming that all numbers are positive.

; The simpliefied formual is: pz = px + py see journal 2018 page 128 for proof
(let ((a (make-center-percent 5 0.8))
      (b (make-center-percent 10 0.6)))
  (display (percent (mul-interval a b))) (newline)
  (display (+ 0.008 0.006)) (newline)
(newline))

(newline) (display "Excercise 2.14") (newline)

(define (par1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))
(define (par2 r1 r2)
  (let ((one (make-interval 1 1)))
    (div-interval one
                  (add-interval (div-interval one r1)
                                (div-interval one r2)))))

(define (print-res r)
  (display (center r))
  (display "+-")
  (display (percent r))
  (display "%")
  (newline))

(define (diff_par r1 r2)
  (let ((rp1 (par1 r1 r2))
        (rp2 (par2 r1 r2)))
    (print-res rp1)
    (print-res rp2)))

(diff_par (make-center-percent 5 0.01) (make-center-percent 3 0.09))
(newline)
(diff_par (make-center-percent 60000000 0.5) (make-center-percent 3000 0.5))

(newline)
(let ((a (make-center-percent 33 0.5))
      (b (make-center-percent 17 0.8)))
  (print-res (add-interval a b))
  (print-res (mul-interval a b))
  (print-res (sub-interval a b))
  (print-res (div-interval a b))
  (newline))

(let ((a (make-center-percent 1000 0.5))
      (b (make-center-percent 1000 0.5)))
  (print-res (div-interval a a))
  (print-res (div-interval a b))
  (newline))


(display "Excercise 2.15") (newline)

(display
" Eva is right, because every variable reintroduced to the system
  increases the uncertainty of the interval. Thus the less a variable
  is used the less uncertainty and the tighter the bounds.") (newline)

(define (square-interval i)
  (make-interval 0 (square (upper-bound i))))

(newline)
(print-interval (mul-interval (make-interval -1 1) (make-interval -1 1)))
(newline)
(print-interval (square-interval (make-interval -1 1)))
(newline)

(display "\nex-2.16\n")
(display
" This is the hard problem of interval arithmetic. One way to avoid
 the issue is to change the input term so that each interval only
 occurs once. That way accounting for an interval multiple times can
 be avoided.")