1 665c255d 2023-08-04 jrmu (define (add-interval x y)
  2 665c255d 2023-08-04 jrmu   (make-interval (+ (lower-bound x) (lower-bound y))
  3 665c255d 2023-08-04 jrmu 		 (+ (upper-bound x) (upper-bound y))))
  4 665c255d 2023-08-04 jrmu 
  5 665c255d 2023-08-04 jrmu (define (make-interval lower upper)
  6 665c255d 2023-08-04 jrmu   (cons lower upper))
  7 665c255d 2023-08-04 jrmu (define (upper-bound interval)
  8 665c255d 2023-08-04 jrmu   (cdr interval))
  9 665c255d 2023-08-04 jrmu (define (lower-bound interval)
 10 665c255d 2023-08-04 jrmu   (car interval))
 11 665c255d 2023-08-04 jrmu 
 12 665c255d 2023-08-04 jrmu (define (sub-interval x y)
 13 665c255d 2023-08-04 jrmu   (make-interval (- (lower-bound x) (upper-bound y))
 14 665c255d 2023-08-04 jrmu 		 (- (upper-bound x) (lower-bound y))))
 15 665c255d 2023-08-04 jrmu 
 16 665c255d 2023-08-04 jrmu (define (div-interval x y)
 17 665c255d 2023-08-04 jrmu   (define (spans-zero? interval)
 18 665c255d 2023-08-04 jrmu     (and (<= (lower-bound interval) 0)
 19 665c255d 2023-08-04 jrmu 	 (<= 0 (upper-bound interval))))
 20 665c255d 2023-08-04 jrmu   (if (spans-zero? y)
 21 665c255d 2023-08-04 jrmu       (error "Division by zero")
 22 665c255d 2023-08-04 jrmu       (mul-interval x
 23 665c255d 2023-08-04 jrmu 		    (make-interval (/ 1.0 (upper-bound y))
 24 665c255d 2023-08-04 jrmu 				   (/ 1.0 (lower-bound y))))))
 25 665c255d 2023-08-04 jrmu 
 26 665c255d 2023-08-04 jrmu (define (mul-interval x y)
 27 665c255d 2023-08-04 jrmu   (let ((lx (lower-bound x))
 28 665c255d 2023-08-04 jrmu 	(ly (lower-bound y))
 29 665c255d 2023-08-04 jrmu 	(ux (upper-bound x))
 30 665c255d 2023-08-04 jrmu 	(uy (upper-bound y)))
 31 665c255d 2023-08-04 jrmu     (cond ((and (< ux 0) 
 32 665c255d 2023-08-04 jrmu 		(< uy 0)) (make-interval (* ux uy)
 33 665c255d 2023-08-04 jrmu 					 (* lx ly)))
 34 665c255d 2023-08-04 jrmu 	  ((and (> lx 0)
 35 665c255d 2023-08-04 jrmu 		(> ly 0)) (make-interval (* lx ly)
 36 665c255d 2023-08-04 jrmu 					 (* ux uy)))
 37 665c255d 2023-08-04 jrmu 	  ((and (< ux 0)
 38 665c255d 2023-08-04 jrmu 		(> ly 0)) (make-interval (* lx uy)
 39 665c255d 2023-08-04 jrmu 					 (* ux ly)))
 40 665c255d 2023-08-04 jrmu 	  ((and (> lx 0)
 41 665c255d 2023-08-04 jrmu 		(< uy 0)) (make-interval (* ux ly)
 42 665c255d 2023-08-04 jrmu 					 (* lx uy)))
 43 665c255d 2023-08-04 jrmu 	  ((and (< lx 0)
 44 665c255d 2023-08-04 jrmu 		(> ux 0)
 45 665c255d 2023-08-04 jrmu 		(< uy 0)) (make-interval (* ux ly)
 46 665c255d 2023-08-04 jrmu 					 (* lx ly)))
 47 665c255d 2023-08-04 jrmu 	  ((and (< lx 0)
 48 665c255d 2023-08-04 jrmu 		(> ux 0)
 49 665c255d 2023-08-04 jrmu 		(> ly 0)) (make-interval (* lx uy)
 50 665c255d 2023-08-04 jrmu 					 (* ux uy)))
 51 665c255d 2023-08-04 jrmu 	  ((and (< ux 0)
 52 665c255d 2023-08-04 jrmu 		(< ly 0)
 53 665c255d 2023-08-04 jrmu 		(> uy 0)) (make-interval (* lx uy)
 54 665c255d 2023-08-04 jrmu 					 (* lx ly)))
 55 665c255d 2023-08-04 jrmu 	  ((and (> lx 0)
 56 665c255d 2023-08-04 jrmu 		(< ly 0)
 57 665c255d 2023-08-04 jrmu 		(> uy 0)) (make-interval (* ux ly)
 58 665c255d 2023-08-04 jrmu 					 (* ux uy)))
 59 665c255d 2023-08-04 jrmu 	  ((and (< lx 0)
 60 665c255d 2023-08-04 jrmu 		(> ux 0)
 61 665c255d 2023-08-04 jrmu 		(< ly 0)
 62 665c255d 2023-08-04 jrmu 		(> uy 0)) (make-interval (min (* lx uy)
 63 665c255d 2023-08-04 jrmu 					      (* ux ly))
 64 665c255d 2023-08-04 jrmu 					 (max (* lx lx)
 65 665c255d 2023-08-04 jrmu 					      (* ux uy)))))))
 66 665c255d 2023-08-04 jrmu 
 67 665c255d 2023-08-04 jrmu 
 68 665c255d 2023-08-04 jrmu 
 69 665c255d 2023-08-04 jrmu 
 70 665c255d 2023-08-04 jrmu (define (make-center-width c w)
 71 665c255d 2023-08-04 jrmu   (make-interval (- c w) (+ c w)))
 72 665c255d 2023-08-04 jrmu (define (center i)
 73 665c255d 2023-08-04 jrmu   (/ (+ (lower-bound i) (upper-bound i)) 2))
 74 665c255d 2023-08-04 jrmu (define (width i)
 75 665c255d 2023-08-04 jrmu   (/ (- (upper-bound i) (lower-bound i)) 2))
 76 665c255d 2023-08-04 jrmu 
 77 665c255d 2023-08-04 jrmu ;; width/center = tolerance = percent / 100
 78 665c255d 2023-08-04 jrmu ;; width = percent * center / 100
 79 665c255d 2023-08-04 jrmu (define (make-center-percent center percent)
 80 665c255d 2023-08-04 jrmu   (make-center-width center (abs (* percent center 0.01))))
 81 665c255d 2023-08-04 jrmu 
 82 665c255d 2023-08-04 jrmu ;; percent = 100 * width / center
 83 665c255d 2023-08-04 jrmu (define (percent interval)
 84 665c255d 2023-08-04 jrmu   (/ (* 100 (width interval))
 85 665c255d 2023-08-04 jrmu      (abs (center interval))))
 86 665c255d 2023-08-04 jrmu 
 87 665c255d 2023-08-04 jrmu (define (print-interval interval)
 88 665c255d 2023-08-04 jrmu   (display "Lb: ")
 89 665c255d 2023-08-04 jrmu   (display (lower-bound interval))
 90 665c255d 2023-08-04 jrmu   (display " Ub: ")
 91 665c255d 2023-08-04 jrmu   (display (upper-bound interval))
 92 665c255d 2023-08-04 jrmu   (newline))
 93 665c255d 2023-08-04 jrmu 
 94 665c255d 2023-08-04 jrmu (define (test-case actual expected)
 95 665c255d 2023-08-04 jrmu   (load-option 'format)
 96 665c255d 2023-08-04 jrmu   (newline)
 97 665c255d 2023-08-04 jrmu   (format #t "Actual: ~A Expected: ~A" actual expected))
 98 665c255d 2023-08-04 jrmu 
 99 665c255d 2023-08-04 jrmu (print-interval (make-center-percent 100.0 10))
100 665c255d 2023-08-04 jrmu (print-interval (make-interval 90.0 110.0))
101 665c255d 2023-08-04 jrmu (test-case (percent (make-center-percent 100.0 10)) 10)
102 665c255d 2023-08-04 jrmu (newline)
103 665c255d 2023-08-04 jrmu (print-interval (make-center-percent 2.0 5))
104 665c255d 2023-08-04 jrmu (print-interval (make-interval 1.9 2.1))
105 665c255d 2023-08-04 jrmu (test-case (percent (make-center-percent 2.0 5)) 5)
106 665c255d 2023-08-04 jrmu (newline)
107 665c255d 2023-08-04 jrmu (print-interval (make-center-percent 1.0 3))
108 665c255d 2023-08-04 jrmu (print-interval (make-interval 0.97 1.03))
109 665c255d 2023-08-04 jrmu (newline)
110 665c255d 2023-08-04 jrmu (test-case (percent (make-center-percent 1.0 3)) 3)
111 665c255d 2023-08-04 jrmu (print-interval (make-center-percent 0 100))
112 665c255d 2023-08-04 jrmu (print-interval (make-interval 0 0))
113 665c255d 2023-08-04 jrmu ;; this would give an error message...
114 665c255d 2023-08-04 jrmu ;; (test-case (percent (make-center-percent 0 100)) (error "Division by zero"))
115 665c255d 2023-08-04 jrmu (print-interval (make-center-percent 25 0))
116 665c255d 2023-08-04 jrmu (print-interval (make-interval 25 25))
117 665c255d 2023-08-04 jrmu (test-case (percent (make-center-percent 25 0)) 0)
118 665c255d 2023-08-04 jrmu 
119 665c255d 2023-08-04 jrmu (define (par1 r1 r2)
120 665c255d 2023-08-04 jrmu   (div-interval (mul-interval r1 r2)
121 665c255d 2023-08-04 jrmu 		(add-interval r1 r2)))
122 665c255d 2023-08-04 jrmu (define (par2 r1 r2)
123 665c255d 2023-08-04 jrmu   (let ((one (make-interval 1 1)))
124 665c255d 2023-08-04 jrmu     (div-interval one
125 665c255d 2023-08-04 jrmu 		  (add-interval (div-interval one r1)
126 665c255d 2023-08-04 jrmu 				(div-interval one r2)))))
127 665c255d 2023-08-04 jrmu 
128 665c255d 2023-08-04 jrmu (newline)
129 665c255d 2023-08-04 jrmu (print-interval (par1 (make-center-percent 25 5) (make-center-percent 20 3)))
130 665c255d 2023-08-04 jrmu (print-interval (par2 (make-center-percent 25 5) (make-center-percent 20 3)))
131 665c255d 2023-08-04 jrmu ;; both should be equal and centered around 11.11, but this is not so
132 665c255d 2023-08-04 jrmu 
133 665c255d 2023-08-04 jrmu (print-interval (div-interval (make-center-percent 25 1n) 
134 665c255d 2023-08-04 jrmu 			      (make-center-percent 25 1)))
135 665c255d 2023-08-04 jrmu 
136 665c255d 2023-08-04 jrmu ;; we'd expect this to give exactly 1?
137 665c255d 2023-08-04 jrmu