-- | 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 :: a
base = 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
(BigFloat e -> BigFloat e -> Bool)
-> (BigFloat e -> BigFloat e -> Bool) -> Eq (BigFloat e)
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 = (BigFloat e -> ShowS) -> Int -> BigFloat e -> ShowS
forall a. Real a => (a -> ShowS) -> Int -> a -> ShowS
showSigned BigFloat e -> ShowS
forall e. Epsilon e => BigFloat e -> ShowS
showBF
      -- Assumes base is 10
      where showBF :: BigFloat e -> ShowS
showBF (BF m :: Fixed e
m e :: Integer
e) = Int -> Fixed e -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 Fixed e
m ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "e" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 Integer
e

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

instance (Epsilon e) => Real (BigFloat e) where
    toRational :: BigFloat e -> Rational
toRational (BF e :: Fixed e
e m :: Integer
m) = Fixed e -> Rational
forall a. Real a => a -> Rational
toRational Fixed e
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
forall a. Num a => a
baseRational -> Integer -> Rational
forall 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 x :: BigFloat e
x y :: BigFloat e
y = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BigFloat e -> Rational
forall a. Real a => a -> Rational
toRational BigFloat e
x) (BigFloat e -> Rational
forall a. Real a => a -> Rational
toRational BigFloat e
y)

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


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

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

instance (Epsilon e) => Floating (BigFloat e) where
    pi :: BigFloat e
pi = Fixed e -> Integer -> BigFloat e
forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf Fixed e
forall a. Floating a => a
pi 0
    sqrt :: BigFloat e -> BigFloat e
sqrt = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.sqrt
    exp :: BigFloat e -> BigFloat e
exp = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.exp
    log :: BigFloat e -> BigFloat e
log = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.log
    sin :: BigFloat e -> BigFloat e
sin = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.sin
    cos :: BigFloat e -> BigFloat e
cos = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.cos
    tan :: BigFloat e -> BigFloat e
tan = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.tan
    asin :: BigFloat e -> BigFloat e
asin = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.asin
    acos :: BigFloat e -> BigFloat e
acos = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.acos
    atan :: BigFloat e -> BigFloat e
atan = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.atan
    sinh :: BigFloat e -> BigFloat e
sinh = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.sinh
    cosh :: BigFloat e -> BigFloat e
cosh = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.cosh
    tanh :: BigFloat e -> BigFloat e
tanh = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.tanh
    asinh :: BigFloat e -> BigFloat e
asinh = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.asinh
    acosh :: BigFloat e -> BigFloat e
acosh = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
toFloat1 Rational -> Rational -> Rational
F.acosh
    atanh :: BigFloat e -> BigFloat e
atanh = (Rational -> Rational -> Rational) -> BigFloat e -> BigFloat e
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 _ = Integer
forall a. Num a => a
base
    floatDigits :: BigFloat e -> Int
floatDigits (BF m :: Fixed e
m _) =
        Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
forall a. Num a => a
base (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Fractional a => a -> a
recip (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
precision Fixed e
m
    floatRange :: BigFloat e -> (Int, Int)
floatRange _ = (Int
forall a. Bounded a => a
minBound, Int
forall a. Bounded a => a
maxBound)
    decodeFloat :: BigFloat e -> (Integer, Int)
decodeFloat x :: BigFloat e
x@(BF m :: Fixed e
m e :: Integer
e) =
        let d :: Int
d = BigFloat e -> Int
forall a. RealFloat a => a -> Int
floatDigits BigFloat e
x
        in  (Fixed e -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Fixed e -> Integer) -> Fixed e -> Integer
forall a b. (a -> b) -> a -> b
$ Fixed e
m Fixed e -> Fixed e -> Fixed e
forall a. Num a => a -> a -> a
* Fixed e
forall a. Num a => a
baseFixed e -> Int -> Fixed e
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d, Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
d)
    encodeFloat :: Integer -> Int -> BigFloat e
encodeFloat m :: Integer
m e :: Int
e = Fixed e -> Integer -> BigFloat e
forall e. Epsilon e => Fixed e -> Integer -> BigFloat e
bf (Integer -> Fixed e
forall a. Num a => Integer -> a
fromInteger Integer
m) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
e)
    exponent :: BigFloat e -> Int
exponent (BF _ e :: Integer
e) = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e
    significand :: BigFloat e -> BigFloat e
significand (BF m :: Fixed e
m _) = Fixed e -> Integer -> BigFloat e
forall e. Fixed e -> Integer -> BigFloat e
BF Fixed e
m 0
    scaleFloat :: Int -> BigFloat e -> BigFloat e
scaleFloat n :: Int
n (BF m :: Fixed e
m e :: Integer
e) = Fixed e -> Integer -> BigFloat e
forall e. Fixed e -> Integer -> BigFloat e
BF Fixed e
m (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n)
    isNaN :: BigFloat e -> Bool
isNaN _ = Bool
False
    isInfinite :: BigFloat e -> Bool
isInfinite _ = Bool
False
    isDenormalized :: BigFloat e -> Bool
isDenormalized _ = Bool
False
    isNegativeZero :: BigFloat e -> Bool
isNegativeZero _ = Bool
False
    isIEEE :: BigFloat e -> Bool
isIEEE _ = Bool
False

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