{-# LANGUAGE
EmptyDataDecls,
GeneralizedNewtypeDeriving,
ScopedTypeVariables,
Rank2Types #-}
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
class Epsilon e where
eps :: e -> Rational
data Eps1
instance Epsilon Eps1 where
eps :: Eps1 -> Rational
eps Eps1
_ = Rational
1
data EpsDiv10 p
instance (Epsilon e) => Epsilon (EpsDiv10 e) where
eps :: EpsDiv10 e -> Rational
eps EpsDiv10 e
e = forall e. Epsilon e => e -> Rational
eps (EpsDiv10 e -> e
un EpsDiv10 e
e) forall a. Fractional a => a -> a -> a
/ Rational
10
where un :: EpsDiv10 e -> e
un :: EpsDiv10 e -> e
un = forall a. HasCallStack => a
undefined
data Prec10
instance Epsilon Prec10 where
eps :: Prec10 -> Rational
eps Prec10
_ = Rational
1e-10
data Prec50
instance Epsilon Prec50 where
eps :: Prec50 -> Rational
eps Prec50
_ = Rational
1e-50
data Prec500
instance Epsilon Prec500 where
eps :: Prec500 -> Rational
eps Prec500
_ = Rational
1e-500
data PrecPlus20 e
instance (Epsilon e) => Epsilon (PrecPlus20 e) where
eps :: PrecPlus20 e -> Rational
eps PrecPlus20 e
e = Rational
1e-20 forall a. Num a => a -> a -> a
* forall e. Epsilon e => e -> Rational
eps (PrecPlus20 e -> e
un PrecPlus20 e
e)
where un :: PrecPlus20 e -> e
un :: PrecPlus20 e -> e
un = forall a. HasCallStack => a
undefined
newtype Fixed e = F Rational deriving (Fixed e -> Fixed e -> Bool
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, 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
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]
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, 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
Real, 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 :: forall b. Integral b => Fixed e -> b
$cfloor :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
ceiling :: forall b. Integral b => Fixed e -> b
$cceiling :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
round :: forall b. Integral b => Fixed e -> b
$cround :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
truncate :: forall b. Integral b => Fixed e -> b
$ctruncate :: forall e b. (Epsilon e, Integral b) => Fixed e -> b
properFraction :: forall b. Integral b => Fixed e -> (b, Fixed e)
$cproperFraction :: forall e b. (Epsilon e, Integral b) => Fixed e -> (b, Fixed e)
RealFrac)
precision :: (Epsilon e) => Fixed e -> Rational
precision :: forall e. Epsilon e => Fixed e -> Rational
precision = forall e. Epsilon e => Fixed e -> Rational
getEps
instance (Epsilon e) => Num (Fixed e) where
+ :: Fixed e -> Fixed e -> Fixed e
(+) = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 forall a. Num a => a -> a -> a
(+)
(-) = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 (-)
* :: Fixed e -> Fixed e -> Fixed e
(*) = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 forall a. Num a => a -> a -> a
(*)
negate :: Fixed e -> Fixed e
negate (F Rational
x) = forall e. Rational -> Fixed e
F (forall a. Num a => a -> a
negate Rational
x)
abs :: Fixed e -> Fixed e
abs (F Rational
x) = forall e. Rational -> Fixed e
F (forall a. Num a => a -> a
abs Rational
x)
signum :: Fixed e -> Fixed e
signum (F Rational
x) = forall e. Rational -> Fixed e
F (forall a. Num a => a -> a
signum Rational
x)
fromInteger :: Integer -> Fixed e
fromInteger = forall e. Rational -> Fixed e
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
instance (Epsilon e) => Fractional (Fixed e) where
/ :: Fixed e -> Fixed e -> Fixed e
(/) = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 forall a. Fractional a => a -> a -> a
(/)
fromRational :: Rational -> Fixed e
fromRational Rational
x = Fixed e
r
where r :: Fixed e
r = forall e. Rational -> Fixed e
F forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
approx Rational
x (forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
r)
lift2 :: (Epsilon e) => (Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 :: forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e -> Fixed e
lift2 Rational -> Rational -> Rational
op fx :: Fixed e
fx@(F Rational
x) (F Rational
y) = forall e. Rational -> Fixed e
F forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
approx (Rational
x Rational -> Rational -> Rational
`op` Rational
y) (forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
fx)
approx :: Rational -> Rational -> Rational
approx :: Rational -> Rational -> Rational
approx Rational
x Rational
eps = forall a. RealFrac a => a -> a -> Rational
approxRational Rational
x (Rational
epsforall a. Fractional a => a -> a -> a
/Rational
2)
convertFixed :: (Epsilon e, Epsilon f) => Fixed e -> Fixed f
convertFixed :: forall e f. (Epsilon e, Epsilon f) => Fixed e -> Fixed f
convertFixed e :: Fixed e
e@(F Rational
x) = Fixed f
f
where f :: Fixed f
f = forall e. Rational -> Fixed e
F forall a b. (a -> b) -> a -> b
$ if Rational
feps forall a. Ord a => a -> a -> Bool
> Rational
eeps then Rational -> Rational -> Rational
approx Rational
x Rational
feps else Rational
x
feps :: Rational
feps = forall e. Epsilon e => Fixed e -> Rational
getEps Fixed f
f
eeps :: Rational
eeps = forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
e
getEps :: (Epsilon e) => Fixed e -> Rational
getEps :: forall e. Epsilon e => Fixed e -> Rational
getEps = forall e. Epsilon e => e -> Rational
eps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Fixed e -> e
un
where un :: Fixed e -> e
un :: forall e. Fixed e -> e
un = forall a. HasCallStack => a
undefined
instance (Epsilon e) => Show (Fixed e) where
showsPrec :: Int -> Fixed e -> ShowS
showsPrec = forall a. Real a => (a -> ShowS) -> Int -> a -> ShowS
showSigned forall {e}. Epsilon e => Fixed e -> ShowS
showFixed
where showFixed :: Fixed e -> ShowS
showFixed f :: Fixed e
f@(F Rational
x) = String -> ShowS
showString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
q forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall {t} {t}. (Ord t, Num t, RealFrac t) => t -> t -> String
decimals Rational
r Rational
e
where q :: Integer
(Integer
q, Rational
r) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational
x forall a. Num a => a -> a -> a
+ Rational
eforall a. Fractional a => a -> a -> a
/Rational
2)
e :: Rational
e = forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
f
decimals :: t -> t -> String
decimals t
a t
e | t
e forall a. Ord a => a -> a -> Bool
>= t
1 = String
""
| Bool
otherwise = Int -> Char
intToDigit Int
b forall a. a -> [a] -> [a]
: t -> t -> String
decimals t
c (t
10 forall a. Num a => a -> a -> a
* t
e)
where (Int
b, t
c) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (t
10 forall a. Num a => a -> a -> a
* t
a)
instance (Epsilon e) => Read (Fixed e) where
readsPrec :: Int -> ReadS (Fixed e)
readsPrec Int
_ = forall a. Real a => ReadS a -> ReadS a
readSigned forall {e}. Epsilon e => String -> [(Fixed e, String)]
readFixed
where readFixed :: String -> [(Fixed e, String)]
readFixed String
s = [ (forall e. Epsilon e => (Rational -> Rational) -> Fixed e
toFixed0 (forall a. RealFrac a => a -> a -> Rational
approxRational Rational
x), String
s') | (Rational
x, String
s') <- forall a. RealFrac a => ReadS a
readFloat String
s ]
instance (Epsilon e) => Floating (Fixed e) where
pi :: Fixed e
pi = forall e. Epsilon e => (Rational -> Rational) -> Fixed e
toFixed0 Rational -> Rational
F.pi
sqrt :: Fixed e -> Fixed e
sqrt = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.sqrt
exp :: Fixed e -> Fixed e
exp Fixed e
x = forall a f.
Epsilon f =>
Rational -> (forall e. Epsilon e => Fixed e -> a) -> Fixed f -> a
with_added_precision Rational
r (forall e f. (Epsilon e, Epsilon f) => Fixed e -> Fixed f
convertFixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 forall a. Ord a => a -> a -> Bool
< Fixed e
0 then Rational
1 else Rational
0.1 forall a b. (Num a, Integral b) => a -> b -> a
^ (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Fixed e
x forall a. Num a => a -> a -> a
* Fixed e
0.45))
log :: Fixed e -> Fixed e
log = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.log
sin :: Fixed e -> Fixed e
sin = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.sin
cos :: Fixed e -> Fixed e
cos = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.cos
tan :: Fixed e -> Fixed e
tan = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.tan
asin :: Fixed e -> Fixed e
asin = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.asin
acos :: Fixed e -> Fixed e
acos = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.acos
atan :: Fixed e -> Fixed e
atan = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.atan
sinh :: Fixed e -> Fixed e
sinh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.sinh
cosh :: Fixed e -> Fixed e
cosh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.cosh
tanh :: Fixed e -> Fixed e
tanh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.tanh
asinh :: Fixed e -> Fixed e
asinh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.asinh
acosh :: Fixed e -> Fixed e
acosh = forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
F.acosh
atanh :: Fixed e -> Fixed e
atanh = 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 :: forall e. Epsilon e => (Rational -> Rational) -> Fixed e
toFixed0 Rational -> Rational
f = Fixed e
r
where r :: Fixed e
r = forall e. Rational -> Fixed e
F forall a b. (a -> b) -> a -> b
$ Rational -> Rational
f forall a b. (a -> b) -> a -> b
$ forall e. Epsilon e => Fixed e -> Rational
getEps Fixed e
r
toFixed1 :: (Epsilon e) => (Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 :: forall e.
Epsilon e =>
(Rational -> Rational -> Rational) -> Fixed e -> Fixed e
toFixed1 Rational -> Rational -> Rational
f x :: Fixed e
x@(F Rational
r) = forall e. Rational -> Fixed e
F forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
f (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 Fixed e
_ = Int
0
scaleFloat :: Int -> Fixed e -> Fixed e
scaleFloat Int
0 Fixed e
x = Fixed e
x
isNaN :: Fixed e -> Bool
isNaN Fixed e
_ = Bool
False
isInfinite :: Fixed e -> Bool
isInfinite Fixed e
_ = Bool
False
isDenormalized :: Fixed e -> Bool
isDenormalized Fixed e
_ = Bool
False
isNegativeZero :: Fixed e -> Bool
isNegativeZero Fixed e
_ = Bool
False
isIEEE :: Fixed e -> Bool
isIEEE Fixed e
_ = Bool
False
floatRadix :: Fixed e -> Integer
floatRadix = forall a. HasCallStack => a
undefined
floatDigits :: Fixed e -> Int
floatDigits = forall a. HasCallStack => a
undefined
floatRange :: Fixed e -> (Int, Int)
floatRange = forall a. HasCallStack => a
undefined
decodeFloat :: Fixed e -> (Integer, Int)
decodeFloat = forall a. HasCallStack => a
undefined
encodeFloat :: Integer -> Int -> Fixed e
encodeFloat = forall a. HasCallStack => a
undefined
dynamicEps :: forall a . Rational -> (forall e . Epsilon e => Fixed e -> a) -> Rational -> a
dynamicEps :: forall a.
Rational -> (forall e. Epsilon e => Fixed e -> a) -> Rational -> a
dynamicEps Rational
r forall e. Epsilon e => Fixed e -> a
f Rational
v = forall x. Epsilon x => x -> a
loop (forall a. HasCallStack => a
undefined :: Eps1)
where loop :: forall x . (Epsilon x) => x -> a
loop :: forall x. Epsilon x => x -> a
loop x
e = if forall e. Epsilon e => e -> Rational
eps x
e forall a. Ord a => a -> a -> Bool
<= Rational
r then forall e. Epsilon e => Fixed e -> a
f (forall a. Fractional a => Rational -> a
fromRational Rational
v :: Fixed x) else forall x. Epsilon x => x -> a
loop (forall a. HasCallStack => a
undefined :: EpsDiv10 x)
with_added_precision :: forall a f.(Epsilon f) => Rational -> (forall e.(Epsilon e) => Fixed e -> a) -> Fixed f -> a
with_added_precision :: forall a f.
Epsilon f =>
Rational -> (forall e. Epsilon e => Fixed e -> a) -> Fixed f -> a
with_added_precision Rational
r forall e. Epsilon e => Fixed e -> a
f Fixed f
v = forall a.
Rational -> (forall e. Epsilon e => Fixed e -> a) -> Rational -> a
dynamicEps (Rational
pforall a. Num a => a -> a -> a
*Rational
r) forall e. Epsilon e => Fixed e -> a
f (forall a. Real a => a -> Rational
toRational Fixed f
v) where
p :: Rational
p = forall e. Epsilon e => Fixed e -> Rational
precision Fixed f
v