{-# LANGUAGE RebindableSyntax #-}
module Number.FixedPoint.Check where

import qualified Number.FixedPoint as FP

import qualified MathObj.PowerSeries.Example as PSE

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Algebraic      as Algebraic
import qualified Algebra.RealRing      as RealRing
import qualified Algebra.Field          as Field
import qualified Algebra.Absolute           as Absolute
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive
import qualified Algebra.ZeroTestable   as ZeroTestable

import NumericPrelude.Base
import NumericPrelude.Numeric   hiding (fromRational')

import qualified Prelude        as P98
import qualified NumericPrelude.Numeric as NP


{- * Types -}

data T = Cons {T -> Integer
denominator :: Integer, T -> Integer
numerator :: Integer}


{- * Conversion -}

cons :: Integer -> Integer -> T
cons :: Integer -> Integer -> T
cons = Integer -> Integer -> T
Cons

{- ** other number types -}

fromFloat :: RealRing.C a => Integer -> a -> T
fromFloat :: Integer -> a -> T
fromFloat Integer
den a
x =
   Integer -> Integer -> T
cons Integer
den (Integer -> a -> Integer
forall a. C a => Integer -> a -> Integer
FP.fromFloat Integer
den a
x)

fromInteger' :: Integer -> Integer -> T
fromInteger' :: Integer -> Integer -> T
fromInteger' Integer
den Integer
x =
   Integer -> Integer -> T
cons Integer
den (Integer
x Integer -> Integer -> Integer
forall a. C a => a -> a -> a
* Integer
den)

fromRational' :: Integer -> Rational -> T
fromRational' :: Integer -> Rational -> T
fromRational' Integer
den Rational
x =
   Integer -> Integer -> T
cons Integer
den (Rational -> Integer
forall a b. (C a, C b) => a -> b
round (Rational
x Rational -> Rational -> Rational
forall a. C a => a -> a -> a
* Integer -> Rational
forall a. C a => Integer -> a
NP.fromInteger Integer
den))

fromFloatBasis :: RealRing.C a => Integer -> Int -> a -> T
fromFloatBasis :: Integer -> Int -> a -> T
fromFloatBasis Integer
basis Int
numDigits =
   Integer -> a -> T
forall a. C a => Integer -> a -> T
fromFloat (Int -> Integer -> Integer
forall a b. (C a, C b) => b -> a -> a
ringPower Int
numDigits Integer
basis)

fromIntegerBasis :: Integer -> Int -> Integer -> T
fromIntegerBasis :: Integer -> Int -> Integer -> T
fromIntegerBasis Integer
basis Int
numDigits =
   Integer -> Integer -> T
fromInteger' (Int -> Integer -> Integer
forall a b. (C a, C b) => b -> a -> a
ringPower Int
numDigits Integer
basis)

fromRationalBasis :: Integer -> Int -> Rational -> T
fromRationalBasis :: Integer -> Int -> Rational -> T
fromRationalBasis Integer
basis Int
numDigits =
   Integer -> Rational -> T
fromRational' (Int -> Integer -> Integer
forall a b. (C a, C b) => b -> a -> a
ringPower Int
numDigits Integer
basis)

-- | denominator conversion
fromFixedPoint :: Integer -> T -> T
fromFixedPoint :: Integer -> T -> T
fromFixedPoint Integer
denDst (Cons Integer
denSrc Integer
x) =
   Integer -> Integer -> T
cons Integer
denDst (Integer -> Integer -> Integer -> Integer
FP.fromFixedPoint Integer
denDst Integer
denSrc Integer
x)


{- * Lift core function -}

lift0 :: Integer -> (Integer -> Integer) -> T
lift0 :: Integer -> (Integer -> Integer) -> T
lift0 Integer
den Integer -> Integer
f = Integer -> Integer -> T
Cons Integer
den (Integer -> Integer
f Integer
den)

lift1 :: (Integer -> Integer -> Integer) -> (T -> T)
lift1 :: (Integer -> Integer -> Integer) -> T -> T
lift1 Integer -> Integer -> Integer
f (Cons Integer
xd Integer
xn) = Integer -> Integer -> T
Cons Integer
xd (Integer -> Integer -> Integer
f Integer
xd Integer
xn)

lift2 :: (Integer -> Integer -> Integer -> Integer) -> (T -> T -> T)
lift2 :: (Integer -> Integer -> Integer -> Integer) -> T -> T -> T
lift2 Integer -> Integer -> Integer -> Integer
f (Cons Integer
xd Integer
xn) (Cons Integer
yd Integer
yn) =
   Integer -> Integer -> T -> T
forall a. Integer -> Integer -> a -> a
commonDenominator Integer
xd Integer
yd (T -> T) -> T -> T
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> T
Cons Integer
xd (Integer -> Integer -> Integer -> Integer
f Integer
xd Integer
xn Integer
yn)

commonDenominator :: Integer -> Integer -> a -> a
commonDenominator :: Integer -> Integer -> a -> a
commonDenominator Integer
xd Integer
yd a
z =
   if Integer
xd Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
yd
     then a
z
     else [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Number.FixedPoint: denominators differ"


{- * Show -}

appPrec :: Int
appPrec :: Int
appPrec  = Int
10

instance Show T where
  showsPrec :: Int -> T -> ShowS
showsPrec Int
p (Cons Integer
den Integer
num) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec)
       ([Char] -> ShowS
showString [Char]
"FixedPoint.cons " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
den
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
num)


defltDenominator :: Integer
defltDenominator :: Integer
defltDenominator = Integer
10Integer -> Integer -> Integer
forall a. C a => a -> Integer -> a
^Integer
100

defltShow :: T -> String
defltShow :: T -> [Char]
defltShow (Cons Integer
den Integer
x) =
   Integer -> Integer -> [Char]
FP.showPositionalDec Integer
den Integer
x



instance Additive.C T where
   zero :: T
zero   = Integer -> Integer -> T
cons Integer
defltDenominator Integer
forall a. C a => a
zero
   + :: T -> T -> T
(+)    = (Integer -> Integer -> Integer -> Integer) -> T -> T -> T
lift2 Integer -> Integer -> Integer -> Integer
FP.add
   (-)    = (Integer -> Integer -> Integer -> Integer) -> T -> T -> T
lift2 Integer -> Integer -> Integer -> Integer
FP.sub
   negate :: T -> T
negate (Cons Integer
xd Integer
xn) = Integer -> Integer -> T
Cons Integer
xd (Integer -> Integer
forall a. C a => a -> a
negate Integer
xn)


instance Ring.C T where
   one :: T
one         = Integer -> Integer -> T
cons Integer
defltDenominator Integer
defltDenominator
   fromInteger :: Integer -> T
fromInteger = Integer -> Integer -> T
fromInteger' Integer
defltDenominator (Integer -> T) -> (Integer -> Integer) -> Integer -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. C a => Integer -> a
NP.fromInteger
   * :: T -> T -> T
(*)         = (Integer -> Integer -> Integer -> Integer) -> T -> T -> T
lift2 Integer -> Integer -> Integer -> Integer
FP.mul
   -- the default instance of (^) cumulates rounding errors but is faster
   -- x^n           = lift1 (pow n) x


instance Field.C T where
   / :: T -> T -> T
(/)   = (Integer -> Integer -> Integer -> Integer) -> T -> T -> T
lift2 Integer -> Integer -> Integer -> Integer
FP.divide
   recip :: T -> T
recip = (Integer -> Integer -> Integer) -> T -> T
lift1 Integer -> Integer -> Integer
FP.recip
   fromRational' :: Rational -> T
fromRational' = Integer -> Rational -> T
fromRational' Integer
defltDenominator (Rational -> T) -> (Rational -> Rational) -> Rational -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. C a => Rational -> a
NP.fromRational'


instance Algebraic.C T where
   sqrt :: T -> T
sqrt   = (Integer -> Integer -> Integer) -> T -> T
lift1 Integer -> Integer -> Integer
FP.sqrt
   root :: Integer -> T -> T
root Integer
n = (Integer -> Integer -> Integer) -> T -> T
lift1 (Integer -> Integer -> Integer -> Integer
FP.root Integer
n)


-- these function are only implemented for the convergence radius of their Taylor expansions
instance Trans.C T where
   pi :: T
pi    = Integer -> (Integer -> Integer) -> T
lift0 Integer
defltDenominator Integer -> Integer
FP.piConst
   exp :: T -> T
exp   = (Integer -> Integer -> Integer) -> T -> T
lift1 Integer -> Integer -> Integer
FP.exp
   log :: T -> T
log   = (Integer -> Integer -> Integer) -> T -> T
lift1 Integer -> Integer -> Integer
FP.ln
   {-
   logBase
   (**)
   -}
   sin :: T -> T
sin   = (Integer -> Integer -> Integer) -> T -> T
lift1 ([Rational] -> Integer -> Integer -> Integer
FP.evalPowerSeries [Rational]
forall a. C a => [a]
PSE.sin)
   cos :: T -> T
cos   = (Integer -> Integer -> Integer) -> T -> T
lift1 ([Rational] -> Integer -> Integer -> Integer
FP.evalPowerSeries [Rational]
forall a. C a => [a]
PSE.cos)
   -- tan   = lift1 (FP.evalPowerSeries PSE.tan)
   asin :: T -> T
asin  = (Integer -> Integer -> Integer) -> T -> T
lift1 ([Rational] -> Integer -> Integer -> Integer
FP.evalPowerSeries [Rational]
forall a. C a => [a]
PSE.asin)
   atan :: T -> T
atan  = (Integer -> Integer -> Integer) -> T -> T
lift1 Integer -> Integer -> Integer
FP.arctan
   {-
   acos  = lift1 (FP.evalPowerSeries PSE.acos)
   sinh  = lift1 (FP.evalPowerSeries PSE.sinh)
   tanh  = lift1 (FP.evalPowerSeries PSE.tanh)
   cosh  = lift1 (FP.evalPowerSeries PSE.cosh)
   asinh = lift1 (FP.evalPowerSeries PSE.asinh)
   atanh = lift1 (FP.evalPowerSeries PSE.atanh)
   acosh = lift1 (FP.evalPowerSeries PSE.acosh)
   -}


instance ZeroTestable.C T where
   isZero :: T -> Bool
isZero (Cons Integer
_ Integer
xn)  =  Integer -> Bool
forall a. C a => a -> Bool
isZero Integer
xn

instance Eq T where
   (Cons Integer
xd Integer
xn) == :: T -> T -> Bool
== (Cons Integer
yd Integer
yn) =
      Integer -> Integer -> Bool -> Bool
forall a. Integer -> Integer -> a -> a
commonDenominator Integer
xd Integer
yd (Integer
xnInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
yn)

instance Ord T where
   compare :: T -> T -> Ordering
compare (Cons Integer
xd Integer
xn) (Cons Integer
yd Integer
yn) =
      Integer -> Integer -> Ordering -> Ordering
forall a. Integer -> Integer -> a -> a
commonDenominator Integer
xd Integer
yd (Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
xn Integer
yn)

instance Absolute.C T where
   abs :: T -> T
abs = (Integer -> Integer -> Integer) -> T -> T
lift1 ((Integer -> Integer) -> Integer -> Integer -> Integer
forall a b. a -> b -> a
const Integer -> Integer
forall a. C a => a -> a
abs)
   signum :: T -> T
signum = T -> T
forall a. (C a, Ord a) => a -> a
Absolute.signumOrd

instance RealRing.C T where
   splitFraction :: T -> (b, T)
splitFraction (Cons Integer
xd Integer
xn) =
      let (Integer
int, Integer
frac) = Integer -> Integer -> (Integer, Integer)
forall a. C a => a -> a -> (a, a)
divMod Integer
xd Integer
xn
      in  (Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
int, Integer -> Integer -> T
Cons Integer
xd Integer
frac)



-- legacy instances for use of numeric literals in GHCi
instance P98.Num T where
   fromInteger :: Integer -> T
fromInteger = Integer -> Integer -> T
fromInteger' Integer
defltDenominator
   negate :: T -> T
negate = T -> T
forall a. C a => a -> a
negate -- for unary minus
   + :: T -> T -> T
(+)    = T -> T -> T
forall a. C a => a -> a -> a
(+)
   * :: T -> T -> T
(*)    = T -> T -> T
forall a. C a => a -> a -> a
(*)
   abs :: T -> T
abs    = T -> T
forall a. C a => a -> a
abs
   signum :: T -> T
signum = T -> T
forall a. C a => a -> a
signum

instance P98.Fractional T where
   fromRational :: Rational -> T
fromRational = Integer -> Rational -> T
fromRational' Integer
defltDenominator (Rational -> T) -> (Rational -> Rational) -> Rational -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. C a => Rational -> a
fromRational
   / :: T -> T -> T
(/) = T -> T -> T
forall a. C a => a -> a -> a
(/)