Blob


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