module Numeric.MixedTypes.Elementary
(
CanSqrt(..), CanSqrtSameType, specCanSqrtReal
, CanExp(..), CanExpSameType, specCanExpReal
, CanLog(..), CanLogSameType, specCanLogReal
, powUsingExpLog
, CanSinCos(..), CanSinCosSameType, specCanSinCosReal
, approxPi
)
where
import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf
import Test.Hspec
import Test.QuickCheck
import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
import Numeric.MixedTypes.AddSub
import Numeric.MixedTypes.Ring
import Numeric.MixedTypes.Field
class CanSqrt t where
type SqrtType t
type SqrtType t = t
sqrt :: t -> SqrtType t
default sqrt :: (SqrtType t ~ t, P.Floating t) => t -> t
sqrt = P.sqrt
type CanSqrtSameType t = (CanSqrt t, SqrtType t ~ t)
type CanSqrtX t =
(CanSqrt t,
CanTestPosNeg t,
HasEqCertainly t (SqrtType t),
HasOrderCertainly Integer (SqrtType t),
Show t, Arbitrary t, Show (SqrtType t))
specCanSqrtReal ::
(CanSqrtX t,
CanPowX (SqrtType t) Integer,
HasEqCertainly t (PowType (SqrtType t) Integer))
=>
T t -> Spec
specCanSqrtReal (T typeName :: T t) =
describe (printf "CanSqrt %s" typeName) $ do
it "sqrt(x) >= 0" $ do
property $ \ (x :: t) ->
isCertainlyNonNegative x ==>
(sqrt x) ?>=?$ 0
it "sqrt(x)^2 = x" $ do
property $ \ (x :: t) ->
isCertainlyNonNegative x ==>
(sqrt x)^2 ?==?$ x
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?==?$) = printArgsIfFails2 "?==?" (?==?)
infix 4 ?>=?$
(?>=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?>=?$) = printArgsIfFails2 "?>=?" (?>=?)
instance CanSqrt Double
class CanExp t where
type ExpType t
type ExpType t = t
exp :: t -> ExpType t
default exp :: (ExpType t ~ t, P.Floating t) => t -> t
exp = P.exp
type CanExpSameType t = (CanExp t, ExpType t ~ t)
type CanExpX t =
(CanExp t,
Ring t,
Field (ExpType t),
CanTestPosNeg t,
CanTestPosNeg (ExpType t),
HasEqCertainly (ExpType t) (ExpType t),
HasOrderCertainly Integer t,
HasOrderCertainly Integer (ExpType t),
Show t, Arbitrary t, Show (ExpType t))
specCanExpReal ::
(CanExpX t)
=>
T t -> Spec
specCanExpReal (T typeName :: T t) =
describe (printf "CanExp %s" typeName) $ do
it "exp(x) >= 0" $ do
property $ \ (x :: t) ->
((100000) !<! x && x !<! 100000) ==>
exp x ?>=?$ 0
it "exp(-x) == 1/(exp x)" $ do
property $ \ (x :: t) ->
((100000) !<! x && x !<! 100000) ==>
(exp x !>! 0) ==>
exp (x) ?==?$ 1/(exp x)
it "exp(x+y) = exp(x)*exp(y)" $ do
property $ \ (x :: t) (y :: t) ->
((100000) !<! x && x !<! 100000 && (100000) !<! y && y !<! 100000) ==>
(exp $ x + y) ?==?$ (exp x) * (exp y)
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?==?$) = printArgsIfFails2 "?==?" (?==?)
infix 4 ?>=?$
(?>=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?>=?$) = printArgsIfFails2 "?>=?" (?>=?)
instance CanExp Double
class CanLog t where
type LogType t
type LogType t = t
log :: t -> LogType t
default log :: (LogType t ~ t, P.Floating t) => t -> t
log = P.log
type CanLogSameType t = (CanLog t, LogType t ~ t)
type CanLogX t =
(CanLog t,
Field t,
Ring (LogType t),
HasOrderCertainly t Integer,
HasEqCertainly (LogType t) (LogType t),
Show t, Arbitrary t, Show (LogType t))
specCanLogReal ::
(CanLogX t,
CanLogX (DivType Integer t),
CanExp t, CanLogX (ExpType t),
HasEqCertainly t (LogType (ExpType t)))
=>
T t -> Spec
specCanLogReal (T typeName :: T t) =
describe (printf "CanLog %s" typeName) $ do
it "log(1/x) == -(log x)" $ do
property $ \ (x :: t) ->
x !>! 0 && (1/x) !>! 0 ==>
log (1/x) ?==?$ (log x)
it "log(x*y) = log(x)+log(y)" $ do
property $ \ (x :: t) (y :: t) ->
x !>! 0 && y !>! 0 && x*y !>! 0 ==>
(log $ x * y) ?==?$ (log x) + (log y)
it "log(exp x) == x" $ do
property $ \ (x :: t) ->
((100000) !<! x && x !<! 100000) ==>
log (exp x) ?==?$ x
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?==?$) = printArgsIfFails2 "?==?" (?==?)
instance CanLog Double
instance CanPow Double Double where
pow = (P.**)
instance CanPow Double Rational where
type PowType Double Rational = Double
pow x y = x ^ (double y)
instance CanPow Rational Double where
type PowType Rational Double = Double
pow x y = (double x) ^ y
instance CanPow Integer Double where
type PowType Integer Double = Double
pow x y = (double x) ^ y
instance CanPow Int Double where
type PowType Int Double = Double
pow x y = (double x) ^ y
powUsingExpLog ::
(CanTestPosNeg t1,
CanMulSameType t1,
HasIntegers t1,
CanTestZero t1,
CanRecipSameType t1,
CanTestInteger t2,
CanTestPosNeg t2,
CanMulAsymmetric (LogType t1) t2,
CanLog t1,
CanExp (MulType (LogType t1) t2),
ExpType (MulType (LogType t1) t2) ~ t1)
=>
t1 -> t2 -> ExpType (MulType (LogType t1) t2)
powUsingExpLog x y
| isCertainlyPositive x = exp ((log x) * y)
| otherwise =
case certainlyIntegerGetIt y of
Just n ->
powUsingMulRecip x n
Nothing ->
if isCertainlyZero x && isCertainlyPositive y then convertExactly 0
else
error $ "powUsingExpLog: potential illegal power a^b with negative a and non-integer b"
class CanSinCos t where
type SinCosType t
type SinCosType t = t
cos :: t -> SinCosType t
default cos :: (SinCosType t ~ t, P.Floating t) => t -> t
cos = P.cos
sin :: t -> SinCosType t
default sin :: (SinCosType t ~ t, P.Floating t) => t -> t
sin = P.sin
type CanSinCosSameType t = (CanSinCos t, SinCosType t ~ t)
type CanSinCosX t =
(CanSinCos t,
OrderedCertainlyField t,
OrderedCertainlyField (SinCosType t),
HasOrderCertainly (SinCosType t) t,
Show t, Arbitrary t, Show (SinCosType t))
specCanSinCosReal ::
(CanSinCosX t)
=>
T t -> Spec
specCanSinCosReal (T typeName :: T t) =
describe (printf "CanSinCos %s" typeName) $ do
it "-1 <= sin(x) <= 1" $ do
property $ \ (x :: t) ->
(1) ?<=?$ (sin x) .&&. (sin x) ?<=?$ 1
it "-1 <= cos(x) <= 1" $ do
property $ \ (x :: t) ->
(1) ?<=?$ (cos x) .&&. (cos x) ?<=?$ 1
it "cos(x)^2 + sin(x)^2 = 1" $ do
property $ \ (x :: t) ->
(sin x)^2 + (cos x)^2 ?==?$ 1
it "sin(x-y) = sin(x)cos(y) - cos(x)sin(y)" $ do
property $ \ (x :: t) (y :: t) ->
(sin $ x y) ?==?$ (sin x)*(cos y) (cos x)*(sin y)
it "cos(x-y) = cos(x)cos(y) + sin(x)sin(y)" $ do
property $ \ (x :: t) (y :: t) ->
(cos $ x y) ?==?$ (cos x)*(cos y) + (sin x)*(sin y)
it "sin(x) < x < tan(x) for x in [0,pi/2]" $ do
property $ \ (x :: t) ->
x !>=! 0 && x !<=! 1.57 && (cos x) !>! 0 ==>
(sin x) ?<=?$ x .&&. x ?<=?$ (sin x)/(cos x)
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?==?$) = printArgsIfFails2 "?==?" (?==?)
infix 4 ?<=?$
(?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
(?<=?$) = printArgsIfFails2 "?<=?" (?<=?)
instance CanSinCos Double
approxPi :: (P.Floating t) => t
approxPi = P.pi