1 module BasicNumber (BasicNumber (..), makeReal, makeRational, RealT{-partain-}) where 2 3 import RealM 4 import Ratio--1.3 5 6 data BasicNumber = BasIntegerC Integer 7 | BasRationalC Rational 8 | BasRealC RealT 9 deriving () 10 11 12 makeReal (a@(BasRealC _)) = a 13 makeReal (BasRationalC a) = if (numerator a) == 0 14 then BasRealC (int2Real 0) 15 else BasRealC (divReal (int2Real (numerator a)) 16 (int2Real (denominator a))) 17 makeReal (BasIntegerC a) = BasRealC (int2Real a) 18 ------------------------------------------------------------------------------- 19 20 makeRational (a@(BasRationalC _)) = a 21 makeRational (BasIntegerC a) = BasRationalC (a % 1) 22 ------------------------------------------------------------------------------- 23 24 instance Eq BasicNumber where 25 26 (BasRealC _) == _ = error "(==) : Real Numbers cannot\ 27 \ be compared" 28 _ == (BasRealC _) = error "(==) : Real Numbers cannot\ 29 \ be compared" 30 (BasRationalC a) == (BasRationalC b) = a == b 31 (BasRationalC a) == (BasIntegerC b) = a == (b % 1) 32 (BasIntegerC a) == (BasRationalC b) = (a % 1) == b 33 (BasIntegerC a) == (BasIntegerC b) = a == b 34 ------------------------------------------------------------------------------- 35 36 instance Ord BasicNumber where 37 38 (BasRealC _) < _ = error "(<) : Real Numbers cannot\ 39 \ be compared" 40 _ < (BasRealC _) = error "(==) : Real Numbers cannot\ 41 \ be compared" 42 (BasRationalC a) < (BasRationalC b) = a < b 43 (BasRationalC a) < (BasIntegerC b) = a < (b % 1) 44 (BasIntegerC a) < (BasRationalC b) = (a % 1) < b 45 (BasIntegerC a) < (BasIntegerC b) = a < b 46 --------------------------------------------------------------------------- 47 48 (BasRealC _) <= _ = error "(<=) : Real Numbers cannot\ 49 \ be compared" 50 _ <= (BasRealC _) = error "(<=) : Real Numbers cannot\ 51 \ be compared" 52 (BasRationalC a) <= (BasRationalC b) = a <= b 53 (BasRationalC a) <= (BasIntegerC b) = a <= (b % 1) 54 (BasIntegerC a) <= (BasRationalC b) = (a % 1) <= b 55 (BasIntegerC a) <= (BasIntegerC b) = a <= b 56 ------------------------------------------------------------------------------- 57 58 instance Num BasicNumber where 59 60 (BasRealC a) + b = BasRealC (addReal a c) 61 where 62 (BasRealC c) = makeReal b 63 a + (BasRealC b) = BasRealC (addReal c b) 64 where 65 (BasRealC c) = makeReal a 66 (BasRationalC a) + b = BasRationalC (a + c) 67 where 68 (BasRationalC c) = makeRational b 69 a + (BasRationalC b) = BasRationalC (c + b) 70 where 71 (BasRationalC c) = makeRational a 72 (BasIntegerC a) + (BasIntegerC b) = BasIntegerC (a + b) 73 --------------------------------------------------------------------------- 74 75 (BasRealC a) - b = BasRealC (subReal a c) 76 where 77 (BasRealC c) = makeReal b 78 a - (BasRealC b) = BasRealC (subReal c b) 79 where 80 (BasRealC c) = makeReal a 81 (BasRationalC a) - b = BasRationalC (a - c) 82 where 83 (BasRationalC c) = makeRational b 84 a - (BasRationalC b) = BasRationalC (c - b) 85 where 86 (BasRationalC c) = makeRational a 87 (BasIntegerC a) - (BasIntegerC b) = BasIntegerC (a - b) 88 --------------------------------------------------------------------------- 89 90 negate a = (BasIntegerC 0) - a 91 --------------------------------------------------------------------------- 92 93 (BasRealC a) * b = BasRealC (mulReal a c) 94 where 95 (BasRealC c) = makeReal b 96 a * (BasRealC b) = BasRealC (mulReal c b) 97 where 98 (BasRealC c) = makeReal a 99 (BasRationalC a) * b = BasRationalC (a * c) 100 where 101 (BasRationalC c) = makeRational b 102 a * (BasRationalC b) = BasRationalC (c * b) 103 where 104 (BasRationalC c) = makeRational a 105 (BasIntegerC a) * (BasIntegerC b) = BasIntegerC (a * b) 106 --------------------------------------------------------------------------- 107 108 abs (BasRealC _) = error "abs : Operation not defined on reals" 109 abs (BasRationalC a) = BasRationalC (abs a) 110 abs (BasIntegerC a) = BasIntegerC (abs a) 111 --------------------------------------------------------------------------- 112 113 signum (BasRealC _) = error "signum : Operation not defined on reals" 114 signum (BasRationalC a) = BasRationalC (signum a) 115 signum (BasIntegerC a) = BasIntegerC (signum a) 116 --------------------------------------------------------------------------- 117 118 fromInteger n = BasIntegerC n 119 ------------------------------------------------------------------------------- 120 121 instance Enum BasicNumber where 122 enumFrom n = iterate (+1) n 123 enumFromThen n m = iterate (+(m-n)) n 124 125 instance Real BasicNumber where 126 127 toRational (BasRealC _) = error "toRational : Real cannot be coerced\ 128 \ to rational" 129 toRational (BasRationalC a) = a 130 toRational (BasIntegerC a) = a % 1 131 ------------------------------------------------------------------------------- 132 133 instance Fractional BasicNumber where 134 135 (BasRealC a) / b = BasRealC (divReal a c) 136 where 137 (BasRealC c) = makeReal b 138 a / (BasRealC b) = BasRealC (divReal c b) 139 where 140 (BasRealC c) = makeReal a 141 (BasRationalC a) / b = BasRationalC (a / c) 142 where 143 (BasRationalC c) = makeRational b 144 a / (BasRationalC b) = BasRationalC (c / b) 145 where 146 (BasRationalC c) = makeRational a 147 (BasIntegerC a) / (BasIntegerC b) = BasRationalC (a % b) 148 --------------------------------------------------------------------------- 149 150 fromRational a = BasRationalC a 151 ------------------------------------------------------------------------------- 152 153 instance Floating BasicNumber where 154 155 sqrt a = BasRealC (sqrtReal b) 156 where 157 (BasRealC b) = makeReal a 158 --------------------------------------------------------------------------- 159 160 pi = error "pi : Not yet implemented" 161 exp = error "exp : Not yet implemented" 162 log = error "log : Not yet implemented" 163 sin = error "sin : Not yet implemented" 164 cos = error "cos : Not yet implemented" 165 asin = error "asin : Not yet implemented" 166 acos = error "acos : Not yet implemented" 167 atan = error "atan : Not yet implemented" 168 sinh = error "sinh : Not yet implemented" 169 cosh = error "cosh : Not yet implemented" 170 asinh = error "asinh : Not yet implemented" 171 acosh = error "acosh : Not yet implemented" 172 atanh = error "atanh : Not yet implemented" 173 ------------------------------------------------------------------------------- 174 175 instance Show BasicNumber where 176 177 showsPrec _ (BasRealC x) s = intPart ++ "." ++ fracPart ++ s 178 where 179 evalX = show (evalReal x (-10)) 180 lenBeforeDecimal = (length evalX) - 10 181 intPart = if lenBeforeDecimal <= 0 182 then "0" 183 else take lenBeforeDecimal 184 evalX 185 fracPart = if lenBeforeDecimal < 0 186 then (pad (- lenBeforeDecimal) 187 '0') ++ 188 evalX 189 else drop lenBeforeDecimal 190 evalX 191 192 pad 0 a = [] 193 --WAS:pad (n+1) a = a:(pad n a) 194 pad n a = a:(pad (n-1) a) 195 showsPrec _ (BasRationalC x) s = shows x s 196 showsPrec _ (BasIntegerC x) s = shows x s 197 --------------------------------------------------------------------------- 198 instance Read BasicNumber where 199 200 readsPrec p s = if allZeros frac 201 then map int2BasNum (readsPrec p int) 202 else map rat2BasNum (readsPrec p s) 203 where 204 (int, frac) = span (\c -> c /= '.') s 205 206 allZeros "" = True 207 allZeros (c:fs) | (c >= '1') && (c <= '9') = False 208 allZeros (c:fs) = allZeros fs 209 210 int2BasNum (num, s) = (BasIntegerC num, s) 211 rat2BasNum (num, s) = (BasRationalC 212 (approxRational num 0), s) 213 ------------------------------------------------------------------------------- 214