{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Numeric.MixedTypes.Power
(
CanPow(..), CanPowBy
, (^), (^^)
, powUsingMul, integerPowCN
, powUsingMulRecip
, CanTestIsIntegerType(..)
, specCanPow
)
where
import Utils.TH.DeclForTypes
import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf
import Test.Hspec
import Test.QuickCheck
import Numeric.CollectErrors ( CN, cn, unCN )
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.AddSub
import Numeric.MixedTypes.Mul
infixl 8 ^, ^^
(^) :: (CanPow t1 t2) => t1 -> t2 -> PowType t1 t2
^ :: forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
(^) = forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
pow
(^^) :: (CanPow t1 t2) => t1 -> t2 -> PPowType t1 t2
^^ :: forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PPowType t1 t2
(^^) = forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PPowType t1 t2
ppow
class CanPow b e where
type PowType b e
type PPowType b e
type PPowType b e = PowType b e
type PowType b e = b
pow :: b -> e -> PowType b e
ppow :: b -> e -> PPowType b e
default ppow :: (PPowType b e ~ PowType b e) => b -> e -> PPowType b e
ppow = forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
pow
class CanTestIsIntegerType t where
isIntegerType :: t -> Bool
isIntegerType t
_ = Bool
False
instance CanTestIsIntegerType t => CanTestIsIntegerType (CN t) where
isIntegerType :: CN t -> Bool
isIntegerType CN t
t = forall t. CanTestIsIntegerType t => t -> Bool
isIntegerType (forall p. CN p -> p
unCN CN t
t)
instance CanTestIsIntegerType Int where
isIntegerType :: Int -> Bool
isIntegerType Int
_ = Bool
True
instance CanTestIsIntegerType Integer where
isIntegerType :: Integer -> Bool
isIntegerType Integer
_ = Bool
True
instance CanTestIsIntegerType Rational
instance CanTestIsIntegerType Double
integerPowCN ::
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, HasEqCertainly e Integer)
=>
(b -> e -> r) -> CN b -> CN e -> CN r
integerPowCN :: forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, HasEqCertainly e Integer) =>
(b -> e -> r) -> CN b -> CN e -> CN r
integerPowCN b -> e -> r
unsafeIntegerPow CN b
b CN e
n
| CN e
n forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: negative exponent"
| CN e
n forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN b
b forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: 0^0"
| CN e
n forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<? Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: negative exponent"
| CN e
n forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN b
b forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorPotential forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: 0^0"
| Bool
otherwise =
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CN.lift2 b -> e -> r
unsafeIntegerPow CN b
b CN e
n
powCN ::
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestIsIntegerType b, CanTestIsIntegerType e, CanTestInteger e)
=>
(b -> e -> r) -> CN b -> CN e -> CN r
powCN :: forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestIsIntegerType b,
CanTestIsIntegerType e, CanTestInteger e) =>
(b -> e -> r) -> CN b -> CN e -> CN r
powCN b -> e -> r
unsafePow CN b
b CN e
e
| forall t. CanTestIsIntegerType t => t -> Bool
isIntegerType CN b
b forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& forall t. CanTestIsIntegerType t => t -> Bool
isIntegerType CN e
e forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN e
e forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: negative exponent, consider using ppow or (^^)"
| Bool
otherwise = forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestInteger e) =>
(b -> e -> r) -> CN b -> CN e -> CN r
ppowCN b -> e -> r
unsafePow CN b
b CN e
e
ppowCN ::
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestInteger e)
=>
(b -> e -> r) -> CN b -> CN e -> CN r
ppowCN :: forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestInteger e) =>
(b -> e -> r) -> CN b -> CN e -> CN r
ppowCN b -> e -> r
unsafePow CN b
b CN e
e
| CN b
b forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN e
e forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal pow: 0^e with e <= 0"
| CN b
b forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& forall t. CanTestInteger t => t -> Bool
certainlyNotInteger CN e
e =
forall v. NumError -> CN v
CN.noValueNumErrorCertain forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal pow: b^e with b < 0 and e non-integer"
| CN b
b forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN e
e forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<=? Integer
0 =
forall v. NumError -> CN v
CN.noValueNumErrorPotential forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal pow: 0^e with e <= 0"
| CN b
b forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<? Integer
0 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& forall t. CanNeg t => t -> NegType t
not (forall t. CanTestInteger t => t -> Bool
certainlyInteger CN e
e) =
forall v. NumError -> CN v
CN.noValueNumErrorPotential forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal pow: b^e with b < 0 and e non-integer"
| Bool
otherwise =
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CN.lift2 b -> e -> r
unsafePow CN b
b CN e
e
powUsingMul ::
(CanBeInteger e)
=>
t -> (t -> t -> t) -> t -> e -> t
powUsingMul :: forall e t. CanBeInteger e => t -> (t -> t -> t) -> t -> e -> t
powUsingMul t
one t -> t -> t
mul' t
x e
nPre
| Integer
n forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"powUsingMul is not defined for negative exponent " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n
| Integer
n forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = t
one
| Bool
otherwise = Integer -> t
aux Integer
n
where
.* :: t -> t -> t
(.*) = t -> t -> t
mul'
n :: Integer
n = forall t. CanBeInteger t => t -> Integer
integer e
nPre
aux :: Integer -> t
aux Integer
m
| Integer
m forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1 = t
x
| forall a. Integral a => a -> Bool
even Integer
m =
let s :: t
s = Integer -> t
aux (Integer
m forall a. Integral a => a -> a -> a
`P.div` Integer
2) in t
s t -> t -> t
.* t
s
| Bool
otherwise =
let s :: t
s = Integer -> t
aux ((Integer
mforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1) forall a. Integral a => a -> a -> a
`P.div` Integer
2) in t
x t -> t -> t
.* t
s t -> t -> t
.* t
s
powUsingMulRecip ::
(CanBeInteger e)
=>
t -> (t -> t -> t) -> (t -> t) -> t -> e -> t
powUsingMulRecip :: 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
x e
e
| Integer
eI forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 = t -> t
recip' forall a b. (a -> b) -> a -> b
$ forall e t. CanBeInteger e => t -> (t -> t -> t) -> t -> e -> t
powUsingMul t
one t -> t -> t
mul' t
x (forall t. CanNeg t => t -> NegType t
negate Integer
eI)
| Bool
otherwise = forall e t. CanBeInteger e => t -> (t -> t -> t) -> t -> e -> t
powUsingMul t
one t -> t -> t
mul' t
x Integer
eI
where
eI :: Integer
eI = forall t. CanBeInteger t => t -> Integer
integer e
e
type CanPowBy t1 t2 =
(CanPow t1 t2, PowType t1 t2 ~ t1)
specCanPow ::
_ => T t1 -> T t2 -> Spec
specCanPow :: T t1 -> T t2 -> Spec
specCanPow (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) =
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanPow %s %s" String
typeName1 String
typeName2) forall a b. (a -> b) -> a -> b
$ do
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^0 = 1" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
let one :: t1
one = (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in
let z :: t2
z = (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t2) in
(t1
x forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ t2
z) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
one
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^1 = x" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
let one :: t2
one = (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t2) in
(t1
x forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ t2
one) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^(y+1) = x*x^y" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) ->
(forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative t2
y) forall prop. Testable prop => Bool -> prop -> Property
==>
t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t1
x forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ t2
y) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t1
x forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ (t2
y forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1))
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?==?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
instance CanPow Integer Integer where
type PowType Integer Integer = Integer
type PPowType Integer Integer = Rational
pow :: Integer -> Integer -> PowType Integer Integer
pow Integer
b = forall a b. (Num a, Integral b) => a -> b -> a
(P.^) Integer
b
ppow :: Integer -> Integer -> PPowType Integer Integer
ppow Integer
b = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanPow Integer Int where
type PowType Integer Int = Integer
type PPowType Integer Int = Rational
pow :: Integer -> Int -> PowType Integer Int
pow Integer
b = forall a b. (Num a, Integral b) => a -> b -> a
(P.^) Integer
b
ppow :: Integer -> Int -> PPowType Integer Int
ppow Integer
b = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanPow Int Integer where
type PowType Int Integer = Integer
type PPowType Int Integer = Rational
pow :: Int -> Integer -> PowType Int Integer
pow Int
b = forall a b. (Num a, Integral b) => a -> b -> a
(P.^) (forall t. CanBeInteger t => t -> Integer
integer Int
b)
ppow :: Int -> Integer -> PPowType Int Integer
ppow Int
b = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (forall t. CanBeRational t => t -> Rational
rational Int
b)
instance CanPow Int Int where
type PowType Int Int = Rational
pow :: Int -> Int -> PowType Int Int
pow Int
b = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (forall t. CanBeRational t => t -> Rational
rational Int
b)
instance CanPow Rational Int where
pow :: Rational -> Int -> PowType Rational Int
pow = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Rational Integer where
pow :: Rational -> Integer -> PowType Rational Integer
pow = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Int where
pow :: Double -> Int -> PowType Double Int
pow = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Integer where
pow :: Double -> Integer -> PowType Double Integer
pow = forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Double where
type PowType Double Double = Double
pow :: Double -> Double -> PowType Double Double
pow = forall a. Floating a => a -> a -> a
(P.**)
instance CanPow Double Rational where
type PowType Double Rational = Double
pow :: Double -> Rational -> PowType Double Rational
pow Double
b Rational
e = Double
b forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ (forall t. CanBeDouble t => t -> Double
double Rational
e)
instance CanPow Rational Double where
type PowType Rational Double = Double
pow :: Rational -> Double -> PowType Rational Double
pow Rational
b Double
e = (forall t. CanBeDouble t => t -> Double
double Rational
b) forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ Double
e
instance CanPow Integer Double where
type PowType Integer Double = Double
pow :: Integer -> Double -> PowType Integer Double
pow Integer
b Double
e = (forall t. CanBeDouble t => t -> Double
double Integer
b) forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ Double
e
instance CanPow Int Double where
type PowType Int Double = Double
pow :: Int -> Double -> PowType Int Double
pow Int
b Double
e = (forall t. CanBeDouble t => t -> Double
double Int
b) forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^ Double
e
instance (CanPow a b) => CanPow (Maybe a) (Maybe b) where
type PowType (Maybe a) (Maybe b) = Maybe (PowType a b)
pow :: Maybe a -> Maybe b -> PowType (Maybe a) (Maybe b)
pow (Just a
x) (Just b
y) = forall a. a -> Maybe a
Just (forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
pow a
x b
y)
pow Maybe a
_ Maybe b
_ = forall a. Maybe a
Nothing
instance
(CanPow b e, HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestIsIntegerType b, CanTestIsIntegerType e, CanTestInteger e)
=>
CanPow (CN b) (CN e)
where
type PowType (CN b) (CN e) = CN (PowType b e)
type PPowType (CN b) (CN e) = CN (PPowType b e)
pow :: CN b -> CN e -> PowType (CN b) (CN e)
pow = forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestIsIntegerType b,
CanTestIsIntegerType e, CanTestInteger e) =>
(b -> e -> r) -> CN b -> CN e -> CN r
powCN forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
pow
ppow :: CN b -> CN e -> PPowType (CN b) (CN e)
ppow = forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
HasEqCertainly b Integer, CanTestInteger e) =>
(b -> e -> r) -> CN b -> CN e -> CN r
ppowCN forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PPowType t1 t2
ppow
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
(\ t -> [d|
instance
(CanPow $t e, HasOrderCertainly e Integer, CanTestIsIntegerType e, CanTestInteger e)
=>
CanPow $t (CN e)
where
type PowType $t (CN e) = CN (PowType $t e)
pow b e = powCN pow (cn b) e
type PPowType $t (CN e) = CN (PPowType $t e)
ppow b e = ppowCN ppow (cn b) e
instance
(CanPow b $t, HasOrderCertainly b Integer, HasEqCertainly b Integer, CanTestIsIntegerType b)
=>
CanPow (CN b) $t
where
type PowType (CN b) $t = CN (PowType b $t)
pow b e = powCN pow b (cn e)
type PPowType (CN b) $t = CN (PPowType b $t)
ppow b e = ppowCN ppow b (cn e)
|]))