Track changes to Num superclasses
[nofib.git] / gc / fulsom / Interval.hs
1 {-
2 - Fulsom (The Solid Modeller, written in Haskell)
3 -
4 - Copyright 1990,1991,1992,1993 Duncan Sinclair
5 -
6 - Permissiom to use, copy, modify, and distribute this software for any
7 - purpose and without fee is hereby granted, provided that the above
8 - copyright notice and this permission notice appear in all copies, and
9 - that my name not be used in advertising or publicity pertaining to this
10 - software without specific, written prior permission. I makes no
11 - representations about the suitability of this software for any purpose.
12 - It is provided ``as is'' without express or implied warranty.
13 -
14 - Duncan Sinclair 1993.
15 -
16 - Interval arithmetic package.
17 -
18 -}
19
20 module Interval(Interval, (#), pt, sqr,
21 tophalf, bothalf, topbit,
22 lo, hi, mid1, mid2,
23 up,down,unpt)
24 where
25
26 infix 4 #,:#:
27
28 data Interval a = Pt a | a :#: a deriving (Show{-was:Text-})
29
30
31 pt a = Pt a
32 a # b = a :#: b
33
34 instance (Ord a, Eq a) => Eq (Interval a) where
35 a == b = a >= b && a <= b -- Not correct - but it will do.
36 a /= b = a > b || a < b
37
38
39 instance (Ord a) => Ord (Interval a) where
40 (<) = ivLess
41 (<=) = ivLeEq
42 (>) = ivGreat
43 (>=) = ivGrEq
44 min = ivMin
45 max = ivMax
46
47
48 instance (Num a,Ord a,Eq a,Show{-was:Text-} a) => Num (Interval a) where
49 (+) = ivPlus
50 (*) = ivMult
51 negate = ivNegate
52 abs = ivAbs
53 signum = ivSignum
54 fromInteger = ivFromInteger
55
56
57 instance (Show a,Num a,Ord a,Fractional a) => Fractional (Interval a) where
58 (/) = ivDiv
59 fromRational = ivFromRational
60
61 -- instance (Fractional a,Ord a,Floating a) => - not this ?
62 instance (Show a,RealFloat a) =>
63 Floating (Interval a) where
64 pi = Pt pi
65 exp = ivExp
66 log = ivLog
67 sqrt = ivSqrt
68 (**) = ivPower
69 sin = ivSin
70 cos = ivCos
71 tan = ivTan
72 asin = ivAsin
73 acos = ivAcos
74 atan = ivAtan
75 sinh = ivSinh
76 cosh = ivCosh
77 tanh = ivTanh
78 asinh = ivAsinh
79 acosh = ivAcosh
80 atanh = ivAtanh
81
82
83 -- Error functions - un-used.
84
85 error0 = error "Not implemented."
86 error1 a = error "Not implemented."
87 error2 a b = error "Not implemented."
88 error3 a b c = error "Not implemented."
89 error4 a b c d = error "Not implemented."
90
91
92 -- Eq class functions
93
94
95 -- Ord class functions
96
97 ivLess (Pt b) (Pt c) = b < c
98 ivLess (a :#: b) (c :#: d) = b < c
99 ivLess (Pt b) (c :#: d) = b < c
100 ivLess (a :#: b) (Pt c) = b < c
101
102 ivLeEq (Pt b) (Pt d) = b <= d
103 ivLeEq (a :#: b) (c :#: d) = b <= d
104 ivLeEq (Pt b) (c :#: d) = b <= d
105 ivLeEq (a :#: b) (Pt d) = b <= d
106
107 ivGreat (Pt a) (Pt d) = a > d
108 ivGreat (a :#: b) (c :#: d) = a > d
109 ivGreat (Pt a) (c :#: d) = a > d
110 ivGreat (a :#: b) (Pt d) = a > d
111
112 ivGrEq (Pt a) (Pt c) = a >= c
113 ivGrEq (a :#: b) (c :#: d) = a >= c
114 ivGrEq (Pt a) (c :#: d) = a >= c
115 ivGrEq (a :#: b) (Pt c) = a >= c
116
117 ivMin (Pt a) (Pt c) = Pt (min a c)
118 ivMin (a :#: b) (c :#: d) = (min a c) :#: (min b d)
119 ivMin (Pt a) (c :#: d) | a < c = Pt a
120 | otherwise = c :#: min a d
121 ivMin (a :#: b) (Pt c) | c < a = Pt c
122 | otherwise = a :#: min c b
123
124 ivMax (Pt a) (Pt c) = Pt (max a c)
125 ivMax (a :#: b) (c :#: d) = (max a c) :#: (max b d)
126 ivMax (Pt a) (c :#: d) | a > d = Pt a
127 | otherwise = max a c :#: d
128 ivMax (a :#: b) (Pt c) | c > b = Pt c
129 | otherwise = max c a :#: b
130
131 -- Num class functions
132
133 ivPlus (Pt a) (Pt c) = Pt (a+c)
134 ivPlus (a :#: b) (c :#: d) = a+c :#: b+d
135 ivPlus (Pt a) (c :#: d) = a+c :#: a+d
136 ivPlus (a :#: b) (Pt c) = a+c :#: b+c
137
138 ivNegate (Pt a) = Pt (negate a)
139 ivNegate (a :#: b) = negate b :#: negate a
140
141 ivMult (Pt a) (Pt c) = Pt (a*c)
142 ivMult (a :#: b) (c :#: d) | (min a c) > 0 = a*c :#: b*d
143 | (max b d) < 0 = b*d :#: a*c
144 | otherwise = minmax [e,f,g,h]
145 where
146 e = b * c
147 f = a * d
148 g = a * c
149 h = b * d
150 ivMult (Pt a) (c :#: d) | a > 0 = a*c :#: a*d
151 | a < 0 = a*d :#: a*c
152 | otherwise = (Pt 0)
153 ivMult (c :#: d) (Pt a) | a > 0 = a*c :#: a*d
154 | a < 0 = a*d :#: a*c
155 | otherwise = (Pt 0)
156
157 -- minmax finds the lowest, and highest in a list - used for mult.
158 -- Should use foldl rather than foldr
159
160 minmax [a] = a :#: a
161 minmax (a:as) = case True of
162 True | (a > s) -> f :#: a
163 True | (a < f) -> a :#: s
164 otherwise -> f :#: s
165 where
166 (f :#: s) = minmax as
167
168 ivAbs (Pt a) = Pt (abs a)
169 ivAbs (a :#: b) | a<=0 && 0<=b = 0 :#: (max (abs a) (abs b))
170 | a<=b && b<0 = b :#: a
171 | 0<a && a<=b = a :#: b
172 | otherwise = error "abs doesny work!"
173
174 ivSignum (Pt a) = Pt (signum a)
175 ivSignum (a :#: b) = (signum a) :#: (signum b)
176
177 ivFromInteger a = Pt (fromInteger a)
178
179 -- Fractional class functions
180
181 ivDiv a (Pt c) = ivMult a (Pt (1/c))
182 ivDiv a (c :#: d) = ivMult a (1/c :#: 1/d)
183 ivFromRational a = Pt (fromRational a)
184
185 -- Floating class functions
186
187 -- ivPi () = fromRational pi
188
189 ivExp (Pt a) = Pt (exp a)
190 ivExp (a :#: b) = (exp a) :#: (exp b)
191
192 ivLog (Pt a) = Pt (log a)
193 ivLog (a :#: b) = (log a) :#: (log b)
194
195 ivSqrt (Pt a) = Pt (sqrt a)
196 ivSqrt (a :#: b) = (sqrt a) :#: (sqrt b)
197
198 ivPower x y = exp (log x * y) -- Optimise for x ** 2
199
200
201 ivSin :: (Floating a) => (Interval a) -> (Interval a)
202 ivSin a = error "Floating op not defined."
203 ivCos :: (Floating a) => (Interval a) -> (Interval a)
204 ivCos a = error "Floating op not defined."
205 ivTan :: (Floating a) => (Interval a) -> (Interval a)
206 ivTan a = error "Floating op not defined."
207 ivAsin :: (Floating a) => (Interval a) -> (Interval a)
208 ivAsin a = error "Floating op not defined."
209 ivAcos :: (Floating a) => (Interval a) -> (Interval a)
210 ivAcos a = error "Floating op not defined."
211 ivAtan :: (Floating a) => (Interval a) -> (Interval a)
212 ivAtan a = error "Floating op not defined."
213 ivSinh :: (Floating a) => (Interval a) -> (Interval a)
214 ivSinh a = error "Floating op not defined."
215 ivCosh :: (Floating a) => (Interval a) -> (Interval a)
216 ivCosh a = error "Floating op not defined."
217 ivTanh :: (Floating a) => (Interval a) -> (Interval a)
218 ivTanh a = error "Floating op not defined."
219 ivAsinh :: (Floating a) => (Interval a) -> (Interval a)
220 ivAsinh a = error "Floating op not defined."
221 ivAcosh :: (Floating a) => (Interval a) -> (Interval a)
222 ivAcosh a = error "Floating op not defined."
223 ivAtanh :: (Floating a) => (Interval a) -> (Interval a)
224 ivAtanh a = error "Floating op not defined."
225
226 -- Extra math functions not part of classes
227
228 sqr (Pt a) = Pt (a*a)
229 sqr (a :#: b) | a > 0 = a*a :#: b*b
230 | b < 0 = b*b :#: a*a
231 | otherwise = 0 :#: (max e f)
232 where
233 e = a * a
234 f = b * b
235
236
237 -- Other Functions specific to interval type
238
239 tophalf (a :#: b) = (a+b)/2 :#: b
240 bothalf (a :#: b) = a :#: (a+b)/2
241 topbit (a :#: b) = (a+b)/2-0.001 :#: b
242
243 lo (a :#: b) = a
244 hi (a :#: b) = b
245
246 down (a :#: b) = Pt a
247 up (a :#: b) = Pt b
248
249 unpt (Pt a) = a
250
251 mid1 (a :#: b) = Pt (a + (b-a)/3)
252 mid2 (a :#: b) = Pt (b - (b-a)/3)
253
254
255 -- END --