{-# LANGUAGE RebindableSyntax #-}
module Algebra.RealRing where

import qualified Algebra.RealRing98 as RealRing98

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring
import qualified Algebra.ToRational     as ToRational
import qualified Algebra.ToInteger      as ToInteger
import qualified Algebra.Absolute       as Absolute

import qualified Algebra.OrderDecision as OrdDec
import Algebra.OrderDecision ((<?), (>=?), )

import Algebra.Field          (fromRational, )
import Algebra.RealIntegral   (quotRem, )
import Algebra.IntegralDomain (divMod, even, )
import Algebra.Ring           ((*), fromInteger, one, )
import Algebra.Additive       ((+), (-), negate, zero, )
import Algebra.ZeroTestable   (isZero, )
import Algebra.ToInteger      (fromIntegral, )

import qualified Number.Ratio as Ratio
import Number.Ratio (T((:%)), Rational)

import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )
import Data.Word (Word, Word8, Word16, Word32, Word64, )

import qualified GHC.Float as GHC
import Data.List as List
import Data.Tuple.HT (mapFst, mapPair, )
import Prelude (Integer, Float, Double, )
import qualified Prelude as P
import NumericPrelude.Base


{- $setup
>>> import qualified Algebra.RealRing as RealRing
>>> import Data.Tuple.HT (mapFst)
>>> import NumericPrelude.Numeric as NP
>>> import NumericPrelude.Base
>>> import Prelude ()
>>>
>>> infix 4 =~=
>>>
>>> (=~=) :: (Eq b) => (a -> b) -> (a -> b) -> a -> Bool
>>> (f =~= g) x = f x == g x
-}


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

There are probably more laws, but some laws are

> splitFraction x === (fromInteger (floor x), fraction x)
> fromInteger (floor x) + fraction x === x
> floor x       <= x       x <  floor x + 1
> ceiling x - 1 <  x       x <= ceiling x
> 0 <= fraction x          fraction x < 1

>               - ceiling x === floor (-x)
>                truncate x === signum x * floor (abs x)
>    ceiling (toRational x) === ceiling x :: Integer
>   truncate (toRational x) === truncate x :: Integer
>      floor (toRational x) === floor x :: Integer

The 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.

Many people will associate rounding with fractional numbers,
and thus they are surprised about the superclass being @Ring@ not @Field@.
The reason is that all of these methods can be defined
exclusively with functions from @Ord@ and @Ring@.
The implementations of 'genericFloor' and other functions demonstrate that.
They implement power-of-two-algorithms
like the one for finding the number of digits of an 'Integer'
in FixedPoint-fractions module.
They are even reasonably efficient.

I am still uncertain whether it was a good idea
to add instances for @Integer@ and friends,
since calling @floor@ or @fraction@ on an integer may well indicate a bug.
The rounding functions are just the identity function
and 'fraction' is constant zero.
However, I decided to associate our class with @Ring@ rather than @Field@,
after I found myself using repeated subtraction and testing
rather than just calling @fraction@,
just in order to get the constraint @(Ring a, Ord a)@
that was more general than @(RealField a)@.

For the results of the rounding functions
we have chosen the constraint @Ring@ instead of @ToInteger@,
since this is more flexible to use,
but it still signals to the user that only integral numbers can be returned.
This is so, because the plain @Ring@ class only provides
@zero@, @one@ and operations that allow to reach all natural numbers but not more.


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

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 @Ring@ constraint for the ''integral'' part of 'splitFraction'
is too weak in order to generate polynomials.
After all, I am uncertain whether this would be useful or not.

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

We might also add a round method,
that rounds 0.5 always up or always down.
This is much more efficient in inner loops
and is acceptable or even preferable for many applications.
-}

class (Absolute.C a, Ord a) => C a where
    {-# MINIMAL splitFraction | floor #-}
    {- |
    prop> \x -> (x::Rational) == (uncurry (+) $ mapFst fromInteger $ splitFraction x)
    prop> \x -> uncurry (==) $ mapFst (((x::Double)-) . fromInteger) $ splitFraction x
    prop> \x -> uncurry (==) $ mapFst (((x::Rational)-) . fromInteger) $ splitFraction x
    prop> \x -> splitFraction x == (floor (x::Double) :: Integer, fraction x)
    prop> \x -> splitFraction x == (floor (x::Rational) :: Integer, fraction x)
    -}
    splitFraction    :: (Ring.C b) => a -> (b,a)
    {- |
    prop> \x -> let y = fraction (x::Double) in 0<=y && y<1
    prop> \x -> let y = fraction (x::Rational) in 0<=y && y<1
    -}
    fraction :: a -> a
    {- |
    prop> \x -> ceiling (-x) == negate (floor (x::Double) :: Integer)
    prop> \x -> ceiling (-x) == negate (floor (x::Rational) :: Integer)
    -}
    ceiling, floor   :: (Ring.C b) => a -> b
    truncate         :: (Ring.C b) => a -> b
    round            :: (ToInteger.C b) => a -> b


    splitFraction a
x   =  (a -> b
forall a b. (C a, C b) => a -> b
floor a
x, a -> a
forall a. C a => a -> a
fraction a
x)

    fraction a
x   =  a
x a -> a -> a
forall a. C a => a -> a -> a
- Integer -> a
forall a. C a => Integer -> a
fromInteger (a -> Integer
forall a b. (C a, C b) => a -> b
floor a
x)

    floor a
x      =  Integer -> b
forall a. C a => Integer -> a
fromInteger ((Integer, a) -> Integer
forall a b. (a, b) -> a
fst (a -> (Integer, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
x))

    ceiling a
x    =  - a -> b
forall a b. (C a, C b) => a -> b
floor (-a
x)

--    truncate x   =  signum x * floor (abs x)
    truncate a
x =
       if a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
0
         then a -> b
forall a b. (C a, C b) => a -> b
floor a
x
         else a -> b
forall a b. (C a, C b) => a -> b
ceiling a
x

    {-
    The ToInteger constraint can be lifted to Ring
    if use Integer temporarily.
    I expect this would not be efficient in many cases.
    -}
    round a
x =
       let (b
n,a
r) = a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
x
       in  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
r) a
forall a. C a => a
one of
              Ordering
LT -> b
n
              Ordering
EQ -> if b -> Bool
forall a. (C a, C a) => a -> Bool
even b
n then b
n else b
nb -> b -> b
forall a. C a => a -> a -> a
+b
1
              Ordering
GT -> b
nb -> b -> b
forall a. C a => a -> a -> a
+b
1


{- |
This function rounds to the closest integer.
For @fraction x == 0.5@ it rounds away from zero.
This function is not the result of an ingenious mathematical insight,
but is simply a kind of rounding that is the fastest
on IEEE floating point architectures.
-}
{-# NOINLINE [2] roundSimple #-}
roundSimple :: (C a, Ring.C b) => a -> b
roundSimple :: a -> b
roundSimple a
x =
   let (b
n,a
r) = a -> (b, a)
forall a b. (C a, C b) => a -> (b, a)
splitFraction a
x
   in  case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a
2a -> a -> a
forall a. C a => a -> a -> a
*a
r) a
forall a. C a => a
one of
          Ordering
LT -> b
n
          Ordering
EQ -> if a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
0 then b
n else b
nb -> b -> b
forall a. C a => a -> a -> a
+b
1
          Ordering
GT -> b
nb -> b -> b
forall a. C a => a -> a -> a
+b
1


instance (ToInteger.C a, PID.C a) => C (Ratio.T a) where
    splitFraction :: T a -> (b, T a)
splitFraction (a
x:%a
y) = (a -> b
forall a b. (C a, C b) => a -> b
fromIntegral a
q, a
ra -> a -> T a
forall a. a -> a -> T a
:%a
y)
                               where (a
q,a
r) = a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
divMod a
x a
y

instance C Integer where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Integer -> (b, Integer)
splitFraction Integer
x = (Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
x, Integer
forall a. C a => a
zero)
    fraction :: Integer -> Integer
fraction      Integer
_ = Integer
forall a. C a => a
zero
    floor :: Integer -> b
floor         Integer
x = Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
x
    ceiling :: Integer -> b
ceiling       Integer
x = Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
x
    round :: Integer -> b
round         Integer
x = Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
x
    truncate :: Integer -> b
truncate      Integer
x = Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
x

instance C Int where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Int -> (b, Int)
splitFraction Int
x = (Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int
x, Int
forall a. C a => a
zero)
    fraction :: Int -> Int
fraction      Int
_ = Int
forall a. C a => a
zero
    floor :: Int -> b
floor         Int
x = Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int
x
    ceiling :: Int -> b
ceiling       Int
x = Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int
x
    round :: Int -> b
round         Int
x = Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int
x
    truncate :: Int -> b
truncate      Int
x = Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int
x

instance C Int8 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Int8 -> (b, Int8)
splitFraction Int8
x = (Int8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int8
x, Int8
forall a. C a => a
zero)
    fraction :: Int8 -> Int8
fraction      Int8
_ = Int8
forall a. C a => a
zero
    floor :: Int8 -> b
floor         Int8
x = Int8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int8
x
    ceiling :: Int8 -> b
ceiling       Int8
x = Int8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int8
x
    round :: Int8 -> b
round         Int8
x = Int8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int8
x
    truncate :: Int8 -> b
truncate      Int8
x = Int8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int8
x

instance C Int16 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Int16 -> (b, Int16)
splitFraction Int16
x = (Int16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int16
x, Int16
forall a. C a => a
zero)
    fraction :: Int16 -> Int16
fraction      Int16
_ = Int16
forall a. C a => a
zero
    floor :: Int16 -> b
floor         Int16
x = Int16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int16
x
    ceiling :: Int16 -> b
ceiling       Int16
x = Int16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int16
x
    round :: Int16 -> b
round         Int16
x = Int16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int16
x
    truncate :: Int16 -> b
truncate      Int16
x = Int16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int16
x

instance C Int32 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Int32 -> (b, Int32)
splitFraction Int32
x = (Int32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int32
x, Int32
forall a. C a => a
zero)
    fraction :: Int32 -> Int32
fraction      Int32
_ = Int32
forall a. C a => a
zero
    floor :: Int32 -> b
floor         Int32
x = Int32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int32
x
    ceiling :: Int32 -> b
ceiling       Int32
x = Int32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int32
x
    round :: Int32 -> b
round         Int32
x = Int32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int32
x
    truncate :: Int32 -> b
truncate      Int32
x = Int32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int32
x

instance C Int64 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Int64 -> (b, Int64)
splitFraction Int64
x = (Int64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int64
x, Int64
forall a. C a => a
zero)
    fraction :: Int64 -> Int64
fraction      Int64
_ = Int64
forall a. C a => a
zero
    floor :: Int64 -> b
floor         Int64
x = Int64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int64
x
    ceiling :: Int64 -> b
ceiling       Int64
x = Int64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int64
x
    round :: Int64 -> b
round         Int64
x = Int64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int64
x
    truncate :: Int64 -> b
truncate      Int64
x = Int64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int64
x

instance C Word8 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Word8 -> (b, Word8)
splitFraction Word8
x = (Word8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word8
x, Word8
forall a. C a => a
zero)
    fraction :: Word8 -> Word8
fraction      Word8
_ = Word8
forall a. C a => a
zero
    floor :: Word8 -> b
floor         Word8
x = Word8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word8
x
    ceiling :: Word8 -> b
ceiling       Word8
x = Word8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word8
x
    round :: Word8 -> b
round         Word8
x = Word8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word8
x
    truncate :: Word8 -> b
truncate      Word8
x = Word8 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word8
x

instance C Word16 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Word16 -> (b, Word16)
splitFraction Word16
x = (Word16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word16
x, Word16
forall a. C a => a
zero)
    fraction :: Word16 -> Word16
fraction      Word16
_ = Word16
forall a. C a => a
zero
    floor :: Word16 -> b
floor         Word16
x = Word16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word16
x
    ceiling :: Word16 -> b
ceiling       Word16
x = Word16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word16
x
    round :: Word16 -> b
round         Word16
x = Word16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word16
x
    truncate :: Word16 -> b
truncate      Word16
x = Word16 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word16
x

instance C Word32 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Word32 -> (b, Word32)
splitFraction Word32
x = (Word32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word32
x, Word32
forall a. C a => a
zero)
    fraction :: Word32 -> Word32
fraction      Word32
_ = Word32
forall a. C a => a
zero
    floor :: Word32 -> b
floor         Word32
x = Word32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word32
x
    ceiling :: Word32 -> b
ceiling       Word32
x = Word32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word32
x
    round :: Word32 -> b
round         Word32
x = Word32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word32
x
    truncate :: Word32 -> b
truncate      Word32
x = Word32 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word32
x

instance C Word64 where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Word64 -> (b, Word64)
splitFraction Word64
x = (Word64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word64
x, Word64
forall a. C a => a
zero)
    fraction :: Word64 -> Word64
fraction      Word64
_ = Word64
forall a. C a => a
zero
    floor :: Word64 -> b
floor         Word64
x = Word64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word64
x
    ceiling :: Word64 -> b
ceiling       Word64
x = Word64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word64
x
    round :: Word64 -> b
round         Word64
x = Word64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word64
x
    truncate :: Word64 -> b
truncate      Word64
x = Word64 -> b
forall a b. (C a, C b) => a -> b
fromIntegral Word64
x

instance C Float where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Float -> (b, Float)
splitFraction = (Float -> Int) -> (Int -> Float) -> Float -> (b, Float)
forall a b.
(RealFrac a, C a, C b) =>
(a -> Int) -> (Int -> a) -> a -> (b, a)
fastSplitFraction Float -> Int
GHC.float2Int Int -> Float
GHC.int2Float
    fraction :: Float -> Float
fraction      = (Float -> Float) -> Float -> Float
forall a. RealFrac a => (a -> a) -> a -> a
RealRing98.fastFraction (Int -> Float
GHC.int2Float (Int -> Float) -> (Float -> Int) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int
GHC.float2Int)
    floor :: Float -> b
floor         = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Float -> Integer) -> Float -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor
    ceiling :: Float -> b
ceiling       = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Float -> Integer) -> Float -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling
    round :: Float -> b
round         = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Float -> Integer) -> Float -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.round
    truncate :: Float -> b
truncate      = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Float -> Integer) -> Float -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.truncate

instance C Double where
    {-# INLINE splitFraction #-}
    {-# INLINE fraction #-}
    {-# INLINE floor #-}
    {-# INLINE ceiling #-}
    {-# INLINE round #-}
    {-# INLINE truncate #-}
    splitFraction :: Double -> (b, Double)
splitFraction = (Double -> Int) -> (Int -> Double) -> Double -> (b, Double)
forall a b.
(RealFrac a, C a, C b) =>
(a -> Int) -> (Int -> a) -> a -> (b, a)
fastSplitFraction Double -> Int
GHC.double2Int Int -> Double
GHC.int2Double
    fraction :: Double -> Double
fraction      = (Double -> Double) -> Double -> Double
forall a. RealFrac a => (a -> a) -> a -> a
RealRing98.fastFraction (Int -> Double
GHC.int2Double (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
GHC.double2Int)
    floor :: Double -> b
floor         = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Double -> Integer) -> Double -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor
    ceiling :: Double -> b
ceiling       = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Double -> Integer) -> Double -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling
    round :: Double -> b
round         = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Double -> Integer) -> Double -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.round
    truncate :: Double -> b
truncate      = Integer -> b
forall a. C a => Integer -> a
fromInteger (Integer -> b) -> (Double -> Integer) -> Double -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.truncate


{-# INLINE fastSplitFraction #-}
fastSplitFraction :: (P.RealFrac a, Absolute.C a, Ring.C b) =>
   (a -> Int) -> (Int -> a) -> a -> (b,a)
fastSplitFraction :: (a -> Int) -> (Int -> a) -> a -> (b, a)
fastSplitFraction a -> Int
trunc Int -> a
toFloat a
x =
   (b, a) -> (b, a)
forall a b. (C a, C b, Ord a) => (b, a) -> (b, a)
fixSplitFraction ((b, a) -> (b, a)) -> (b, a) -> (b, a)
forall a b. (a -> b) -> a -> b
$
   if Int -> a
toFloat Int
forall a. Bounded a => a
minBound a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> a
toFloat Int
forall a. Bounded a => a
maxBound
     then case a -> Int
trunc a
x of Int
n -> (Int -> b
forall a b. (C a, C b) => a -> b
fromIntegral Int
n, a
x a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
toFloat Int
n)
     else case a -> (Integer, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction a
x of (Integer
n,a
f) -> (Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
n, a
f)

{-# INLINE fixSplitFraction #-}
fixSplitFraction :: (Ring.C a, Ring.C b, Ord a) => (b,a) -> (b,a)
fixSplitFraction :: (b, a) -> (b, a)
fixSplitFraction (b
n,a
f) =
   --  if x>=0 || f==0
   if a
fa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
0
     then (b
n,   a
f)
     else (b
nb -> b -> b
forall a. C a => a -> a -> a
-b
1, a
fa -> a -> a
forall a. C a => a -> a -> a
+a
1)

{-# INLINE fixFraction #-}
fixFraction :: (Ring.C a, Ord a) => a -> a
fixFraction :: a -> a
fixFraction a
y =
   if a
ya -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
0 then a
y else a
ya -> a -> a
forall a. C a => a -> a -> a
+a
1

{-
mapM_ (\n -> let x = fromInteger n / 10 in print (x, floorInt GHC.double2Int GHC.int2Double x)) [-20,-19..20]
-}

{-# INLINE splitFractionInt #-}
splitFractionInt :: (Ring.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> (Int, a)
splitFractionInt :: (a -> Int) -> (Int -> a) -> a -> (Int, a)
splitFractionInt a -> Int
trunc Int -> a
toFloat a
x =
   let n :: Int
n = a -> Int
trunc a
x
   in  (Int, a) -> (Int, a)
forall a b. (C a, C b, Ord a) => (b, a) -> (b, a)
fixSplitFraction (Int
n, a
x a -> a -> a
forall a. C a => a -> a -> a
- Int -> a
toFloat Int
n)

{-# INLINE floorInt #-}
floorInt :: (Ring.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int
floorInt :: (a -> Int) -> (Int -> a) -> a -> Int
floorInt a -> Int
trunc Int -> a
toFloat a
x =
   let n :: Int
n = a -> Int
trunc a
x
   in  if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> a
toFloat Int
n
         then Int
n
         else Int -> Int
forall a. Enum a => a -> a
pred Int
n

{-# INLINE ceilingInt #-}
ceilingInt :: (Ring.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int
ceilingInt :: (a -> Int) -> (Int -> a) -> a -> Int
ceilingInt a -> Int
trunc Int -> a
toFloat a
x =
   let n :: Int
n = a -> Int
trunc a
x
   in  if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> a
toFloat Int
n
         then Int
n
         else Int -> Int
forall a. Enum a => a -> a
succ Int
n

{-# INLINE roundInt #-}
roundInt :: (Field.C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int
roundInt :: (a -> Int) -> (Int -> a) -> a -> Int
roundInt a -> Int
trunc Int -> a
toFloat a
x =
   let half :: a
half = a
0.5 -- P.fromRational
       halfUp :: a
halfUp = a
xa -> a -> a
forall a. C a => a -> a -> a
+a
half
       n :: Int
n = (a -> Int) -> (Int -> a) -> a -> Int
forall a. (C a, Ord a) => (a -> Int) -> (Int -> a) -> a -> Int
floorInt a -> Int
trunc Int -> a
toFloat a
halfUp
   in  if Int -> a
toFloat Int
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
halfUp  Bool -> Bool -> Bool
&&  Int -> Bool
forall a. Integral a => a -> Bool
P.odd Int
n
         then Int -> Int
forall a. Enum a => a -> a
pred Int
n
         else Int
n

{-# INLINE roundSimpleInt #-}
roundSimpleInt ::
   (Field.C a, Absolute.C a, Ord a) =>
   (a -> Int) -> (Int -> a) -> a -> Int
roundSimpleInt :: (a -> Int) -> (Int -> a) -> a -> Int
roundSimpleInt a -> Int
trunc Int -> a
_toFloat a
x =
   a -> Int
trunc (a
x a -> a -> a
forall a. C a => a -> a -> a
+ a -> a
forall a. C a => a -> a
Absolute.signum a
x a -> a -> a
forall a. C a => a -> a -> a
* a
0.5)



{- RULES maybe used, when Prelude implementations become more efficient
     "NP.round    :: Float -> Int"    round    = P.round    :: Float -> Int;
     "NP.truncate :: Float -> Int"    truncate = P.truncate :: Float -> Int;
     "NP.floor    :: Float -> Int"    floor    = P.floor    :: Float -> Int;
     "NP.ceiling  :: Float -> Int"    ceiling  = P.ceiling  :: Float -> Int;
     "NP.round    :: Double -> Int"   round    = P.round    :: Double -> Int;
     "NP.truncate :: Double -> Int"   truncate = P.truncate :: Double -> Int;
     "NP.floor    :: Double -> Int"   floor    = P.floor    :: Double -> Int;
     "NP.ceiling  :: Double -> Int"   ceiling  = P.ceiling  :: Double -> Int;
  -}

-- these rules will also be needed for Int16 et.al.
{-# RULES
     "NP.round       :: Float -> Int"    round    = roundInt       GHC.float2Int  GHC.int2Float;
     "NP.roundSimple :: Float -> Int"    round    = roundSimpleInt GHC.float2Int  GHC.int2Float;
     "NP.truncate    :: Float -> Int"    truncate =                GHC.float2Int               ;
     "NP.floor       :: Float -> Int"    floor    = floorInt       GHC.float2Int  GHC.int2Float;
     "NP.ceiling     :: Float -> Int"    ceiling  = ceilingInt     GHC.float2Int  GHC.int2Float;
     "NP.round       :: Double -> Int"   round    = roundInt       GHC.double2Int GHC.int2Double;
     "NP.roundSimple :: Double -> Int"   round    = roundSimpleInt GHC.double2Int GHC.int2Double;
     "NP.truncate    :: Double -> Int"   truncate =                GHC.double2Int               ;
     "NP.floor       :: Double -> Int"   floor    = floorInt       GHC.double2Int GHC.int2Double;
     "NP.ceiling     :: Double -> Int"   ceiling  = ceilingInt     GHC.double2Int GHC.int2Double;

     "NP.splitFraction :: Float ->  (Int, Float)"  splitFraction = splitFractionInt GHC.float2Int GHC.int2Float;
     "NP.splitFraction :: Double -> (Int, Double)" splitFraction = splitFractionInt GHC.double2Int GHC.int2Double;
  #-}

-- generated by GenerateRules.hs
{-# RULES
     "NP.round       :: a -> Int8"    round       = (P.fromIntegral :: Int -> Int8) . round;
     "NP.roundSimple :: a -> Int8"    roundSimple = (P.fromIntegral :: Int -> Int8) . roundSimple;
     "NP.truncate    :: a -> Int8"    truncate    = (P.fromIntegral :: Int -> Int8) . truncate;
     "NP.floor       :: a -> Int8"    floor       = (P.fromIntegral :: Int -> Int8) . floor;
     "NP.ceiling     :: a -> Int8"    ceiling     = (P.fromIntegral :: Int -> Int8) . ceiling;
     "NP.round       :: a -> Int16"   round       = (P.fromIntegral :: Int -> Int16) . round;
     "NP.roundSimple :: a -> Int16"   roundSimple = (P.fromIntegral :: Int -> Int16) . roundSimple;
     "NP.truncate    :: a -> Int16"   truncate    = (P.fromIntegral :: Int -> Int16) . truncate;
     "NP.floor       :: a -> Int16"   floor       = (P.fromIntegral :: Int -> Int16) . floor;
     "NP.ceiling     :: a -> Int16"   ceiling     = (P.fromIntegral :: Int -> Int16) . ceiling;
     "NP.round       :: a -> Int32"   round       = (P.fromIntegral :: Int -> Int32) . round;
     "NP.roundSimple :: a -> Int32"   roundSimple = (P.fromIntegral :: Int -> Int32) . roundSimple;
     "NP.truncate    :: a -> Int32"   truncate    = (P.fromIntegral :: Int -> Int32) . truncate;
     "NP.floor       :: a -> Int32"   floor       = (P.fromIntegral :: Int -> Int32) . floor;
     "NP.ceiling     :: a -> Int32"   ceiling     = (P.fromIntegral :: Int -> Int32) . ceiling;
     "NP.round       :: a -> Int64"   round       = (P.fromIntegral :: Int -> Int64) . round;
     "NP.roundSimple :: a -> Int64"   roundSimple = (P.fromIntegral :: Int -> Int64) . roundSimple;
     "NP.truncate    :: a -> Int64"   truncate    = (P.fromIntegral :: Int -> Int64) . truncate;
     "NP.floor       :: a -> Int64"   floor       = (P.fromIntegral :: Int -> Int64) . floor;
     "NP.ceiling     :: a -> Int64"   ceiling     = (P.fromIntegral :: Int -> Int64) . ceiling;
     "NP.round       :: a -> Word"    round       = (P.fromIntegral :: Int -> Word) . round;
     "NP.roundSimple :: a -> Word"    roundSimple = (P.fromIntegral :: Int -> Word) . roundSimple;
     "NP.truncate    :: a -> Word"    truncate    = (P.fromIntegral :: Int -> Word) . truncate;
     "NP.floor       :: a -> Word"    floor       = (P.fromIntegral :: Int -> Word) . floor;
     "NP.ceiling     :: a -> Word"    ceiling     = (P.fromIntegral :: Int -> Word) . ceiling;
     "NP.round       :: a -> Word8"   round       = (P.fromIntegral :: Int -> Word8) . round;
     "NP.roundSimple :: a -> Word8"   roundSimple = (P.fromIntegral :: Int -> Word8) . roundSimple;
     "NP.truncate    :: a -> Word8"   truncate    = (P.fromIntegral :: Int -> Word8) . truncate;
     "NP.floor       :: a -> Word8"   floor       = (P.fromIntegral :: Int -> Word8) . floor;
     "NP.ceiling     :: a -> Word8"   ceiling     = (P.fromIntegral :: Int -> Word8) . ceiling;
     "NP.round       :: a -> Word16"  round       = (P.fromIntegral :: Int -> Word16) . round;
     "NP.roundSimple :: a -> Word16"  roundSimple = (P.fromIntegral :: Int -> Word16) . roundSimple;
     "NP.truncate    :: a -> Word16"  truncate    = (P.fromIntegral :: Int -> Word16) . truncate;
     "NP.floor       :: a -> Word16"  floor       = (P.fromIntegral :: Int -> Word16) . floor;
     "NP.ceiling     :: a -> Word16"  ceiling     = (P.fromIntegral :: Int -> Word16) . ceiling;
     "NP.round       :: a -> Word32"  round       = (P.fromIntegral :: Int -> Word32) . round;
     "NP.roundSimple :: a -> Word32"  roundSimple = (P.fromIntegral :: Int -> Word32) . roundSimple;
     "NP.truncate    :: a -> Word32"  truncate    = (P.fromIntegral :: Int -> Word32) . truncate;
     "NP.floor       :: a -> Word32"  floor       = (P.fromIntegral :: Int -> Word32) . floor;
     "NP.ceiling     :: a -> Word32"  ceiling     = (P.fromIntegral :: Int -> Word32) . ceiling;
     "NP.round       :: a -> Word64"  round       = (P.fromIntegral :: Int -> Word64) . round;
     "NP.roundSimple :: a -> Word64"  roundSimple = (P.fromIntegral :: Int -> Word64) . roundSimple;
     "NP.truncate    :: a -> Word64"  truncate    = (P.fromIntegral :: Int -> Word64) . truncate;
     "NP.floor       :: a -> Word64"  floor       = (P.fromIntegral :: Int -> Word64) . floor;
     "NP.ceiling     :: a -> Word64"  ceiling     = (P.fromIntegral :: Int -> Word64) . ceiling;

     "NP.splitFraction :: a -> (Int8,a)"     splitFraction = mapFst (P.fromIntegral :: Int -> Int8) . splitFraction;
     "NP.splitFraction :: a -> (Int16,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Int16) . splitFraction;
     "NP.splitFraction :: a -> (Int32,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Int32) . splitFraction;
     "NP.splitFraction :: a -> (Int64,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Int64) . splitFraction;
     "NP.splitFraction :: a -> (Word,a)"     splitFraction = mapFst (P.fromIntegral :: Int -> Word) . splitFraction;
     "NP.splitFraction :: a -> (Word8,a)"    splitFraction = mapFst (P.fromIntegral :: Int -> Word8) . splitFraction;
     "NP.splitFraction :: a -> (Word16,a)"   splitFraction = mapFst (P.fromIntegral :: Int -> Word16) . splitFraction;
     "NP.splitFraction :: a -> (Word32,a)"   splitFraction = mapFst (P.fromIntegral :: Int -> Word32) . splitFraction;
     "NP.splitFraction :: a -> (Word64,a)"   splitFraction = mapFst (P.fromIntegral :: Int -> Word64) . splitFraction;
  #-}


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

approxRational :: (ToRational.C a, C a) => a -> a -> Rational
approxRational :: a -> a -> Rational
approxRational a
rat a
eps    =  a -> a -> Rational
forall a. C a => a -> a -> Rational
simplest (a
rata -> a -> a
forall a. C a => a -> a -> a
-a
eps) (a
rata -> a -> a
forall a. C a => a -> a -> a
+a
eps)
        where simplest :: a -> a -> Rational
simplest a
x a
y | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x      =  a -> a -> Rational
simplest a
y a
x
                           | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y     =  Rational
xr
                           | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0      =  Integer -> Integer -> Integer -> Integer -> Rational
forall a. C a => a -> a -> a -> a -> T a
simplest' Integer
n Integer
d Integer
n' Integer
d'
                           | a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0      =  - Integer -> Integer -> Integer -> Integer -> Rational
forall a. C a => a -> a -> a -> a -> T a
simplest' (-Integer
n') Integer
d' (-Integer
n) Integer
d
                           | Bool
otherwise  =  Integer
0 Integer -> Integer -> Rational
forall a. a -> a -> T a
:% Integer
1
                                        where xr :: Rational
xr@(Integer
n:%Integer
d) = a -> Rational
forall a. C a => a -> Rational
ToRational.toRational a
x
                                              (Integer
n':%Integer
d')  = a -> Rational
forall a. C a => a -> Rational
ToRational.toRational a
y

              simplest' :: a -> a -> a -> a -> T a
simplest' a
n a
d a
n' a
d'       -- assumes 0 < n%d < n'%d'
                        | a -> Bool
forall a. C a => a -> Bool
isZero a
r   =  a
q a -> a -> T a
forall a. a -> a -> T a
:% a
1
                        | a
q a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
q'    =  (a
qa -> a -> a
forall a. C a => a -> a -> a
+a
1) a -> a -> T a
forall a. a -> a -> T a
:% a
1
                        | Bool
otherwise  =  (a
qa -> a -> a
forall a. C a => a -> a -> a
*a
n''a -> a -> a
forall a. C a => a -> a -> a
+a
d'') a -> a -> T a
forall a. a -> a -> T a
:% a
n''
                                     where (a
q,a
r)      =  a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
quotRem a
n a
d
                                           (a
q',a
r')    =  a -> a -> (a, a)
forall a. C a => a -> a -> (a, a)
quotRem a
n' a
d'
                                           (a
n'':%a
d'') =  a -> a -> a -> a -> T a
simplest' a
d' a
r' a
d a
r


-- * generic implementation of round functions

powersOfTwo :: (Ring.C a) => [a]
powersOfTwo :: [a]
powersOfTwo = (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a
2a -> a -> a
forall a. C a => a -> a -> a
*) a
forall a. C a => a
one

pairsOfPowersOfTwo :: (Ring.C a, Ring.C b) => [(a,b)]
pairsOfPowersOfTwo :: [(a, b)]
pairsOfPowersOfTwo =
   [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
forall a. C a => [a]
powersOfTwo [b]
forall a. C a => [a]
powersOfTwo

{- |
The generic rounding functions need a number of operations
proportional to the number of binary digits of the integer portion.
If operations like multiplication with two and comparison
need time proportional to the number of binary digits,
then the overall rounding requires quadratic time.

prop> RealRing.genericFloor =~= (NP.floor :: Double -> Integer)
prop> RealRing.genericFloor =~= (NP.floor :: Rational -> Integer)
-}
genericFloor :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericFloor :: a -> b
genericFloor a
a =
   if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
forall a. C a => a
zero
     then a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosFloor a
a
     else b -> b
forall a. C a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosCeiling (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate a
a

{- |
prop> RealRing.genericCeiling =~= (NP.ceiling :: Double -> Integer)
prop> RealRing.genericCeiling =~= (NP.ceiling :: Rational -> Integer)
-}
genericCeiling :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericCeiling :: a -> b
genericCeiling a
a =
   if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
forall a. C a => a
zero
     then a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosCeiling a
a
     else b -> b
forall a. C a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosFloor (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate a
a

{- |
prop> RealRing.genericTruncate =~= (NP.truncate :: Double -> Integer)
prop> RealRing.genericTruncate =~= (NP.truncate :: Rational -> Integer)
-}
genericTruncate :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericTruncate :: a -> b
genericTruncate a
a =
   if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
forall a. C a => a
zero
     then a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosFloor a
a
     else b -> b
forall a. C a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosFloor (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate a
a

{- |
prop> RealRing.genericRound =~= (NP.round :: Double -> Integer)
prop> RealRing.genericRound =~= (NP.round :: Rational -> Integer)
-}
genericRound :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericRound :: a -> b
genericRound a
a =
   if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
forall a. C a => a
zero
     then a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosRound a
a
     else b -> b
forall a. C a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Ord a, C a, C b) => a -> b
genericPosRound (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate a
a

{- |
prop> RealRing.genericFraction =~= (NP.fraction :: Double -> Double)
prop> RealRing.genericFraction =~= (NP.fraction :: Rational -> Rational)
-}
genericFraction :: (Ord a, Ring.C a) => a -> a
genericFraction :: a -> a
genericFraction a
a =
   if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
forall a. C a => a
zero
     then a -> a
forall a. (Ord a, C a) => a -> a
genericPosFraction a
a
     else a -> a
forall a. (C a, Ord a) => a -> a
fixFraction (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. (Ord a, C a) => a -> a
genericPosFraction (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate a
a

{- |
prop> RealRing.genericSplitFraction =~= (NP.splitFraction :: Double -> (Integer,Double))
prop> RealRing.genericSplitFraction =~= (NP.splitFraction :: Rational -> (Integer,Rational))
-}
genericSplitFraction :: (Ord a, Ring.C a, Ring.C b) => a -> (b,a)
genericSplitFraction :: a -> (b, a)
genericSplitFraction a
a =
   if a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
forall a. C a => a
zero
     then a -> (b, a)
forall a b. (Ord a, C a, C b) => a -> (b, a)
genericPosSplitFraction a
a
     else (b, a) -> (b, a)
forall a b. (C a, C b, Ord a) => (b, a) -> (b, a)
fixSplitFraction ((b, a) -> (b, a)) -> (b, a) -> (b, a)
forall a b. (a -> b) -> a -> b
$ (b -> b, a -> a) -> (b, a) -> (b, a)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (b -> b
forall a. C a => a -> a
negate, a -> a
forall a. C a => a -> a
negate) ((b, a) -> (b, a)) -> (b, a) -> (b, a)
forall a b. (a -> b) -> a -> b
$
          a -> (b, a)
forall a b. (Ord a, C a, C b) => a -> (b, a)
genericPosSplitFraction (a -> (b, a)) -> a -> (b, a)
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. C a => a -> a
negate a
a


genericPosFloor :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericPosFloor :: a -> b
genericPosFloor a
a =
   (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$
   ((a, b) -> (a, b) -> (a, b)) -> (a, b) -> [(a, b)] -> (a, b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\(a
pa,b
pb) acc :: (a, b)
acc@(a
accA,b
accB) ->
         let newA :: a
newA = a
accAa -> a -> a
forall a. C a => a -> a -> a
+a
pa
         in  if a
newAa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
a then (a, b)
acc else (a
newA,b
accBb -> b -> b
forall a. C a => a -> a -> a
+b
pb))
      (a
forall a. C a => a
zero,b
forall a. C a => a
zero) ([(a, b)] -> (a, b)) -> [(a, b)] -> (a, b)
forall a b. (a -> b) -> a -> b
$
   ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$
   [(a, b)]
forall a b. (C a, C b) => [(a, b)]
pairsOfPowersOfTwo

genericPosCeiling :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericPosCeiling :: a -> b
genericPosCeiling a
a =
   (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$
   (\([(a, b)]
ps,(a, b)
u:[(a, b)]
_) ->
      ((a, b) -> (a, b) -> (a, b)) -> (a, b) -> [(a, b)] -> (a, b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
         (\(a
pa,b
pb) acc :: (a, b)
acc@(a
accA,b
accB) ->
            let newA :: a
newA = a
accAa -> a -> a
forall a. C a => a -> a -> a
-a
pa
            in  if a
newAa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
a then (a
newA,b
accBb -> b -> b
forall a. C a => a -> a -> a
-b
pb) else (a, b)
acc)
         (a, b)
u [(a, b)]
ps) (([(a, b)], [(a, b)]) -> (a, b)) -> ([(a, b)], [(a, b)]) -> (a, b)
forall a b. (a -> b) -> a -> b
$
   ((a, b) -> Bool) -> [(a, b)] -> ([(a, b)], [(a, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> ([(a, b)], [(a, b)]))
-> [(a, b)] -> ([(a, b)], [(a, b)])
forall a b. (a -> b) -> a -> b
$
   (a
forall a. C a => a
zero,b
forall a. C a => a
zero) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
forall a b. (C a, C b) => [(a, b)]
pairsOfPowersOfTwo

{-
genericPosFloorDigits :: (Ord a, Ring.C a, Ring.C b) => a -> ((a,b), [Bool])
genericPosFloorDigits a =
   List.mapAccumR
      (\acc@(accA,accB) (pa,pb) ->
         let newA = accA+pa
             b = newA<=a
         in  (if b then (newA,accB+pb) else acc, b))
      (zero,zero) $
   takeWhile ((a>=) . fst) $
   pairsOfPowersOfTwo
-}

genericHalfPosFloorDigits :: (Ord a, Ring.C a, Ring.C b) => a -> ((a,b), [Bool])
genericHalfPosFloorDigits :: a -> ((a, b), [Bool])
genericHalfPosFloorDigits a
a =
   ((a, b) -> (a, b) -> ((a, b), Bool))
-> (a, b) -> [(a, b)] -> ((a, b), [Bool])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
List.mapAccumR
      (\acc :: (a, b)
acc@(a
accA,b
accB) (a
pa,b
pb) ->
         let newA :: a
newA = a
accAa -> a -> a
forall a. C a => a -> a -> a
+a
pa
             b :: Bool
b = a
newAa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
a
         in  (if Bool
b then (a
newA,b
accBb -> b -> b
forall a. C a => a -> a -> a
+b
pb) else (a, b)
acc, Bool
b))
      (a
forall a. C a => a
zero,b
forall a. C a => a
zero) ([(a, b)] -> ((a, b), [Bool])) -> [(a, b)] -> ((a, b), [Bool])
forall a b. (a -> b) -> a -> b
$
   ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$
   [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
forall a. C a => [a]
powersOfTwo (b
forall a. C a => a
zerob -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
forall a. C a => [a]
powersOfTwo)

genericPosRound :: (Ord a, Ring.C a, Ring.C b) => a -> b
genericPosRound :: a -> b
genericPosRound a
a =
   let a2 :: a
a2 = a
2a -> a -> a
forall a. C a => a -> a -> a
*a
a
       ((a
ai,b
bi), [Bool]
ds) = a -> ((a, b), [Bool])
forall a b. (Ord a, C a, C b) => a -> ((a, b), [Bool])
genericHalfPosFloorDigits a
a2
   in  if a
aia -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
a2
         then
           case [Bool]
ds of
             Bool
True : Bool
True : [Bool]
_ -> b
bib -> b -> b
forall a. C a => a -> a -> a
+b
forall a. C a => a
one
             [Bool]
_ -> b
bi
         else
           case [Bool]
ds of
             Bool
True : [Bool]
_ -> b
bib -> b -> b
forall a. C a => a -> a -> a
+b
forall a. C a => a
one
             [Bool]
_ -> b
bi

genericPosFraction :: (Ord a, Ring.C a) => a -> a
genericPosFraction :: a -> a
genericPosFraction a
a =
   (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
p a
acc ->
         if a
pa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
acc then a
acc else a
acca -> a -> a
forall a. C a => a -> a -> a
-a
p)
      a
a ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
   (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$
   [a]
forall a. C a => [a]
powersOfTwo

genericPosSplitFraction :: (Ord a, Ring.C a, Ring.C b) => a -> (b,a)
genericPosSplitFraction :: a -> (b, a)
genericPosSplitFraction a
a =
   ((b, a) -> (b, a) -> (b, a)) -> (b, a) -> [(b, a)] -> (b, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\(b
pb,a
pa) acc :: (b, a)
acc@(b
accB,a
accA) ->
         if a
paa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
accA then (b, a)
acc else (b
accBb -> b -> b
forall a. C a => a -> a -> a
+b
pb,a
accAa -> a -> a
forall a. C a => a -> a -> a
-a
pa))
      (b
forall a. C a => a
zero,a
a) ([(b, a)] -> (b, a)) -> [(b, a)] -> (b, a)
forall a b. (a -> b) -> a -> b
$
   ((b, a) -> Bool) -> [(b, a)] -> [(b, a)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((a
aa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=) (a -> Bool) -> ((b, a) -> a) -> (b, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, a) -> a
forall a b. (a, b) -> b
snd) ([(b, a)] -> [(b, a)]) -> [(b, a)] -> [(b, a)]
forall a b. (a -> b) -> a -> b
$
   [(b, a)]
forall a b. (C a, C b) => [(a, b)]
pairsOfPowersOfTwo


{- |
Needs linear time with respect to the number of digits.

This and other functions using OrderDecision
like @floor@ where argument and result are the same
may be moved to a new module.
-}
decisionPosFraction :: (OrdDec.C a, Ring.C a) => a -> a
decisionPosFraction :: a -> a
decisionPosFraction a
a0 =
   (\[a]
ps ->
      (a -> (a -> a) -> a -> a) -> (a -> a) -> [a] -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
         (\a
p a -> a
cont a
a ->
            (a
aa -> a -> a -> a -> a
forall a. C a => a -> a -> a -> a -> a
<?a
forall a. C a => a
one) a
a (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
cont (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
            (a
aa -> a -> a -> a -> a
forall a. C a => a -> a -> a -> a -> a
>=?a
p) (a
aa -> a -> a
forall a. C a => a -> a -> a
-a
p) a
a)
         ([Char] -> a -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"decisionPosFraction: end of list should never be reached")
         [a]
ps a
a0) ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
   (Int -> [a]) -> [Int] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Int -> [a]) -> Int -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [a] -> [a]) -> [a] -> Int -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take [a]
forall a. C a => [a]
powersOfTwo) [Int]
forall a. C a => [a]
powersOfTwo

{-
Works but needs quadratic time with respect to the number of digits.
I feel that there must be something more efficient.
-}
decisionPosFractionSqrTime :: (OrdDec.C a, Ring.C a) => a -> a
decisionPosFractionSqrTime :: a -> a
decisionPosFractionSqrTime a
a0 =
   (\[a]
ps ->
      (a -> (a -> a) -> a -> a) -> (a -> a) -> [a] -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
         (\a
p a -> a
cont a
a ->
            (a
aa -> a -> a -> a -> a
forall a. C a => a -> a -> a -> a -> a
<?a
forall a. C a => a
one) a
a (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
cont (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
            (a
aa -> a -> a -> a -> a
forall a. C a => a -> a -> a -> a -> a
>=?a
p) (a
aa -> a -> a
forall a. C a => a -> a -> a
-a
p) a
a)
         ([Char] -> a -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"decisionPosFraction: end of list should never be reached")
         [a]
ps a
a0) ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$
   ([a] -> [a]) -> [[a]] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$
   [a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
forall a. C a => [a]
powersOfTwo