module BasicNumber (BasicNumber (..), makeReal, makeRational, RealT{-partain-}) where
import RealM
import Ratio--1.3
data BasicNumber = BasIntegerC Integer
| BasRationalC Rational
| BasRealC RealT
-- deriving ()
makeReal (a@(BasRealC _)) = a
makeReal (BasRationalC a) = if (numerator a) == 0
then BasRealC (int2Real 0)
else BasRealC (divReal (int2Real (numerator a))
(int2Real (denominator a)))
makeReal (BasIntegerC a) = BasRealC (int2Real a)
-------------------------------------------------------------------------------
makeRational (a@(BasRationalC _)) = a
makeRational (BasIntegerC a) = BasRationalC (a % 1)
-------------------------------------------------------------------------------
instance Eq BasicNumber where
(BasRealC _) == _ = error "(==) : Real Numbers cannot\
\ be compared"
_ == (BasRealC _) = error "(==) : Real Numbers cannot\
\ be compared"
(BasRationalC a) == (BasRationalC b) = a == b
(BasRationalC a) == (BasIntegerC b) = a == (b % 1)
(BasIntegerC a) == (BasRationalC b) = (a % 1) == b
(BasIntegerC a) == (BasIntegerC b) = a == b
-------------------------------------------------------------------------------
instance Ord BasicNumber where
(BasRealC _) < _ = error "(<) : Real Numbers cannot\
\ be compared"
_ < (BasRealC _) = error "(==) : Real Numbers cannot\
\ be compared"
(BasRationalC a) < (BasRationalC b) = a < b
(BasRationalC a) < (BasIntegerC b) = a < (b % 1)
(BasIntegerC a) < (BasRationalC b) = (a % 1) < b
(BasIntegerC a) < (BasIntegerC b) = a < b
---------------------------------------------------------------------------
(BasRealC _) <= _ = error "(<=) : Real Numbers cannot\
\ be compared"
_ <= (BasRealC _) = error "(<=) : Real Numbers cannot\
\ be compared"
(BasRationalC a) <= (BasRationalC b) = a <= b
(BasRationalC a) <= (BasIntegerC b) = a <= (b % 1)
(BasIntegerC a) <= (BasRationalC b) = (a % 1) <= b
(BasIntegerC a) <= (BasIntegerC b) = a <= b
-------------------------------------------------------------------------------
instance Num BasicNumber where
(BasRealC a) + b = BasRealC (addReal a c)
where
(BasRealC c) = makeReal b
a + (BasRealC b) = BasRealC (addReal c b)
where
(BasRealC c) = makeReal a
(BasRationalC a) + b = BasRationalC (a + c)
where
(BasRationalC c) = makeRational b
a + (BasRationalC b) = BasRationalC (c + b)
where
(BasRationalC c) = makeRational a
(BasIntegerC a) + (BasIntegerC b) = BasIntegerC (a + b)
---------------------------------------------------------------------------
(BasRealC a) - b = BasRealC (subReal a c)
where
(BasRealC c) = makeReal b
a - (BasRealC b) = BasRealC (subReal c b)
where
(BasRealC c) = makeReal a
(BasRationalC a) - b = BasRationalC (a - c)
where
(BasRationalC c) = makeRational b
a - (BasRationalC b) = BasRationalC (c - b)
where
(BasRationalC c) = makeRational a
(BasIntegerC a) - (BasIntegerC b) = BasIntegerC (a - b)
---------------------------------------------------------------------------
negate a = (BasIntegerC 0) - a
---------------------------------------------------------------------------
(BasRealC a) * b = BasRealC (mulReal a c)
where
(BasRealC c) = makeReal b
a * (BasRealC b) = BasRealC (mulReal c b)
where
(BasRealC c) = makeReal a
(BasRationalC a) * b = BasRationalC (a * c)
where
(BasRationalC c) = makeRational b
a * (BasRationalC b) = BasRationalC (c * b)
where
(BasRationalC c) = makeRational a
(BasIntegerC a) * (BasIntegerC b) = BasIntegerC (a * b)
---------------------------------------------------------------------------
abs (BasRealC _) = error "abs : Operation not defined on reals"
abs (BasRationalC a) = BasRationalC (abs a)
abs (BasIntegerC a) = BasIntegerC (abs a)
---------------------------------------------------------------------------
signum (BasRealC _) = error "signum : Operation not defined on reals"
signum (BasRationalC a) = BasRationalC (signum a)
signum (BasIntegerC a) = BasIntegerC (signum a)
---------------------------------------------------------------------------
fromInteger n = BasIntegerC n
-------------------------------------------------------------------------------
instance Enum BasicNumber where
enumFrom n = iterate (+1) n
enumFromThen n m = iterate (+(m-n)) n
instance Real BasicNumber where
toRational (BasRealC _) = error "toRational : Real cannot be coerced\
\ to rational"
toRational (BasRationalC a) = a
toRational (BasIntegerC a) = a % 1
-------------------------------------------------------------------------------
instance Fractional BasicNumber where
(BasRealC a) / b = BasRealC (divReal a c)
where
(BasRealC c) = makeReal b
a / (BasRealC b) = BasRealC (divReal c b)
where
(BasRealC c) = makeReal a
(BasRationalC a) / b = BasRationalC (a / c)
where
(BasRationalC c) = makeRational b
a / (BasRationalC b) = BasRationalC (c / b)
where
(BasRationalC c) = makeRational a
(BasIntegerC a) / (BasIntegerC b) = BasRationalC (a % b)
---------------------------------------------------------------------------
fromRational a = BasRationalC a
-------------------------------------------------------------------------------
instance Floating BasicNumber where
sqrt a = BasRealC (sqrtReal b)
where
(BasRealC b) = makeReal a
---------------------------------------------------------------------------
pi = error "pi : Not yet implemented"
exp = error "exp : Not yet implemented"
log = error "log : Not yet implemented"
sin = error "sin : Not yet implemented"
cos = error "cos : Not yet implemented"
asin = error "asin : Not yet implemented"
acos = error "acos : Not yet implemented"
atan = error "atan : Not yet implemented"
sinh = error "sinh : Not yet implemented"
cosh = error "cosh : Not yet implemented"
asinh = error "asinh : Not yet implemented"
acosh = error "acosh : Not yet implemented"
atanh = error "atanh : Not yet implemented"
-------------------------------------------------------------------------------
instance Show BasicNumber where
showsPrec _ (BasRealC x) s = intPart ++ "." ++ fracPart ++ s
where
evalX = show (evalReal x (-10))
lenBeforeDecimal = (length evalX) - 10
intPart = if lenBeforeDecimal <= 0
then "0"
else take lenBeforeDecimal
evalX
fracPart = if lenBeforeDecimal < 0
then (pad (- lenBeforeDecimal)
'0') ++
evalX
else drop lenBeforeDecimal
evalX
pad 0 a = []
--WAS:pad (n+1) a = a:(pad n a)
pad n a = a:(pad (n-1) a)
showsPrec _ (BasRationalC x) s = shows x s
showsPrec _ (BasIntegerC x) s = shows x s
---------------------------------------------------------------------------
instance Read BasicNumber where
readsPrec p s = if allZeros frac
then map int2BasNum (readsPrec p int)
else map rat2BasNum (readsPrec p s)
where
(int, frac) = span (\c -> c /= '.') s
allZeros "" = True
allZeros (c:fs) | (c >= '1') && (c <= '9') = False
allZeros (c:fs) = allZeros fs
int2BasNum (num, s) = (BasIntegerC num, s)
rat2BasNum (num, s) = (BasRationalC
(approxRational num 0), s)
-------------------------------------------------------------------------------
|
