Copyright | (c) Michal Konecny |
---|---|
License | BSD3 |
Maintainer | mikkonecny@gmail.com |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
Numeric.MixedTypes.Elementary
Description
Synopsis
- class CanSqrt t where
- type CanSqrtSameType t = (CanSqrt t, SqrtType t ~ t)
- type CanSqrtCNSameType t = (CanSqrt t, SqrtType t ~ EnsureCN t)
- specCanSqrtReal :: (Show t, Show (SqrtType t), Show (PowType (SqrtType t) Integer), Arbitrary t, CanTestCertainly (OrderCompareType (SqrtType t) Integer), CanTestCertainly (EqCompareType (PowType (SqrtType t) Integer) t), HasEqAsymmetric (PowType (SqrtType t) Integer) t, HasOrderAsymmetric (SqrtType t) Integer, CanTestPosNeg t, CanPow (SqrtType t) Integer, CanSqrt t) => T t -> Spec
- class CanExp t where
- type CanExpSameType t = (CanExp t, ExpType t ~ t)
- specCanExpReal :: (Show t, Show (ExpType t), Show (DivType Integer (ExpType t)), Show (ExpType (AddType t t)), Show (MulType (ExpType t) (ExpType t)), Show (EnsureCN (ExpType t)), Arbitrary t, CanEnsureCN (ExpType t), CanTestCertainly (OrderCompareType Integer t), CanTestCertainly (OrderCompareType t Integer), CanTestCertainly (OrderCompareType (ExpType t) Integer), CanTestCertainly (EqCompareType (EnsureCN (ExpType t)) (DivType Integer (ExpType t))), CanTestCertainly (EqCompareType (ExpType (AddType t t)) (MulType (ExpType t) (ExpType t))), CanNeg t, HasEqAsymmetric (ExpType (AddType t t)) (MulType (ExpType t) (ExpType t)), HasEqAsymmetric (EnsureCN (ExpType t)) (DivType Integer (ExpType t)), HasOrderAsymmetric t Integer, HasOrderAsymmetric (ExpType t) Integer, HasOrderAsymmetric Integer t, CanAddAsymmetric t t, CanMulAsymmetric (ExpType t) (ExpType t), CanDiv Integer (ExpType t), CanExp t, CanExp (AddType t t), NegType t ~ t, CanEnforceRange t Integer) => T t -> Spec
- class CanLog t where
- type CanLogSameType t = (CanLog t, LogType t ~ t)
- type CanLogCNSameType t = (CanLog t, LogType t ~ EnsureCN t)
- specCanLogReal :: (Show t, Show (LogType t), Show (LogType (DivType Integer t)), Show (LogType (MulType t t)), Show (AddType (LogType t) (LogType t)), Show (LogType (ExpType t)), Arbitrary t, CanTestCertainly (OrderCompareType t Integer), CanTestCertainly (OrderCompareType (DivType Integer t) Integer), CanTestCertainly (EqCompareType (LogType (DivType Integer t)) (LogType t)), CanTestCertainly (OrderCompareType (MulType t t) Integer), CanTestCertainly (OrderCompareType (ExpType t) Integer), CanTestCertainly (EqCompareType (LogType (MulType t t)) (AddType (LogType t) (LogType t))), CanTestCertainly (OrderCompareType Integer t), CanTestCertainly (EqCompareType (LogType (ExpType t)) t), CanNeg (LogType t), HasEqAsymmetric (LogType (DivType Integer t)) (LogType t), HasEqAsymmetric (LogType (MulType t t)) (AddType (LogType t) (LogType t)), HasEqAsymmetric (LogType (ExpType t)) t, HasOrderAsymmetric t Integer, HasOrderAsymmetric (DivType Integer t) Integer, HasOrderAsymmetric (MulType t t) Integer, HasOrderAsymmetric (ExpType t) Integer, HasOrderAsymmetric Integer t, CanAddAsymmetric (LogType t) (LogType t), CanMulAsymmetric t t, CanDiv Integer t, CanExp t, CanLog t, CanLog (DivType Integer t), CanLog (MulType t t), CanLog (ExpType t), LogType t ~ NegType (LogType t), CanEnforceRange t Integer) => T t -> Spec
- 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, CanTestZero t, CanRecipCNSameType t) => t -> t -> t -> t -> EnsureCN t
- class CanSinCos t where
- type SinCosType t
- cos :: t -> SinCosType t
- sin :: t -> SinCosType t
- type CanSinCosSameType t = (CanSinCos t, SinCosType t ~ t)
- specCanSinCosReal :: (Show t, Show (SinCosType t), Show (AddType (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)), Show (SinCosType (SubType t t)), Show (SubType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), Show (AddType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), Show (DivType (SinCosType t) (SinCosType t)), Show (EnsureCN t), Arbitrary t, CanEnsureCN t, CanTestCertainly (OrderCompareType Integer (SinCosType t)), CanTestCertainly (OrderCompareType (SinCosType t) Integer), CanTestCertainly (EqCompareType (AddType (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)) Integer), CanTestCertainly (EqCompareType (SinCosType (SubType t t)) (SubType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)))), CanTestCertainly (EqCompareType (SinCosType (SubType t t)) (AddType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)))), CanTestCertainly (OrderCompareType t Integer), CanTestCertainly (OrderCompareType t Rational), CanTestCertainly (OrderCompareType (SinCosType t) t), CanTestCertainly (OrderCompareType (EnsureCN t) (DivType (SinCosType t) (SinCosType t))), HasEqAsymmetric (AddType (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)) Integer, HasEqAsymmetric (SinCosType (SubType t t)) (SubType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), HasEqAsymmetric (SinCosType (SubType t t)) (AddType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), HasOrderAsymmetric t Integer, HasOrderAsymmetric t Rational, HasOrderAsymmetric (SinCosType t) t, HasOrderAsymmetric (SinCosType t) Integer, HasOrderAsymmetric (EnsureCN t) (DivType (SinCosType t) (SinCosType t)), HasOrderAsymmetric Integer (SinCosType t), CanSub t t, CanSub (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)), CanAddAsymmetric (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer), CanAddAsymmetric (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)), CanPow (SinCosType t) Integer, CanMulAsymmetric (SinCosType t) (SinCosType t), CanDiv (SinCosType t) (SinCosType t), CanSinCos t, CanSinCos (SubType t t)) => T t -> Spec
- approxPi :: Floating t => t
Square root
class CanSqrt t where Source #
A replacement for Prelude's sqrt
. If Floating t
,
then one can use the default implementation to mirror Prelude's sqrt
.
Minimal complete definition
Nothing
Methods
Instances
CanSqrt Double Source # | |
(CanSqrt a, CanEnsureCE es a, CanEnsureCE es (SqrtType a), SuitableForCE es) => CanSqrt (CollectErrors es a) Source # | |
Defined in Numeric.MixedTypes.Elementary Associated Types type SqrtType (CollectErrors es a) Source # Methods sqrt :: CollectErrors es a -> SqrtType (CollectErrors es a) Source # |
type CanSqrtSameType t = (CanSqrt t, SqrtType t ~ t) Source #
specCanSqrtReal :: (Show t, Show (SqrtType t), Show (PowType (SqrtType t) Integer), Arbitrary t, CanTestCertainly (OrderCompareType (SqrtType t) Integer), CanTestCertainly (EqCompareType (PowType (SqrtType t) Integer) t), HasEqAsymmetric (PowType (SqrtType t) Integer) t, HasOrderAsymmetric (SqrtType t) Integer, CanTestPosNeg t, CanPow (SqrtType t) Integer, CanSqrt t) => T t -> Spec Source #
HSpec properties that each implementation of CanSqrt should satisfy.
Exp
A replacement for Prelude's exp
. If Floating t
,
then one can use the default implementation to mirror Prelude's exp
.
Minimal complete definition
Nothing
Methods
Instances
CanExp Double Source # | |
(CanExp t, CanSinCos t, CanMulAsymmetric (ExpType t) (SinCosType t)) => CanExp (Complex t) Source # | |
(CanExp a, CanEnsureCE es a, CanEnsureCE es (ExpType a), SuitableForCE es) => CanExp (CollectErrors es a) Source # | |
Defined in Numeric.MixedTypes.Elementary Associated Types type ExpType (CollectErrors es a) Source # Methods exp :: CollectErrors es a -> ExpType (CollectErrors es a) Source # |
type CanExpSameType t = (CanExp t, ExpType t ~ t) Source #
specCanExpReal :: (Show t, Show (ExpType t), Show (DivType Integer (ExpType t)), Show (ExpType (AddType t t)), Show (MulType (ExpType t) (ExpType t)), Show (EnsureCN (ExpType t)), Arbitrary t, CanEnsureCN (ExpType t), CanTestCertainly (OrderCompareType Integer t), CanTestCertainly (OrderCompareType t Integer), CanTestCertainly (OrderCompareType (ExpType t) Integer), CanTestCertainly (EqCompareType (EnsureCN (ExpType t)) (DivType Integer (ExpType t))), CanTestCertainly (EqCompareType (ExpType (AddType t t)) (MulType (ExpType t) (ExpType t))), CanNeg t, HasEqAsymmetric (ExpType (AddType t t)) (MulType (ExpType t) (ExpType t)), HasEqAsymmetric (EnsureCN (ExpType t)) (DivType Integer (ExpType t)), HasOrderAsymmetric t Integer, HasOrderAsymmetric (ExpType t) Integer, HasOrderAsymmetric Integer t, CanAddAsymmetric t t, CanMulAsymmetric (ExpType t) (ExpType t), CanDiv Integer (ExpType t), CanExp t, CanExp (AddType t t), NegType t ~ t, CanEnforceRange t Integer) => T t -> Spec Source #
HSpec properties that each implementation of CanExp should satisfy.
Log
A replacement for Prelude's log
. If Floating t
,
then one can use the default implementation to mirror Prelude's log
.
Minimal complete definition
Nothing
Methods
Instances
CanLog Double Source # | |
(CanLog a, CanEnsureCE es a, CanEnsureCE es (LogType a), SuitableForCE es) => CanLog (CollectErrors es a) Source # | |
Defined in Numeric.MixedTypes.Elementary Associated Types type LogType (CollectErrors es a) Source # Methods log :: CollectErrors es a -> LogType (CollectErrors es a) Source # |
type CanLogSameType t = (CanLog t, LogType t ~ t) Source #
specCanLogReal :: (Show t, Show (LogType t), Show (LogType (DivType Integer t)), Show (LogType (MulType t t)), Show (AddType (LogType t) (LogType t)), Show (LogType (ExpType t)), Arbitrary t, CanTestCertainly (OrderCompareType t Integer), CanTestCertainly (OrderCompareType (DivType Integer t) Integer), CanTestCertainly (EqCompareType (LogType (DivType Integer t)) (LogType t)), CanTestCertainly (OrderCompareType (MulType t t) Integer), CanTestCertainly (OrderCompareType (ExpType t) Integer), CanTestCertainly (EqCompareType (LogType (MulType t t)) (AddType (LogType t) (LogType t))), CanTestCertainly (OrderCompareType Integer t), CanTestCertainly (EqCompareType (LogType (ExpType t)) t), CanNeg (LogType t), HasEqAsymmetric (LogType (DivType Integer t)) (LogType t), HasEqAsymmetric (LogType (MulType t t)) (AddType (LogType t) (LogType t)), HasEqAsymmetric (LogType (ExpType t)) t, HasOrderAsymmetric t Integer, HasOrderAsymmetric (DivType Integer t) Integer, HasOrderAsymmetric (MulType t t) Integer, HasOrderAsymmetric (ExpType t) Integer, HasOrderAsymmetric Integer t, CanAddAsymmetric (LogType t) (LogType t), CanMulAsymmetric t t, CanDiv Integer t, CanExp t, CanLog t, CanLog (DivType Integer t), CanLog (MulType t t), CanLog (ExpType t), LogType t ~ NegType (LogType t), CanEnforceRange t Integer) => T t -> Spec Source #
HSpec properties that each implementation of CanLog should satisfy.
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, CanTestZero t, CanRecipCNSameType t) => t -> t -> t -> t -> EnsureCN t Source #
Sine and cosine
class CanSinCos t where Source #
A replacement for Prelude's cos
and sin
. If Floating t
,
then one can use the default implementation to mirror Prelude's sin
, cos
.
Minimal complete definition
Nothing
Methods
cos :: t -> SinCosType t Source #
default cos :: (SinCosType t ~ t, Floating t) => t -> SinCosType t Source #
sin :: t -> SinCosType t Source #
default sin :: (SinCosType t ~ t, Floating t) => t -> SinCosType t Source #
Instances
CanSinCos Double Source # | |
Defined in Numeric.MixedTypes.Elementary Associated Types type SinCosType Double Source # | |
(CanSinCos a, CanEnsureCE es a, CanEnsureCE es (SinCosType a), SuitableForCE es) => CanSinCos (CollectErrors es a) Source # | |
Defined in Numeric.MixedTypes.Elementary Associated Types type SinCosType (CollectErrors es a) Source # Methods cos :: CollectErrors es a -> SinCosType (CollectErrors es a) Source # sin :: CollectErrors es a -> SinCosType (CollectErrors es a) Source # |
type CanSinCosSameType t = (CanSinCos t, SinCosType t ~ t) Source #
specCanSinCosReal :: (Show t, Show (SinCosType t), Show (AddType (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)), Show (SinCosType (SubType t t)), Show (SubType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), Show (AddType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), Show (DivType (SinCosType t) (SinCosType t)), Show (EnsureCN t), Arbitrary t, CanEnsureCN t, CanTestCertainly (OrderCompareType Integer (SinCosType t)), CanTestCertainly (OrderCompareType (SinCosType t) Integer), CanTestCertainly (EqCompareType (AddType (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)) Integer), CanTestCertainly (EqCompareType (SinCosType (SubType t t)) (SubType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)))), CanTestCertainly (EqCompareType (SinCosType (SubType t t)) (AddType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)))), CanTestCertainly (OrderCompareType t Integer), CanTestCertainly (OrderCompareType t Rational), CanTestCertainly (OrderCompareType (SinCosType t) t), CanTestCertainly (OrderCompareType (EnsureCN t) (DivType (SinCosType t) (SinCosType t))), HasEqAsymmetric (AddType (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer)) Integer, HasEqAsymmetric (SinCosType (SubType t t)) (SubType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), HasEqAsymmetric (SinCosType (SubType t t)) (AddType (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t))), HasOrderAsymmetric t Integer, HasOrderAsymmetric t Rational, HasOrderAsymmetric (SinCosType t) t, HasOrderAsymmetric (SinCosType t) Integer, HasOrderAsymmetric (EnsureCN t) (DivType (SinCosType t) (SinCosType t)), HasOrderAsymmetric Integer (SinCosType t), CanSub t t, CanSub (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)), CanAddAsymmetric (PowType (SinCosType t) Integer) (PowType (SinCosType t) Integer), CanAddAsymmetric (MulType (SinCosType t) (SinCosType t)) (MulType (SinCosType t) (SinCosType t)), CanPow (SinCosType t) Integer, CanMulAsymmetric (SinCosType t) (SinCosType t), CanDiv (SinCosType t) (SinCosType t), CanSinCos t, CanSinCos (SubType t t)) => T t -> Spec Source #
HSpec properties that each implementation of CanSinCos should satisfy.
Derived partially from http://math.stackexchange.com/questions/1303044/axiomatic-definition-of-sin-and-cos
approxPi :: Floating t => t Source #
Approximate pi, synonym for Prelude's pi
.
We do not define (exect) pi
in this package as we have no type
that can represent it exactly.