RealField.hs

{-# OPTIONS -fno-implicit-prelude #-}
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


{- |
Minimal complete definition:
     'splitFraction' or 'floor'

There are probably more laws, but some laws are

> (fromInteger.fst.splitFraction) a + (snd.splitFraction) a === a
>    ceiling (toRational x) === ceiling x :: Integer
>   truncate (toRational x) === truncate x :: Integer
>      floor (toRational x) === floor x :: Integer

If there wouldn't be @Real.C a@ and @ToInteger.C b@ constraints,
we could also use this class for splitting ratios of polynomials.

As an aside, let me note the similarities
between @splitFraction x@ and @x divMod 1@ (if that were defined).
In particular, it might make sense to unify the rounding modes somehow.

IEEEFloat-specific calls are removed here (cf. 'Prelude.RealFloat')
so probably nobody will actually use this default definition.

Henning:
New function 'fraction' doesn't return the integer part of the number.
This also removes a type ambiguity if the integer part is not needed.

The new methods 'fraction' and 'splitFraction'
differ from 'Prelude.properFraction' semantics.
They always round to 'floor'.
This means that the fraction is always non-negative and
is always smaller than 1.
This is more useful in practice and
can be generalised to more than real numbers.
Since every 'Number.Ratio.T' denominator type supports 'Algebra.IntegralDomain.divMod',
every 'Number.Ratio.T' can provide 'fraction' and 'splitFraction',
e.g. fractions of polynomials.
However the ''integral'' part would not be of type class 'ToInteger.C'.

Can there be a separate class for
'fraction', 'splitFraction', 'floor' and 'ceiling'
since they do not need reals and their ordering?
-}

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   =  signum x * floor (abs 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)
                    -- preludeFraction
    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
   --  if x>=0 || f==0
   in  if f>=0
         then (fromInteger n,   f)
         else (fromInteger n-1, 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


{- | TODO: Should be moved to a continued fraction module. -}

approxRational :: (ToRational.C a, C a) => a -> a -> Rational
approxRational rat eps    =  simplest (rat-eps) (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'       -- assumes 0 < 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