module Algebra.RealField where
import qualified Algebra.Field as Field
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Real as Real
import qualified Algebra.Ring as Ring
import qualified Algebra.ToRational as ToRational
import qualified Algebra.ToInteger as ToInteger
import Algebra.Field ((/))
import Algebra.RealIntegral (quotRem, )
import Algebra.IntegralDomain (divMod, even, )
import Algebra.Ring ((*), fromInteger, )
import Algebra.Additive ((+), (), negate, )
import Algebra.ZeroTestable (isZero, )
import Algebra.ToInteger (fromIntegral, )
import qualified Number.Ratio as Ratio
import Number.Ratio (T((:%)), Rational)
import qualified GHC.Float as GHC
import Prelude(Int,Float,Double)
import qualified Prelude as P
import PreludeBase
class (Real.C a, Field.C a) => C a where
splitFraction :: (ToInteger.C b) => a -> (b,a)
fraction :: a -> a
ceiling, floor :: (ToInteger.C b) => a -> b
truncate, round :: (ToInteger.C b) => a -> b
splitFraction x = (floor x, fraction x)
fraction x = x fromInteger (floor x)
floor x = fromInteger (fst (splitFraction x))
ceiling x = floor (x)
truncate x = if x>=0
then floor x
else ceiling x
round x = let (n,r) = splitFraction x
in case compare r (1/2) of
LT -> n
EQ -> if even n then n else n+1
GT -> n+1
instance (ToInteger.C a, PID.C a) => C (Ratio.T a) where
splitFraction (x:%y) = (fromIntegral q, r:%y)
where (q,r) = divMod x y
instance C Float where
splitFraction = preludeSplitFraction
fraction = fractionTrunc (GHC.int2Float . GHC.float2Int)
floor = fromInteger . P.floor
ceiling = fromInteger . P.ceiling
round = fromInteger . P.round
truncate = fromInteger . P.truncate
instance C Double where
splitFraction = preludeSplitFraction
fraction = fractionTrunc (GHC.int2Double . GHC.double2Int)
floor = fromInteger . P.floor
ceiling = fromInteger . P.ceiling
round = fromInteger . P.round
truncate = fromInteger . P.truncate
preludeSplitFraction :: (P.RealFrac a, Ring.C a, ToInteger.C b) => a -> (b,a)
preludeSplitFraction x =
let (n,f) = P.properFraction x
in if f>=0
then (fromInteger n, f)
else (fromInteger n1, f+1)
preludeFraction :: (P.RealFrac a, Ring.C a) => a -> a
preludeFraction x =
let second :: (Int, a) -> a
second = snd
in fixFraction (second (P.properFraction x))
fractionTrunc :: (Ring.C a, Ord a) => (a -> a) -> a -> a
fractionTrunc trunc x =
fixFraction (x trunc x)
fixFraction :: (Ring.C a, Ord a) => a -> a
fixFraction y =
if y>=0 then y else y+1
approxRational :: (ToRational.C a, C a) => a -> a -> Rational
approxRational rat eps = simplest (rateps) (rat+eps)
where simplest x y | y < x = simplest y x
| x == y = xr
| x > 0 = simplest' n d n' d'
| y < 0 = simplest' (n') d' (n) d
| otherwise = 0 :% 1
where xr@(n:%d) = ToRational.toRational x
(n':%d') = ToRational.toRational y
simplest' n d n' d'
| isZero r = q :% 1
| q /= q' = (q+1) :% 1
| otherwise = (q*n''+d'') :% n''
where (q,r) = quotRem n d
(q',r') = quotRem n' d'
(n'':%d'') = simplest' d' r' d r