{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
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.CollectErrors ( CN )
import qualified Numeric.CollectErrors as CN
import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
import Numeric.MixedTypes.MinMaxAbs
import Numeric.MixedTypes.AddSub
import Numeric.MixedTypes.Ring
import Numeric.MixedTypes.Field
import Numeric.MixedTypes.Power
import Utils.Test.EnforceRange
class CanSqrt t where
type SqrtType t
type SqrtType t = t
sqrt :: t -> SqrtType t
default sqrt :: (SqrtType t ~ t, P.Floating t) => t -> SqrtType t
sqrt = t -> SqrtType t
forall a. Floating a => a -> a
P.sqrt
type CanSqrtSameType t = (CanSqrt t, SqrtType t ~ t)
specCanSqrtReal ::
_ => T t -> Spec
specCanSqrtReal :: T t -> Spec
specCanSqrtReal (T String
typeName :: T t) =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanSqrt %s" String
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sqrt(x) >= 0" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative t
x Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(t -> SqrtType t
forall t. CanSqrt t => t -> SqrtType t
sqrt t
x) SqrtType t -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?>=?$ Integer
0
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sqrt(x)^2 = x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative t
x Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(t -> SqrtType t
forall t. CanSqrt t => t -> SqrtType t
sqrt t
x)SqrtType t -> Integer -> PowType (SqrtType t) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 PowType (SqrtType t) Integer -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t
x
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
infix 4 ?>=?$
(?>=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?>=?$ :: a -> b -> Property
(?>=?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?>=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?>=?)
instance CanSqrt Double
instance
(CanSqrt a, CanTestPosNeg a, CanMinMaxThis a Integer)
=>
CanSqrt (CN a)
where
type SqrtType (CN a) = CN (SqrtType a)
sqrt :: CN a -> SqrtType (CN a)
sqrt CN a
x
| CN a -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative CN a
x = (a -> SqrtType a) -> CN a -> CollectErrors NumErrors (SqrtType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CN.lift a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt CN a
x
| CN a -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative CN a
x = CollectErrors NumErrors (SqrtType a)
-> NumError -> CollectErrors NumErrors (SqrtType a)
forall t. CN t -> NumError -> CN t
CN.removeValueErrorCertain CollectErrors NumErrors (SqrtType a)
sqrtx NumError
err
| Bool
otherwise = NumError
-> CollectErrors NumErrors (SqrtType a)
-> CollectErrors NumErrors (SqrtType a)
forall t. NumError -> CN t -> CN t
CN.prependErrorPotential NumError
err CollectErrors NumErrors (SqrtType a)
sqrtx
where
sqrtx :: CollectErrors NumErrors (SqrtType a)
sqrtx = (a -> SqrtType a) -> CN a -> CollectErrors NumErrors (SqrtType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CN.lift a -> SqrtType a
forall t. CanSqrt t => t -> SqrtType t
sqrt (CN a -> CollectErrors NumErrors (SqrtType a))
-> CN a -> CollectErrors NumErrors (SqrtType a)
forall a b. (a -> b) -> a -> b
$ CN a -> Integer -> MinMaxType (CN a) Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max CN a
x Integer
0
err :: CN.NumError
err :: NumError
err = String -> NumError
CN.OutOfDomain String
"negative sqrt argument"
class CanExp t where
type ExpType t
type ExpType t = t
exp :: t -> ExpType t
default exp :: (ExpType t ~ t, P.Floating t) => t -> ExpType t
exp = t -> ExpType t
forall a. Floating a => a -> a
P.exp
type CanExpSameType t = (CanExp t, ExpType t ~ t)
specCanExpReal ::
_ => T t -> Spec
specCanExpReal :: T t -> Spec
specCanExpReal (T String
typeName :: T t) =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanExp %s" String
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"exp(x) >= 0" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x_ :: t) ->
let x :: t
x = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
100000), Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
100000) t
x_ in
t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp t
x ExpType t -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?>=?$ Integer
0
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"exp(-x) == 1/(exp x)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x_ :: t) ->
let x :: t
x = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
100000), Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
100000) t
x_ in
let ex :: ExpType t
ex = t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp t
x in
(ExpType t
ex ExpType t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(NegType t -> ExpType (NegType t)
forall t. CanExp t => t -> ExpType t
exp (-t
x)) ExpType (NegType t) -> DivType Integer (ExpType t) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ Integer
1Integer -> ExpType t -> DivType Integer (ExpType t)
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ExpType t
ex
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"exp(x+y) = exp(x)*exp(y)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x_ :: t) (t
y_ :: t) ->
let x :: t
x = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
100000), Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
100000) t
x_ in
let y :: t
y = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
100000), Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
100000) t
y_ in
(t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp (t -> ExpType t) -> t -> ExpType t
forall a b. (a -> b) -> a -> b
$ t
x t -> t -> AddType t t
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t
y) ExpType t -> MulType (ExpType t) (ExpType t) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp t
x) ExpType t -> ExpType t -> MulType (ExpType t) (ExpType t)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp t
y)
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
infix 4 ?>=?$
(?>=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?>=?$ :: a -> b -> Property
(?>=?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?>=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?>=?)
instance CanExp Double
instance
(CanExp a) => CanExp (CN a)
where
type ExpType (CN a) = CN (ExpType a)
exp :: CN a -> ExpType (CN a)
exp = (a -> ExpType a) -> CN a -> CollectErrors NumErrors (ExpType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CN.lift a -> ExpType a
forall t. CanExp t => t -> ExpType t
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 -> LogType t
log = t -> LogType t
forall a. Floating a => a -> a
P.log
type CanLogSameType t = (CanLog t, LogType t ~ t)
specCanLogReal ::
_ => T t -> Spec
specCanLogReal :: T t -> Spec
specCanLogReal (T String
typeName :: T t) =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanLog %s" String
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"log(1/x) == -(log x)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x_ :: t) ->
let x :: t
x = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0, Maybe Integer
forall a. Maybe a
Nothing) t
x_ in
t
x t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (Integer
1Integer -> t -> DivType Integer t
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/t
x) DivType Integer t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
DivType Integer t -> LogType (DivType Integer t)
forall t. CanLog t => t -> LogType t
log (Integer
1Integer -> t -> DivType Integer t
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/t
x) LogType (DivType Integer t) -> NegType (LogType t) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ -(t -> LogType t
forall t. CanLog t => t -> LogType t
log t
x)
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"log(x*y) = log(x)+log(y)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x_ :: t) (t
y_ :: t) ->
let x :: t
x = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0, Maybe Integer
forall a. Maybe a
Nothing) t
x_ in
let y :: t
y = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0, Maybe Integer
forall a. Maybe a
Nothing) t
y_ in
t
x t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
y t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
xt -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*t
y MulType t t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(MulType t t -> LogType (MulType t t)
forall t. CanLog t => t -> LogType t
log (MulType t t -> LogType (MulType t t))
-> MulType t t -> LogType (MulType t t)
forall a b. (a -> b) -> a -> b
$ t
x t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
y) LogType (MulType t t)
-> AddType (LogType t) (LogType t) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> LogType t
forall t. CanLog t => t -> LogType t
log t
x) LogType t -> LogType t -> AddType (LogType t) (LogType t)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t -> LogType t
forall t. CanLog t => t -> LogType t
log t
y)
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"log(exp x) == x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x_ :: t) ->
let x :: t
x = (Maybe Integer, Maybe Integer) -> t -> t
forall t b. CanEnforceRange t b => (Maybe b, Maybe b) -> t -> t
enforceRange (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
1000), Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
10000) t
x_ in
let ex :: ExpType t
ex = t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp t
x in
(ExpType t
ex ExpType t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
ExpType t -> LogType (ExpType t)
forall t. CanLog t => t -> LogType t
log ExpType t
ex LogType (ExpType t) -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t
x
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
instance CanLog Double
instance
(CanLog a, CanTestPosNeg a)
=>
CanLog (CN a)
where
type LogType (CN a) = CN (LogType a)
log :: CN a -> LogType (CN a)
log CN a
x
| CN a -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive CN a
x = CollectErrors NumErrors (LogType a)
LogType (CN a)
logx
| CN a -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonPositive CN a
x = CollectErrors NumErrors (LogType a)
-> NumError -> CollectErrors NumErrors (LogType a)
forall t. CN t -> NumError -> CN t
CN.removeValueErrorCertain CollectErrors NumErrors (LogType a)
logx NumError
err
| Bool
otherwise = CollectErrors NumErrors (LogType a)
-> NumError -> CollectErrors NumErrors (LogType a)
forall t. CN t -> NumError -> CN t
CN.removeValueErrorPotential CollectErrors NumErrors (LogType a)
logx NumError
err
where
logx :: CollectErrors NumErrors (LogType a)
logx = (a -> LogType a) -> CN a -> CollectErrors NumErrors (LogType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CN.lift a -> LogType a
forall t. CanLog t => t -> LogType t
log CN a
x
err :: CN.NumError
err :: NumError
err = String -> NumError
CN.OutOfDomain String
"log argument not positive"
powUsingExpLog ::
(CanLogSameType t,
CanExpSameType t,
CanMulSameType t,
CanTestInteger t,
CanTestZero t,
CanRecipSameType t)
=>
t -> t -> t -> t
powUsingExpLog :: t -> t -> t -> t
powUsingExpLog t
one t
b t
e =
case t -> Maybe Integer
forall t. CanTestInteger t => t -> Maybe Integer
certainlyIntegerGetIt t
e of
Just Integer
n ->
t -> t -> Integer -> t
forall e b.
(CanBeInteger e, CanMulSameType b, CanRecipSameType b) =>
b -> b -> e -> b
powUsingMulRecip t
one t
b Integer
n
Maybe Integer
Nothing ->
t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp ((t -> LogType t
forall t. CanLog t => t -> LogType t
log t
b) t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t
e))
class CanSinCos t where
type SinCosType t
type SinCosType t = t
cos :: t -> SinCosType t
default cos :: (SinCosType t ~ t, P.Floating t) => t -> SinCosType t
cos = t -> SinCosType t
forall a. Floating a => a -> a
P.cos
sin :: t -> SinCosType t
default sin :: (SinCosType t ~ t, P.Floating t) => t -> SinCosType t
sin = t -> SinCosType t
forall a. Floating a => a -> a
P.sin
type CanSinCosSameType t = (CanSinCos t, SinCosType t ~ t)
specCanSinCosReal ::
_ => T t -> Spec
specCanSinCosReal :: T t -> Spec
specCanSinCosReal (T String
typeName :: T t) =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanSinCos %s" String
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"-1 <= sin(x) <= 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
(-Integer
1) Integer -> SinCosType t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x) SinCosType t -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ Integer
1
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"-1 <= cos(x) <= 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
(-Integer
1) Integer -> SinCosType t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x) SinCosType t -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ Integer
1
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"cos(x)^2 + sin(x)^2 = 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x)SinCosType t -> Integer -> PowType (SinCosType t) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 PowType (SinCosType t) Integer
-> PowType (SinCosType t) Integer
-> AddType
(PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x)SinCosType t -> Integer -> PowType (SinCosType t) Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
2 AddType
(PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)
-> Integer -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ Integer
1
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sin(x-y) = sin(x)cos(y) - cos(x)sin(y)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) (t
y :: t) ->
(SubType t t -> SinCosType (SubType t t)
forall t. CanSinCos t => t -> SinCosType t
sin (SubType t t -> SinCosType (SubType t t))
-> SubType t t -> SinCosType (SubType t t)
forall a b. (a -> b) -> a -> b
$ t
x t -> t -> SubType t t
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- t
y) SinCosType (SubType t t)
-> SubType
(MulType (SinCosType t) (SinCosType t))
(MulType (SinCosType t) (SinCosType t))
-> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x)SinCosType t
-> SinCosType t -> MulType (SinCosType t) (SinCosType t)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
y) MulType (SinCosType t) (SinCosType t)
-> MulType (SinCosType t) (SinCosType t)
-> SubType
(MulType (SinCosType t) (SinCosType t))
(MulType (SinCosType t) (SinCosType t))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x)SinCosType t
-> SinCosType t -> MulType (SinCosType t) (SinCosType t)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
y)
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"cos(x-y) = cos(x)cos(y) + sin(x)sin(y)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) (t
y :: t) ->
(SubType t t -> SinCosType (SubType t t)
forall t. CanSinCos t => t -> SinCosType t
cos (SubType t t -> SinCosType (SubType t t))
-> SubType t t -> SinCosType (SubType t t)
forall a b. (a -> b) -> a -> b
$ t
x t -> t -> SubType t t
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- t
y) SinCosType (SubType t t)
-> AddType
(MulType (SinCosType t) (SinCosType t))
(MulType (SinCosType t) (SinCosType t))
-> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x)SinCosType t
-> SinCosType t -> MulType (SinCosType t) (SinCosType t)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
y) MulType (SinCosType t) (SinCosType t)
-> MulType (SinCosType t) (SinCosType t)
-> AddType
(MulType (SinCosType t) (SinCosType t))
(MulType (SinCosType t) (SinCosType t))
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x)SinCosType t
-> SinCosType t -> MulType (SinCosType t) (SinCosType t)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
y)
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"sin(x) < x < tan(x) for x in [0,pi/2]" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t
x t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>=! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
x t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Rational
1.57 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x) SinCosType t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x) SinCosType t -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
x Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
x) t -> DivType (SinCosType t) (SinCosType t) -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ (t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin t
x)SinCosType t
-> SinCosType t -> DivType (SinCosType t) (SinCosType t)
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/(t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos t
x)
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
infix 4 ?<=?$
(?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?<=?$ :: a -> b -> Property
(?<=?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?<=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
instance CanSinCos Double
instance
(CanSinCos a) => CanSinCos (CN a)
where
type SinCosType (CN a) = CN (SinCosType a)
sin :: CN a -> SinCosType (CN a)
sin = (a -> SinCosType a)
-> CN a -> CollectErrors NumErrors (SinCosType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CN.lift a -> SinCosType a
forall t. CanSinCos t => t -> SinCosType t
sin
cos :: CN a -> SinCosType (CN a)
cos = (a -> SinCosType a)
-> CN a -> CollectErrors NumErrors (SinCosType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CN.lift a -> SinCosType a
forall t. CanSinCos t => t -> SinCosType t
cos
approxPi :: (P.Floating t) => t
approxPi :: t
approxPi = t
forall a. Floating a => a
P.pi