module Data.Number.BigFloat(
BigFloat,
Epsilon, Eps1, EpsDiv10, Prec10, Prec50, PrecPlus20
) where
import Numeric(showSigned)
import Data.Number.Fixed
import qualified Data.Number.FixedFunctions as F
base :: (Num a) => a
base = 10
data BigFloat e = BF (Fixed e) Integer
deriving (Eq)
instance (Epsilon e) => Show (BigFloat e) where
showsPrec = showSigned showBF
where showBF (BF m e) = showsPrec 0 m . showString "e" . showsPrec 0 e
instance (Epsilon e) => Num (BigFloat e) where
BF m1 e1 + BF m2 e2 = bf (m1' + m2') e
where (m1', m2') = if e == e1 then (m1, m2 / base^(ee2))
else (m1 / base^(ee1), m2)
e = e1 `max` e2
BF m1 e1 * BF m2 e2 = bf (m1 * m2) (e1 + e2)
negate (BF m e) = BF (m) e
abs (BF m e) = BF (abs m) e
signum (BF m _) = bf (signum m) 0
fromInteger i = bf (fromInteger i) 0
instance (Epsilon e) => Real (BigFloat e) where
toRational (BF e m) = toRational e * base^^m
instance (Epsilon e) => Ord (BigFloat e) where
compare x y = compare (toRational x) (toRational y)
instance (Epsilon e) => Fractional (BigFloat e) where
recip (BF m e) = bf (base / m) ((e + 1))
fromRational x
| x == 0 || abs x >= 1 = bf (fromRational x) 0
| otherwise = recip $ bf (fromRational (recip x)) 0
bf :: (Epsilon e) => Fixed e -> Integer -> BigFloat e
bf m e | m == 0 = BF 0 0
| m < 0 = bf (m) e
| m >= base = bf (m / base) (e + 1)
| m < 1 = bf (m * base) (e 1)
| otherwise = BF m e
instance (Epsilon e) => RealFrac (BigFloat e) where
properFraction x@(BF m e) =
if e < 0 then (0, x)
else let (i, f) = properFraction (m * base^^e)
in (i, bf f 0)
instance (Epsilon e) => Floating (BigFloat e) where
pi = bf pi 0
sqrt = toFloat1 F.sqrt
exp = toFloat1 F.exp
log = toFloat1 F.log
sin = toFloat1 F.sin
cos = toFloat1 F.cos
tan = toFloat1 F.tan
asin = toFloat1 F.asin
acos = toFloat1 F.acos
atan = toFloat1 F.atan
sinh = toFloat1 F.sinh
cosh = toFloat1 F.cosh
tanh = toFloat1 F.tanh
asinh = toFloat1 F.asinh
acosh = toFloat1 F.acosh
atanh = toFloat1 F.atanh
instance (Epsilon e) => RealFloat (BigFloat e) where
floatRadix _ = base
floatDigits (BF m _) =
floor $ logBase base $ recip $ fromRational $ precision m
floatRange _ = (minBound, maxBound)
decodeFloat x@(BF m e) =
let d = floatDigits x
in (round $ m * base^d, fromInteger e d)
encodeFloat m e = bf (fromInteger m) (toInteger e)
exponent (BF _ e) = fromInteger e
significand (BF m _) = BF m 0
scaleFloat n (BF m e) = BF m (e + toInteger n)
isNaN _ = False
isInfinite _ = False
isDenormalized _ = False
isNegativeZero _ = False
isIEEE _ = False
toFloat1 :: (Epsilon e) => (Rational -> Rational -> Rational) ->
BigFloat e -> BigFloat e
toFloat1 f x@(BF m e) =
fromRational $ f (precision m * scl) (toRational m * scl)
where scl = base^^e