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 (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 (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 --