module Numeric.MixedTypes.Elementary
(
CanSqrt(..), CanSqrtSameType, CanSqrtCNSameType, specCanSqrtReal
, CanExp(..), CanExpSameType, specCanExpReal
, CanLog(..), CanLogSameType, CanLogCNSameType, 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.CollectErrors
import Control.CollectErrors
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 CanSqrtCNSameType t = (CanSqrt t, SqrtType t ~ EnsureCN 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
instance
(CanSqrt a
, CanEnsureCE es (SqrtType a)
, SuitableForCE es)
=>
CanSqrt (CollectErrors es a)
where
type SqrtType (CollectErrors es a) = EnsureCE es (SqrtType a)
sqrt = lift1CE sqrt
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),
HasEqCertainlyCN (ExpType t) (ExpType t),
HasOrderCertainly Integer t,
HasOrderCertainly Integer (ExpType t),
Show t, Arbitrary t, Show (ExpType t),
Show (EnsureCN t), Show (EnsureCN (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) ==>
(ensureCN $ 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
instance
(CanExp a
, CanEnsureCE es (ExpType a)
, SuitableForCE es)
=>
CanExp (CollectErrors es a)
where
type ExpType (CollectErrors es a) = EnsureCE es (ExpType a)
exp = lift1CE exp
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 CanLogCNSameType t = (CanLog t, LogType t ~ EnsureCN t)
type CanLogX t =
(CanLog t,
Field t,
Ring (LogType t),
HasOrderCertainly t Integer,
HasOrderCertainlyCN 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 (LogType t) (LogType (EnsureCN t)),
HasEqCertainlyCN 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
(CanLog a
, CanEnsureCE es (LogType a)
, SuitableForCE es)
=>
CanLog (CollectErrors es a)
where
type LogType (CollectErrors es a) = EnsureCE es (LogType a)
log = lift1CE log
instance CanPow Double Double where
pow = (P.**)
instance CanPow Double Rational where
type PowType Double Rational = Double
pow b e = b ^ (double e)
instance CanPow Rational Double where
type PowType Rational Double = Double
pow b e = (double b) ^ e
instance CanPow Integer Double where
type PowType Integer Double = Double
pow b e = (double b) ^ e
instance CanPow Int Double where
type PowType Int Double = Double
pow b e = (double b) ^ e
powUsingExpLog ::
(CanTestPosNeg t,
CanEnsureCN t,
CanEnsureCN (EnsureCN t),
EnsureCN t ~ EnsureCN (EnsureCN t),
CanLogCNSameType t,
CanMulSameType t,
CanMulSameType (EnsureCN t),
CanExpSameType (EnsureCN t),
CanTestInteger t,
HasIntegers t,
CanTestZero t,
CanRecipCNSameType t,
HasIntegers (EnsureCN t))
=>
t -> t -> EnsureCN t
powUsingExpLog b e =
case certainlyIntegerGetIt e of
Just n ->
powUsingMulRecip b n
Nothing
| isCertainlyZero b && isCertainlyPositive e -> convertExactly 0
| isCertainlyNonNegative b -> exp ((log b) * (ensureCN e))
| isCertainlyNegative b && certainlyNotInteger e -> noValueNumErrorCertainECN (Just b) err
| otherwise -> noValueNumErrorPotentialECN (Just b) err
where
err = NumError "powUsingExpLog: 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),
HasOrderCertainlyCN (SinCosType t) t,
Show t, Arbitrary t, Show (SinCosType t),
Show (EnsureCN t), Arbitrary t, Show (EnsureCN (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 .&&. (ensureCN 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
instance
(CanSinCos a
, CanEnsureCE es (SinCosType a)
, SuitableForCE es)
=>
CanSinCos (CollectErrors es a)
where
type SinCosType (CollectErrors es a) = EnsureCE es (SinCosType a)
sin = lift1CE sin
cos = lift1CE cos
approxPi :: (P.Floating t) => t
approxPi = P.pi