{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-|
    Module      :  Numeric.MixedType.Elementary
    Description :  Bottom-up typed pi, sqrt, cos, etc
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

-}
module Numeric.MixedTypes.Elementary
(
  -- * Square root
  CanSqrt(..), CanSqrtSameType, specCanSqrtReal
  -- * Exp
  , CanExp(..), CanExpSameType, specCanExpReal
  -- * Log
  , CanLog(..), CanLogSameType, specCanLogReal
  , powUsingExpLog
  -- * Sine and cosine
  , CanSinCos(..), CanSinCosSameType, specCanSinCosReal
  , approxPi
)
where

import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf

-- import qualified Data.List as List

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.Mul
import Numeric.MixedTypes.Field
import Numeric.MixedTypes.Power
-- import Numeric.MixedTypes.Round

import Utils.Test.EnforceRange 

{----  sqrt -----}

{-|
  A replacement for Prelude's `P.sqrt`.  If @Floating t@,
  then one can use the default implementation to mirror Prelude's @sqrt@.
-}
class CanSqrt t where
  type SqrtType t
  type SqrtType t = t -- default
  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)

{-|
  HSpec properties that each implementation of CanSqrt should satisfy.
 -}
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
(?>=?)

{-
  Instances for Integer, Rational etc need an algebraic real or exact real type.
  Such type is not provided in this package. See eg aern2-real.
-}

instance CanSqrt Double -- not exact, will not pass the tests

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"


{----  exp -----}

{-|
  A replacement for Prelude's `P.exp`.  If @Floating t@,
  then one can use the default implementation to mirror Prelude's @exp@.
-}
class CanExp t where
  type ExpType t
  type ExpType t = t -- default
  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)

{-|
  HSpec properties that each implementation of CanExp should satisfy.
 -}
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
(?>=?)

{-
  Instances for Integer, Rational etc need an algebraic real or exact real type.
  Such type is not provided in this package. See eg aern2-real.
-}

instance CanExp Double -- not exact, will not pass the tests

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

{----  log -----}

{-|
  A replacement for Prelude's `P.log`.  If @Floating t@,
  then one can use the default implementation to mirror Prelude's @log@.
-}
class CanLog t where
  type LogType t
  type LogType t = t -- default
  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)

{-|
  HSpec properties that each implementation of CanLog should satisfy.
 -}
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
(?==?)

{-
  Instances for Integer, Rational etc need an algebraic real or exact real type.
  Such type is not provided in this package. See eg aern2-real.
-}

instance CanLog Double -- not exact, will not pass the tests

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,
   CanTestInteger t,
   CanTestZero t)
  =>
   t -> (t -> t -> t) -> (t -> t) -> t -> t -> t
powUsingExpLog :: t -> (t -> t -> t) -> (t -> t) -> t -> t -> t
powUsingExpLog t
one t -> t -> t
mul' t -> t
recip' t
b t
e =
  case t -> Maybe Integer
forall t. CanTestInteger t => t -> Maybe Integer
certainlyIntegerGetIt t
e of
    Just Integer
n ->
      t -> (t -> t -> t) -> (t -> t) -> t -> Integer -> t
forall e t.
CanBeInteger e =>
t -> (t -> t -> t) -> (t -> t) -> t -> e -> t
powUsingMulRecip t
one t -> t -> t
mul' t -> t
recip' 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 -> t
`mul'` (t
e))

{----  sine and cosine -----}

{-|
  A replacement for Prelude's `P.cos` and `P.sin`.  If @Floating t@,
  then one can use the default implementation to mirror Prelude's @sin@, @cos@.
-}
class CanSinCos t where
  type SinCosType t
  type SinCosType t = t -- default
  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)

{-|
  HSpec properties that each implementation of CanSinCos should satisfy.

  Derived partially from
  http://math.stackexchange.com/questions/1303044/axiomatic-definition-of-sin-and-cos
 -}
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
(?<=?)

{-
  Instances for Integer, Rational etc need an algebraic real or exact real type.
  Such type is not provided in this package. See eg aern2-real.
-}

instance CanSinCos Double -- not exact, will not pass the tests

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

{-|
  Approximate pi, synonym for Prelude's `P.pi`.

  We do not define (exect) @pi@ in this package as we have no type
  that can represent it exactly.
-}
approxPi :: (P.Floating t) => t
approxPi :: t
approxPi = t
forall a. Floating a => a
P.pi