-- | A simple implementation of floating point numbers with a selectable
-- precision.  The number of digits in the mantissa is selected by the
-- 'Epsilon' type class from the "Fixed" module.
--
-- The numbers are stored in base 10.
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 :: forall a. Num a => a
base = a
10

-- This representation is stupid, two Integers makes more sense,
-- but is more work.
-- | Floating point number where the precision is determined by the type /e/.
data BigFloat e = BF (Fixed e) Integer
    deriving (BigFloat e -> BigFloat e -> Bool
forall e. BigFloat e -> BigFloat e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigFloat e -> BigFloat e -> Bool
$c/= :: forall e. BigFloat e -> BigFloat e -> Bool
== :: BigFloat e -> BigFloat e -> Bool
$c== :: forall e. BigFloat e -> BigFloat e -> Bool
Eq)

instance (Epsilon e) => Show (BigFloat e) where
    showsPrec :: Int -> BigFloat e -> ShowS
showsPrec = forall a. Real a => (a -> ShowS) -> Int -> a -> ShowS
showSigned forall {e}. Epsilon e => BigFloat e -> ShowS
showBF
      -- Assumes base is 10
      where showBF :: BigFloat e -> ShowS
showBF (BF Fixed e
m Integer
e) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Fixed e
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"e" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Integer
e

instance (Epsilon e) => Num (BigFloat e) where
    BF Fixed e
m1 Integer
e1 + :: BigFloat e -> BigFloat e -> BigFloat e
+ BF Fixed e
m2 Integer
e2  =  forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (Fixed e
m1' forall a. Num a => a -> a -> a
+ Fixed e
m2') Integer
e
      where (Fixed e
m1', Fixed e
m2') = if Integer
e forall a. Eq a => a -> a -> Bool
== Integer
e1 then (Fixed e
m1, Fixed e
m2 forall a. Fractional a => a -> a -> a
/ forall a. Num a => a
baseforall a b. (Num a, Integral b) => a -> b -> a
^(Integer
eforall a. Num a => a -> a -> a
-Integer
e2))
                                           else (Fixed e
m1 forall a. Fractional a => a -> a -> a
/ forall a. Num a => a
baseforall a b. (Num a, Integral b) => a -> b -> a
^(Integer
eforall a. Num a => a -> a -> a
-Integer
e1), Fixed e
m2)
            e :: Integer
e = Integer
e1 forall a. Ord a => a -> a -> a
`max` Integer
e2
    -- Do - via negate
    BF Fixed e
m1 Integer
e1 * :: BigFloat e -> BigFloat e -> BigFloat e
* BF Fixed e
m2 Integer
e2  =  forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (Fixed e
m1 forall a. Num a => a -> a -> a
* Fixed e
m2) (Integer
e1 forall a. Num a => a -> a -> a
+ Integer
e2)
    negate :: BigFloat e -> BigFloat e
negate (BF Fixed e
m Integer
e) = forall e. Fixed e -> Integer -> BigFloat e
BF (-Fixed e
m) Integer
e
    abs :: BigFloat e -> BigFloat e
abs (BF Fixed e
m Integer
e) = forall e. Fixed e -> Integer -> BigFloat e
BF (forall a. Num a => a -> a
abs Fixed e
m) Integer
e
    signum :: BigFloat e -> BigFloat e
signum (BF Fixed e
m Integer
_) = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (forall a. Num a => a -> a
signum Fixed e
m) Integer
0
    fromInteger :: Integer -> BigFloat e
fromInteger Integer
i = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (forall a. Num a => Integer -> a
fromInteger Integer
i) Integer
0

instance (Epsilon e) => Real (BigFloat e) where
    toRational :: BigFloat e -> Rational
toRational (BF Fixed e
e Integer
m) = forall a. Real a => a -> Rational
toRational Fixed e
e forall a. Num a => a -> a -> a
* forall a. Num a => a
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
m

instance (Epsilon e) => Ord (BigFloat e) where
    compare :: BigFloat e -> BigFloat e -> Ordering
compare BigFloat e
x BigFloat e
y = forall a. Ord a => a -> a -> Ordering
compare (forall a. Real a => a -> Rational
toRational BigFloat e
x) (forall a. Real a => a -> Rational
toRational BigFloat e
y)

instance (Epsilon e) => Fractional (BigFloat e) where
    recip :: BigFloat e -> BigFloat e
recip (BF Fixed e
m Integer
e) = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (forall a. Num a => a
base forall a. Fractional a => a -> a -> a
/ Fixed e
m) (-(Integer
e forall a. Num a => a -> a -> a
+ Integer
1))
    -- Take care not to lose precision for small numbers
    fromRational :: Rational -> BigFloat e
fromRational Rational
x
      | Rational
x forall a. Eq a => a -> a -> Bool
== Rational
0 Bool -> Bool -> Bool
|| forall a. Num a => a -> a
abs Rational
x forall a. Ord a => a -> a -> Bool
>= Rational
1 = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (forall a. Fractional a => Rational -> a
fromRational Rational
x) Integer
0
      | Bool
otherwise = forall a. Fractional a => a -> a
recip forall a b. (a -> b) -> a -> b
$ forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (forall a. Fractional a => Rational -> a
fromRational (forall a. Fractional a => a -> a
recip Rational
x)) Integer
0


-- normalizing constructor
-- XXX The scaling is very inefficient
bf :: (Epsilon e) => Fixed e -> Integer -> BigFloat e
bf :: forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf Fixed e
m Integer
e | Fixed e
m forall a. Eq a => a -> a -> Bool
== Fixed e
0     = forall e. Fixed e -> Integer -> BigFloat e
BF Fixed e
0 Integer
0
       | Fixed e
m forall a. Ord a => a -> a -> Bool
< Fixed e
0      = - forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (-Fixed e
m) Integer
e
       | Fixed e
m forall a. Ord a => a -> a -> Bool
>= forall a. Num a => a
base  = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (Fixed e
m forall a. Fractional a => a -> a -> a
/ forall a. Num a => a
base) (Integer
e forall a. Num a => a -> a -> a
+ Integer
1)
       | Fixed e
m forall a. Ord a => a -> a -> Bool
< Fixed e
1      = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (Fixed e
m forall a. Num a => a -> a -> a
* forall a. Num a => a
base) (Integer
e forall a. Num a => a -> a -> a
- Integer
1)
       | Bool
otherwise  = forall e. Fixed e -> Integer -> BigFloat e
BF Fixed e
m Integer
e

instance (Epsilon e) => RealFrac (BigFloat e) where
    properFraction :: forall b. Integral b => BigFloat e -> (b, BigFloat e)
properFraction x :: BigFloat e
x@(BF Fixed e
m Integer
e) =
        if Integer
e forall a. Ord a => a -> a -> Bool
< Integer
0 then (b
0, BigFloat e
x)
                 else let (b
i, Fixed e
f) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Fixed e
m forall a. Num a => a -> a -> a
* forall a. Num a => a
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
e)
                      in  (b
i, forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf Fixed e
f Integer
0)

instance (Epsilon e) => Floating (BigFloat e) where
    pi :: BigFloat e
pi = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf forall a. Floating a => a
pi Integer
0
    sqrt :: BigFloat e -> BigFloat e
sqrt = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.sqrt
    exp :: BigFloat e -> BigFloat e
exp = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.exp
    log :: BigFloat e -> BigFloat e
log = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.log
    sin :: BigFloat e -> BigFloat e
sin = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.sin
    cos :: BigFloat e -> BigFloat e
cos = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.cos
    tan :: BigFloat e -> BigFloat e
tan = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.tan
    asin :: BigFloat e -> BigFloat e
asin = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.asin
    acos :: BigFloat e -> BigFloat e
acos = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.acos
    atan :: BigFloat e -> BigFloat e
atan = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.atan
    sinh :: BigFloat e -> BigFloat e
sinh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.sinh
    cosh :: BigFloat e -> BigFloat e
cosh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.cosh
    tanh :: BigFloat e -> BigFloat e
tanh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.tanh
    asinh :: BigFloat e -> BigFloat e
asinh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.asinh
    acosh :: BigFloat e -> BigFloat e
acosh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.acosh
    atanh :: BigFloat e -> BigFloat e
atanh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.atanh

instance (Epsilon e) => RealFloat (BigFloat e) where
    floatRadix :: BigFloat e -> Integer
floatRadix BigFloat e
_ = forall a. Num a => a
base
    floatDigits :: BigFloat e -> Int
floatDigits (BF Fixed e
m Integer
_) =
        forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a -> a
logBase forall a. Num a => a
base forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => a -> a
recip forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall e. Epsilon e => Fixed e -> Rational
precision Fixed e
m
    floatRange :: BigFloat e -> (Int, Int)
floatRange BigFloat e
_ = (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
    decodeFloat :: BigFloat e -> (Integer, Int)
decodeFloat x :: BigFloat e
x@(BF Fixed e
m Integer
e) =
        let d :: Int
d = forall a. RealFloat a => a -> Int
floatDigits BigFloat e
x
        in  (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Fixed e
m forall a. Num a => a -> a -> a
* forall a. Num a => a
baseforall a b. (Num a, Integral b) => a -> b -> a
^Int
d, forall a. Num a => Integer -> a
fromInteger Integer
e forall a. Num a => a -> a -> a
- Int
d)
    encodeFloat :: Integer -> Int -> BigFloat e
encodeFloat Integer
m Int
e = forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (forall a. Num a => Integer -> a
fromInteger Integer
m) (forall a. Integral a => a -> Integer
toInteger Int
e)
    exponent :: BigFloat e -> Int
exponent (BF Fixed e
_ Integer
e) = forall a. Num a => Integer -> a
fromInteger Integer
e
    significand :: BigFloat e -> BigFloat e
significand (BF Fixed e
m Integer
_) = forall e. Fixed e -> Integer -> BigFloat e
BF Fixed e
m Integer
0
    scaleFloat :: Int -> BigFloat e -> BigFloat e
scaleFloat Int
n (BF Fixed e
m Integer
e) = forall e. Fixed e -> Integer -> BigFloat e
BF Fixed e
m (Integer
e forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Integer
toInteger Int
n)
    isNaN :: BigFloat e -> Bool
isNaN BigFloat e
_ = Bool
False
    isInfinite :: BigFloat e -> Bool
isInfinite BigFloat e
_ = Bool
False
    isDenormalized :: BigFloat e -> Bool
isDenormalized BigFloat e
_ = Bool
False
    isNegativeZero :: BigFloat e -> Bool
isNegativeZero BigFloat e
_ = Bool
False
    isIEEE :: BigFloat e -> Bool
isIEEE BigFloat e
_ = Bool
False

toFloat1 :: (Epsilon e) => (Rational -> Rational -> Rational) ->
             BigFloat e -> BigFloat e
toFloat1 :: forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
f x :: BigFloat e
x@(BF Fixed e
m Integer
e) =
    forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
f (forall e. Epsilon e => Fixed e -> Rational
precision Fixed e
m forall a. Num a => a -> a -> a
* Rational
scl) (forall a. Real a => a -> Rational
toRational Fixed e
m forall a. Num a => a -> a -> a
* Rational
scl)
      where scl :: Rational
scl = forall a. Num a => a
baseforall a b. (Fractional a, Integral b) => a -> b -> a
^^Integer
e