-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path2_11.scm
158 lines (138 loc) · 7.32 KB
/
2_11.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
#lang sicp
(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 (add-interval a b)
(make-interval (+ (lower-bound a) (lower-bound b))
(+ (upper-bound a) (upper-bound b))))
(define (sub-interval a b)
(add-interval a
(make-interval (- (upper-bound b)) (- (lower-bound b)))))
(define (mul-interval a b)
(let ((p1 (* (lower-bound a) (lower-bound b)))
(p2 (* (lower-bound a) (upper-bound b)))
(p3 (* (upper-bound a) (lower-bound b)))
(p4 (* (upper-bound a) (upper-bound b))))
(make-interval (min p1 p2 p3 p4)
(max p1 p2 p3 p4))))
(define (spans-zero? interval)
(if (and (or (< (lower-bound interval) 0)
(= (lower-bound interval) 0))
(or (> (upper-bound interval) 0)
(= (lower-bound interval) 0)))
#t
#f))
(define (div-interval a b)
(if (spans-zero? b)
(error "Trying to divide by interval that spans zero")
(mul-interval a
(make-interval (/ 1 (upper-bound b)) (/ 1 (lower-bound b))))))
(define (pos? x) (or (> x 0) (= x 0)))
(define (neg? x) (< x 0))
(define (mul-interval-cases a b)
(let ((la (lower-bound a))
(ua (upper-bound a))
(lb (lower-bound b))
(ub (upper-bound b)))
(cond ((and (pos? la) (pos? ua)
(pos? lb) (pos? ub))
(make-interval (* la lb) (* ua ub)))
((and (pos? la) (pos? ua)
(neg? lb) (neg? ub))
(make-interval (* ua lb) (* la ub)))
((and (neg? la) (neg? ua)
(pos? lb) (pos? ub))
(make-interval (* la ub) (* ua lb)))
((and (pos? la) (pos? ua)
(neg? lb) (pos? ub))
(make-interval (* ua lb) (* ua ub)))
((and (neg? la) (neg? ua)
(neg? lb) (neg? ub))
(make-interval (* ua ub) (* la lb)))
((and (neg? la) (pos? ua)
(pos? lb) (pos? ub))
(make-interval (* la ub) (* ua ub)))
((and (neg? la) (neg? ua)
(neg? lb) (pos? ub))
(make-interval (* la ub) (* la lb)))
((and (neg? la) (pos? ua)
(neg? lb) (neg? ub))
(make-interval (* ua lb) (* la lb)))
(else
(make-interval (min (* la ub) (* ua lb))
(max (* la lb) (* ua ub)))))))
(mul-interval-cases (make-interval +10 +10) (make-interval +10 +10))
(mul-interval-cases (make-interval +10 +10) (make-interval +00 +10))
(mul-interval-cases (make-interval +10 +10) (make-interval +00 +00))
(mul-interval-cases (make-interval +10 +10) (make-interval +10 -10))
(mul-interval-cases (make-interval +10 +10) (make-interval -10 +00))
(mul-interval-cases (make-interval +10 +10) (make-interval -10 -10))
(mul-interval-cases (make-interval +00 +10) (make-interval +10 +10))
(mul-interval-cases (make-interval +00 +10) (make-interval +00 +10))
(mul-interval-cases (make-interval +00 +10) (make-interval +00 +00))
(mul-interval-cases (make-interval +00 +10) (make-interval +10 -10))
(mul-interval-cases (make-interval +00 +10) (make-interval -10 +00))
(mul-interval-cases (make-interval +00 +10) (make-interval -10 -10))
(mul-interval-cases (make-interval +00 +00) (make-interval +10 +10))
(mul-interval-cases (make-interval +00 +00) (make-interval +00 +10))
(mul-interval-cases (make-interval +00 +00) (make-interval +00 +00))
(mul-interval-cases (make-interval +00 +00) (make-interval +10 -10))
(mul-interval-cases (make-interval +00 +00) (make-interval -10 +00))
(mul-interval-cases (make-interval +00 +00) (make-interval -10 -10))
(mul-interval-cases (make-interval +10 -10) (make-interval +10 +10))
(mul-interval-cases (make-interval +10 -10) (make-interval +00 +10))
(mul-interval-cases (make-interval +10 -10) (make-interval +00 +00))
(mul-interval-cases (make-interval +10 -10) (make-interval +10 -10))
(mul-interval-cases (make-interval +10 -10) (make-interval -10 +00))
(mul-interval-cases (make-interval +10 -10) (make-interval -10 -10))
(mul-interval-cases (make-interval -10 +00) (make-interval +10 +10))
(mul-interval-cases (make-interval -10 +00) (make-interval +00 +10))
(mul-interval-cases (make-interval -10 +00) (make-interval +00 +00))
(mul-interval-cases (make-interval -10 +00) (make-interval +10 -10))
(mul-interval-cases (make-interval -10 +00) (make-interval -10 +00))
(mul-interval-cases (make-interval -10 +00) (make-interval -10 -10))
(mul-interval-cases (make-interval -10 -10) (make-interval +10 +10))
(mul-interval-cases (make-interval -10 -10) (make-interval +00 +10))
(mul-interval-cases (make-interval -10 -10) (make-interval +00 +00))
(mul-interval-cases (make-interval -10 -10) (make-interval +10 -10))
(mul-interval-cases (make-interval -10 -10) (make-interval -10 +00))
(mul-interval-cases (make-interval -10 -10) (make-interval -10 -10))
;; both display the same thing
(mul-interval (make-interval +10 +10) (make-interval +10 +10))
(mul-interval (make-interval +10 +10) (make-interval +00 +10))
(mul-interval (make-interval +10 +10) (make-interval +00 +00))
(mul-interval (make-interval +10 +10) (make-interval +10 -10))
(mul-interval (make-interval +10 +10) (make-interval -10 +00))
(mul-interval (make-interval +10 +10) (make-interval -10 -10))
(mul-interval (make-interval +00 +10) (make-interval +10 +10))
(mul-interval (make-interval +00 +10) (make-interval +00 +10))
(mul-interval (make-interval +00 +10) (make-interval +00 +00))
(mul-interval (make-interval +00 +10) (make-interval +10 -10))
(mul-interval (make-interval +00 +10) (make-interval -10 +00))
(mul-interval (make-interval +00 +10) (make-interval -10 -10))
(mul-interval (make-interval +00 +00) (make-interval +10 +10))
(mul-interval (make-interval +00 +00) (make-interval +00 +10))
(mul-interval (make-interval +00 +00) (make-interval +00 +00))
(mul-interval (make-interval +00 +00) (make-interval +10 -10))
(mul-interval (make-interval +00 +00) (make-interval -10 +00))
(mul-interval (make-interval +00 +00) (make-interval -10 -10))
(mul-interval (make-interval +10 -10) (make-interval +10 +10))
(mul-interval (make-interval +10 -10) (make-interval +00 +10))
(mul-interval (make-interval +10 -10) (make-interval +00 +00))
(mul-interval (make-interval +10 -10) (make-interval +10 -10))
(mul-interval (make-interval +10 -10) (make-interval -10 +00))
(mul-interval (make-interval +10 -10) (make-interval -10 -10))
(mul-interval (make-interval -10 +00) (make-interval +10 +10))
(mul-interval (make-interval -10 +00) (make-interval +00 +10))
(mul-interval (make-interval -10 +00) (make-interval +00 +00))
(mul-interval (make-interval -10 +00) (make-interval +10 -10))
(mul-interval (make-interval -10 +00) (make-interval -10 +00))
(mul-interval (make-interval -10 +00) (make-interval -10 -10))
(mul-interval (make-interval -10 -10) (make-interval +10 +10))
(mul-interval (make-interval -10 -10) (make-interval +00 +10))
(mul-interval (make-interval -10 -10) (make-interval +00 +00))
(mul-interval (make-interval -10 -10) (make-interval +10 -10))
(mul-interval (make-interval -10 -10) (make-interval -10 +00))
(mul-interval (make-interval -10 -10) (make-interval -10 -10))