{-# LANGUAGE
    EmptyDataDecls,
    GeneralizedNewtypeDeriving,
    ScopedTypeVariables,
    Rank2Types #-}

-- | Numbers with a fixed number of decimals.
module Data.Number.Fixed(
    Fixed,
    Epsilon, Eps1, EpsDiv10, Prec10, Prec50, PrecPlus20,
    Prec500, convertFixed, dynamicEps, precision, with_added_precision) where
import Numeric
import Data.Char
import Data.Ratio
import qualified Data.Number.FixedFunctions as F

-- | The 'Epsilon' class contains the types that can be used to determine the
-- precision of a 'Fixed' number.
class Epsilon e where
    eps :: e -> Rational

-- | An epsilon of 1, i.e., no decimals.
data Eps1
instance Epsilon Eps1 where
    eps :: Eps1 -> Rational
eps _ = 1

-- | A type construct that gives one more decimals than the argument.
data EpsDiv10 p
instance (Epsilon e) => Epsilon (EpsDiv10 e) where
    eps :: EpsDiv10 e -> Rational
eps e :: EpsDiv10 e
e = e -> Rational
forall e. Epsilon e => e -> Rational
eps (EpsDiv10 e -> e
un EpsDiv10 e
e) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ 10
       where un :: EpsDiv10 e -> e
             un :: EpsDiv10 e -> e
un = EpsDiv10 e -> e
forall a. HasCallStack => a
undefined

-- | Ten decimals.
data Prec10
instance Epsilon Prec10 where
    eps :: Prec10 -> Rational
eps _ = 1e-10

-- | 50 decimals.
data Prec50
instance Epsilon Prec50 where
    eps :: Prec50 -> Rational
eps _ = 1e-50

-- | 500 decimals.
data Prec500
instance Epsilon Prec500 where
    eps :: Prec500 -> Rational
eps _ = 1e-500

-- A type that gives 20 more decimals than the argument.
data PrecPlus20 e
instance (Epsilon e) => Epsilon (PrecPlus20 e) where
    eps :: PrecPlus20 e -> Rational
eps e :: PrecPlus20 e
e = 1e-20 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* e -> Rational
forall e. Epsilon e => e -> Rational
eps (PrecPlus20 e -> e
un PrecPlus20 e
e)
       where un :: PrecPlus20 e -> e
             un :: PrecPlus20 e -> e
un = PrecPlus20 e -> e
forall a. HasCallStack => a
undefined

-----------

-- The type of fixed precision numbers.  The type /e/ determines the precision.
newtype Fixed e = F Rational deriving (Fixed e -> Fixed e -> Bool
(Fixed e -> Fixed e -> Bool)
-> (Fixed e -> Fixed e -> Bool) -> Eq (Fixed e)
forall e. Fixed e -> Fixed e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixed e -> Fixed e -> Bool
$c/= :: forall e. Fixed e -> Fixed e -> Bool
== :: Fixed e -> Fixed e -> Bool
$c== :: forall e. Fixed e -> Fixed e -> Bool
Eq, Eq (Fixed e)
Eq (Fixed e) =>
(Fixed e -> Fixed e -> Ordering)
-> (Fixed e -> Fixed e -> Bool)
-> (Fixed e -> Fixed e -> Bool)
-> (Fixed e -> Fixed e -> Bool)
-> (Fixed e -> Fixed e -> Bool)
-> (Fixed e -> Fixed e -> Fixed e)
-> (Fixed e -> Fixed e -> Fixed e)
-> Ord (Fixed e)
Fixed e -> Fixed e -> Bool
Fixed e -> Fixed e -> Ordering
Fixed e -> Fixed e -> Fixed e
forall e. Eq (Fixed e)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e. Fixed e -> Fixed e -> Bool
forall e. Fixed e -> Fixed e -> Ordering
forall e. Fixed e -> Fixed e -> Fixed e
min :: Fixed e -> Fixed e -> Fixed e
$cmin :: forall e. Fixed e -> Fixed e -> Fixed e
max :: Fixed e -> Fixed e -> Fixed e
$cmax :: forall e. Fixed e -> Fixed e -> Fixed e
>= :: Fixed e -> Fixed e -> Bool
$c>= :: forall e. Fixed e -> Fixed e -> Bool
> :: Fixed e -> Fixed e -> Bool
$c> :: forall e. Fixed e -> Fixed e -> Bool
<= :: Fixed e -> Fixed e -> Bool
$c<= :: forall e. Fixed e -> Fixed e -> Bool
< :: Fixed e -> Fixed e -> Bool
$c< :: forall e. Fixed e -> Fixed e -> Bool
compare :: Fixed e -> Fixed e -> Ordering
$ccompare :: forall e. Fixed e -> Fixed e -> Ordering
$cp1Ord :: forall e. Eq (Fixed e)
Ord, Int -> Fixed e
Fixed e -> Int
Fixed e -> [Fixed e]
Fixed e -> Fixed e
Fixed e -> Fixed e -> [Fixed e]
Fixed e -> Fixed e -> Fixed e -> [Fixed e]
(Fixed e -> Fixed e)
-> (Fixed e -> Fixed e)
-> (Int -> Fixed e)
-> (Fixed e -> Int)
-> (Fixed e -> [Fixed e])
-> (Fixed e -> Fixed e -> [Fixed e])
-> (Fixed e -> Fixed e -> [Fixed e])
-> (Fixed e -> Fixed e -> Fixed e -> [Fixed e])
-> Enum (Fixed e)
forall e. Int -> Fixed e
forall e. Fixed e -> Int
forall e. Fixed e -> [Fixed e]
forall e. Fixed e -> Fixed e
forall e. Fixed e -> Fixed e -> [Fixed e]
forall e. Fixed e -> Fixed e -> Fixed e -> [Fixed e]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Fixed e -> Fixed e -> Fixed e -> [Fixed e]
$cenumFromThenTo :: forall e. Fixed e -> Fixed e -> Fixed e -> [Fixed e]
enumFromTo :: Fixed e -> Fixed e -> [Fixed e]
$cenumFromTo :: forall e. Fixed e -> Fixed e -> [Fixed e]
enumFromThen :: Fixed e -> Fixed e -> [Fixed e]
$cenumFromThen :: forall e. Fixed e -> Fixed e -> [Fixed e]
enumFrom :: Fixed e -> [Fixed e]
$cenumFrom :: forall e. Fixed e -> [Fixed e]
fromEnum :: Fixed e -> Int
$cfromEnum :: forall e. Fixed e -> Int
toEnum :: Int -> Fixed e
$ctoEnum :: forall e. Int -> Fixed e
pred :: Fixed e -> Fixed e
$cpred :: forall e. Fixed e -> Fixed e
succ :: Fixed e -> Fixed e
$csucc :: forall e. Fixed e -> Fixed e
Enum, Num (Fixed e)
Ord (Fixed e)
(Num (Fixed e), Ord (Fixed e)) =>
(Fixed e -> Rational) -> Real (Fixed e)
Fixed e -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
forall e. Epsilon e => Num (Fixed e)
forall e. Epsilon e => Ord (Fixed e)
forall e. Epsilon e => Fixed e -> Rational
toRational :: Fixed e -> Rational
$ctoRational :: forall e. Epsilon e => Fixed e -> Rational
$cp2Real :: forall e. Epsilon e => Ord (Fixed e)
$cp1Real :: forall e. Epsilon e => Num (Fixed e)
Real, Fractional (Fixed e)
Real (Fixed e)
(Real (Fixed e), Fractional (Fixed e)) =>
(forall b. Integral b => Fixed e -> (b, Fixed e))
-> (forall b. Integral b => Fixed e -> b)
-> (forall b. Integral b => Fixed e -> b)
-> (forall b. Integral b => Fixed e -> b)
-> (forall b. Integral b => Fixed e -> b)
-> RealFrac (Fixed e)
Fixed e -> b
Fixed e -> b
Fixed e -> b
Fixed e -> b
Fixed e -> (b, Fixed e)
forall b. Integral b => Fixed e -> b
forall b. Integral b => Fixed e -> (b, Fixed e)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
forall e. Epsilon e => Fractional (Fixed e)
forall e. Epsilon e => Real (Fixed e)
forall e b. (Epsilon e, Integral b) => Fixed e -> b
forall e b. (Epsilon e, Integral b) => Fixed e -> (b, Fixed e)
floor :: Fixed e -> b
$cfloor :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
ceiling :: Fixed e -> b
$cceiling :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
round :: Fixed e -> b
$cround :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
truncate :: Fixed e -> b
$ctruncate :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
properFraction :: Fixed e -> (b, Fixed e)
$cproperFraction :: forall e b. (Epsilon e, Integral b) => Fixed e -> (b, Fixed e)
$cp2RealFrac :: forall e. Epsilon e => Fractional (Fixed e)
$cp1RealFrac :: forall e. Epsilon e => Real (Fixed e)
RealFrac)

-- Get the accuracy (the epsilon) of the type.
precision :: (Epsilon e) => Fixed e -> Rational
precision :: Fixed e -> Rational
precision = Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps

instance (Epsilon e) => Num (Fixed e) where
    + :: Fixed e -> Fixed e -> Fixed e
(+) = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+)
    (-) = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 (-)
    * :: Fixed e -> Fixed e -> Fixed e
(*) = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*)
    negate :: Fixed e -> Fixed e
negate (F x :: Rational
x) = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Rational
forall a. Num a => a -> a
negate Rational
x)
    abs :: Fixed e -> Fixed e
abs (F x :: Rational
x) = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Rational
forall a. Num a => a -> a
abs Rational
x)
    signum :: Fixed e -> Fixed e
signum (F x :: Rational
x) = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Rational
forall a. Num a => a -> a
signum Rational
x)
    fromInteger :: Integer -> Fixed e
fromInteger = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Fixed e)
-> (Integer -> Rational) -> Integer -> Fixed e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Rational
forall a. Num a => Integer -> a
fromInteger

instance (Epsilon e) => Fractional (Fixed e) where
    / :: Fixed e -> Fixed e -> Fixed e
(/) = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/)
    fromRational :: Rational -> Fixed e
fromRational x :: Rational
x = Fixed e
r
        where r :: Fixed e
r = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Fixed e) -> Rational -> Fixed e
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
approx Rational
x (Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
r)

lift2 :: (Epsilon e) => (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 :: (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 op :: Rational -> Rational -> Rational
op fx :: Fixed e
fx@(F x :: Rational
x) (F y :: Rational
y) = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Fixed e) -> Rational -> Fixed e
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
approx (Rational
x Rational -> Rational -> Rational
`op` Rational
y) (Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
fx)

approx :: Rational -> Rational -> Rational
approx :: Rational -> Rational -> Rational
approx x :: Rational
x eps :: Rational
eps = Rational -> Rational -> Rational
forall a. RealFrac a => a -> a -> Rational
approxRational Rational
x (Rational
epsRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/2)

-- | Convert between two arbitrary fixed precision types.
convertFixed :: (Epsilon e, Epsilon f) => Fixed e -> Fixed f
convertFixed :: Fixed e -> Fixed f
convertFixed e :: Fixed e
e@(F x :: Rational
x) = Fixed f
f
  where f :: Fixed f
f = Rational -> Fixed f
forall e. Rational -> Fixed e
F (Rational -> Fixed f) -> Rational -> Fixed f
forall a b. (a -> b) -> a -> b
$ if Rational
feps Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
eeps then Rational -> Rational -> Rational
approx Rational
x Rational
feps else Rational
x
        feps :: Rational
feps = Fixed f -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed f
f
        eeps :: Rational
eeps = Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
e

getEps :: (Epsilon e) => Fixed e -> Rational
getEps :: Fixed e -> Rational
getEps = e -> Rational
forall e. Epsilon e => e -> Rational
eps (e -> Rational) -> (Fixed e -> e) -> Fixed e -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed e -> e
forall e. Fixed e -> e
un
  where un :: Fixed e -> e
        un :: Fixed e -> e
un = Fixed e -> e
forall a. HasCallStack => a
undefined

instance (Epsilon e) => Show (Fixed e) where
    showsPrec :: Int -> Fixed e -> ShowS
showsPrec = (Fixed e -> ShowS) -> Int -> Fixed e -> ShowS
forall a. Real a => (a -> ShowS) -> Int -> a -> ShowS
showSigned Fixed e -> ShowS
forall e. Epsilon e => Fixed e -> ShowS
showFixed
      where showFixed :: Fixed e -> ShowS
showFixed f :: Fixed e
f@(F x :: Rational
x) = String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ "." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rational -> Rational -> String
forall t t. (Ord t, Num t, RealFrac t) => t -> t -> String
decimals Rational
r Rational
e
              where q :: Integer
                    (q :: Integer
q, r :: Rational
r) = Rational -> (Integer, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
eRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/2)
                    e :: Rational
e = Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
f
            decimals :: t -> t -> String
decimals a :: t
a e :: t
e | t
e t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = ""
                         | Bool
otherwise = Int -> Char
intToDigit Int
b Char -> ShowS
forall a. a -> [a] -> [a]
: t -> t -> String
decimals t
c (10 t -> t -> t
forall a. Num a => a -> a -> a
* t
e)
                              where (b :: Int
b, c :: t
c) = t -> (Int, t)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (10 t -> t -> t
forall a. Num a => a -> a -> a
* t
a)

instance (Epsilon e) => Read (Fixed e) where
    readsPrec :: Int -> ReadS (Fixed e)
readsPrec _ = ReadS (Fixed e) -> ReadS (Fixed e)
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS (Fixed e)
forall e. Epsilon e => String -> [(Fixed e, String)]
readFixed
      where readFixed :: String -> [(Fixed e, String)]
readFixed s :: String
s = [ ((Rational -> Rational) -> Fixed e
forall e. Epsilon e => (Rational -> Rational) -> Fixed e
toFixed0 (Rational -> Rational -> Rational
forall a. RealFrac a => a -> a -> Rational
approxRational Rational
x), String
s') | (x :: Rational
x, s' :: String
s') <- ReadS Rational
forall a. RealFrac a => ReadS a
readFloat String
s ]

instance (Epsilon e) => Floating (Fixed e) where
    pi :: Fixed e
pi = (Rational -> Rational) -> Fixed e
forall e. Epsilon e => (Rational -> Rational) -> Fixed e
toFixed0 Rational -> Rational
F.pi
    sqrt :: Fixed e -> Fixed e
sqrt = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.sqrt
    exp :: Fixed e -> Fixed e
exp x :: Fixed e
x = Rational
-> (forall e. Epsilon e => Fixed e -> Fixed e)
-> Fixed e
-> Fixed e
forall a f.
Epsilon f =>
Rational -> (forall e. Epsilon e => Fixed e -> a) -> Fixed f -> a
with_added_precision Rational
r (Fixed e -> Fixed e
forall e f. (Epsilon e, Epsilon f) => Fixed e -> Fixed f
convertFixed (Fixed e -> Fixed e) -> (Fixed e -> Fixed e) -> Fixed e -> Fixed e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.exp)) Fixed e
x where
      r :: Rational
r = if Fixed e
x Fixed e -> Fixed e -> Bool
forall a. Ord a => a -> a -> Bool
< 0 then 1 else 0.1 Rational -> Integer -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Fixed e -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Fixed e
x Fixed e -> Fixed e -> Fixed e
forall a. Num a => a -> a -> a
* 0.45))
    log :: Fixed e -> Fixed e
log = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.log
    sin :: Fixed e -> Fixed e
sin = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.sin
    cos :: Fixed e -> Fixed e
cos = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.cos
    tan :: Fixed e -> Fixed e
tan = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.tan
    asin :: Fixed e -> Fixed e
asin = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.asin
    acos :: Fixed e -> Fixed e
acos = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.acos
    atan :: Fixed e -> Fixed e
atan = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.atan
    sinh :: Fixed e -> Fixed e
sinh = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.sinh
    cosh :: Fixed e -> Fixed e
cosh = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.cosh
    tanh :: Fixed e -> Fixed e
tanh = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.tanh
    asinh :: Fixed e -> Fixed e
asinh = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.asinh
    acosh :: Fixed e -> Fixed e
acosh = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.acosh
    atanh :: Fixed e -> Fixed e
atanh = (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.atanh

toFixed0 :: (Epsilon e) => (Rational -> Rational) -> Fixed e
toFixed0 :: (Rational -> Rational) -> Fixed e
toFixed0 f :: Rational -> Rational
f = Fixed e
r
    where r :: Fixed e
r = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Fixed e) -> Rational -> Fixed e
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
f (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
r

toFixed1 :: (Epsilon e) => (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 :: (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 f :: Rational -> Rational -> Rational
f x :: Fixed e
x@(F r :: Rational
r) = Rational -> Fixed e
forall e. Rational -> Fixed e
F (Rational -> Fixed e) -> Rational -> Fixed e
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
f (Fixed e -> Rational
forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
x) Rational
r

instance (Epsilon e) => RealFloat (Fixed e) where
    exponent :: Fixed e -> Int
exponent _ = 0
    scaleFloat :: Int -> Fixed e -> Fixed e
scaleFloat 0 x :: Fixed e
x = Fixed e
x
    isNaN :: Fixed e -> Bool
isNaN _ = Bool
False
    isInfinite :: Fixed e -> Bool
isInfinite _ = Bool
False
    isDenormalized :: Fixed e -> Bool
isDenormalized _ = Bool
False
    isNegativeZero :: Fixed e -> Bool
isNegativeZero _ = Bool
False
    isIEEE :: Fixed e -> Bool
isIEEE _ = Bool
False
    -- Explicitly undefine these rather than omitting them; this
    -- prevents a compiler warning at least.
    floatRadix :: Fixed e -> Integer
floatRadix = Fixed e -> Integer
forall a. HasCallStack => a
undefined
    floatDigits :: Fixed e -> Int
floatDigits = Fixed e -> Int
forall a. HasCallStack => a
undefined
    floatRange :: Fixed e -> (Int, Int)
floatRange = Fixed e -> (Int, Int)
forall a. HasCallStack => a
undefined
    decodeFloat :: Fixed e -> (Integer, Int)
decodeFloat = Fixed e -> (Integer, Int)
forall a. HasCallStack => a
undefined
    encodeFloat :: Integer -> Int -> Fixed e
encodeFloat = Integer -> Int -> Fixed e
forall a. HasCallStack => a
undefined

-----------

-- The call @dynmicEps r f v@ evaluates @f v@ to a precsion of @r@.
dynamicEps :: forall a . Rational -> (forall e . Epsilon e => Fixed e -> a) -> Rational -> a
dynamicEps :: Rational -> (forall e. Epsilon e => Fixed e -> a) -> Rational -> a
dynamicEps r :: Rational
r f :: forall e. Epsilon e => Fixed e -> a
f v :: Rational
v = Eps1 -> a
forall x. Epsilon x => x -> a
loop (Eps1
forall a. HasCallStack => a
undefined :: Eps1)
  where loop :: forall x . (Epsilon x) => x -> a
        loop :: x -> a
loop e :: x
e = if x -> Rational
forall e. Epsilon e => e -> Rational
eps x
e Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
r then Fixed x -> a
forall e. Epsilon e => Fixed e -> a
f (Rational -> Fixed x
forall a. Fractional a => Rational -> a
fromRational Rational
v :: Fixed x) else EpsDiv10 x -> a
forall x. Epsilon x => x -> a
loop (EpsDiv10 x
forall a. HasCallStack => a
undefined :: EpsDiv10 x)

-- | The call @with_added_precision r f v@ evaluates @f v@, while
-- temporarily multiplying the precision of /v/ by /r/.
with_added_precision :: forall a f.(Epsilon f) => Rational -> (forall e.(Epsilon e) => Fixed e -> a) -> Fixed f -> a
with_added_precision :: Rational -> (forall e. Epsilon e => Fixed e -> a) -> Fixed f -> a
with_added_precision r :: Rational
r f :: forall e. Epsilon e => Fixed e -> a
f v :: Fixed f
v = Rational -> (forall e. Epsilon e => Fixed e -> a) -> Rational -> a
forall a.
Rational -> (forall e. Epsilon e => Fixed e -> a) -> Rational -> a
dynamicEps (Rational
pRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
r) forall e. Epsilon e => Fixed e -> a
f (Fixed f -> Rational
forall a. Real a => a -> Rational
toRational Fixed f
v) where
  p :: Rational
p = Fixed f -> Rational
forall e. Epsilon e => Fixed e -> Rational
precision Fixed f
v