{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Power
    Description :  Bottom-up typed exponentiation
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

-}

module Numeric.MixedTypes.Power
(
  -- * Exponentiation
   CanPow(..), CanPowBy
  , (^)
  , powUsingMul, integerPowCN
  , powUsingMulRecip
  -- ** Tests
  , 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 )
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.Div



{---- Exponentiation -----}

infixl 8  ^

(^) :: (CanPow t1 t2) => t1 -> t2 -> PowType t1 t2
^ :: t1 -> t2 -> PowType t1 t2
(^) = t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
pow


{-|
  A replacement for Prelude's binary `P.^` and `P.^^`.
-}
class CanPow b e where
  type PowType b e
  type PowType b e = b -- default
  pow :: b -> e -> PowType b e

integerPowCN ::
  (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) -> CN b -> CN e -> CN r
integerPowCN b -> e -> r
unsafeIntegerPow CN b
b CN e
n
  | CN e
n CN e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
0 =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN r) -> NumError -> CN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: negative exponent"
  | CN e
n CN e -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN b
b CN b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN r) -> NumError -> CN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: 0^0"
  | CN e
n CN e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<? Integer
0 =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN r) -> NumError -> CN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: negative exponent"
  | CN e
n CN e -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN b
b CN b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorPotential (NumError -> CN r) -> NumError -> CN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal integer pow: 0^0"
  | Bool
otherwise =
    (b -> e -> r) -> CN b -> CN e -> CN r
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, CanTestInteger e)
  =>
  (b -> e -> r) -> CN b -> CN e -> CN r
powCN :: (b -> e -> r) -> CN b -> CN e -> CN r
powCN b -> e -> r
unsafePow CN b
b CN e
e
  | CN b
b CN b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN e
e CN e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Integer
0 =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN r) -> NumError -> CN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal pow: 0^e with e <= 0"
  | CN b
b CN b -> 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
&& CN e -> Bool
forall t. CanTestInteger t => t -> Bool
certainlyNotInteger CN e
e =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN r) -> NumError -> CN r
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 CN b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& CN e
e CN e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<=? Integer
0 =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorPotential (NumError -> CN r) -> NumError -> CN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.OutOfDomain String
"illegal pow: 0^e with e <= 0"
  | CN b
b CN b -> 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
&& Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (CN e -> Bool
forall t. CanTestInteger t => t -> Bool
certainlyInteger CN e
e) =
    NumError -> CN r
forall v. NumError -> CN v
CN.noValueNumErrorPotential (NumError -> CN r) -> NumError -> CN r
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 =
    (b -> e -> r) -> CN b -> CN e -> CN r
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,
   CanMulSameType t)
   =>
   t -> t -> e -> t
powUsingMul :: t -> t -> e -> t
powUsingMul t
one t
x e
nPre
  | Integer
n Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 = String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ String
"powUsingMul is not defined for negative exponent " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n
  | Integer
n Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = t
one
  | Bool
otherwise = Integer -> t
aux Integer
n
  where
    n :: Integer
n = e -> Integer
forall t. CanBeInteger t => t -> Integer
integer e
nPre
    aux :: Integer -> t
aux Integer
m
      | Integer
m Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1 = t
x
      | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
m =
        let s :: t
s = Integer -> t
aux (Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`P.div` Integer
2) in t
s t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
s
      | Bool
otherwise =
        let s :: t
s = Integer -> t
aux ((Integer
mInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`P.div` Integer
2) in t
x t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
s t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
s

powUsingMulRecip ::
  (CanBeInteger e, CanMulSameType b, CanRecipSameType b)
   =>
   b -> b -> e -> b
powUsingMulRecip :: b -> b -> e -> b
powUsingMulRecip b
one b
x e
e
  | Integer
eI Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 = b -> DivType Integer b
forall t. CanRecip t => t -> DivType Integer t
recip (b -> DivType Integer b) -> b -> DivType Integer b
forall a b. (a -> b) -> a -> b
$ b -> b -> Integer -> b
forall e t. (CanBeInteger e, CanMulSameType t) => t -> t -> e -> t
powUsingMul b
one b
x (Integer -> NegType Integer
forall t. CanNeg t => t -> NegType t
negate Integer
eI)
  | Bool
otherwise = b -> b -> Integer -> b
forall e t. (CanBeInteger e, CanMulSameType t) => t -> t -> e -> t
powUsingMul b
one b
x Integer
eI
  where
  eI :: Integer
eI = e -> Integer
forall t. CanBeInteger t => t -> Integer
integer e
e

type CanPowBy t1 t2 =
  (CanPow t1 t2, PowType t1 t2 ~ t1)

{-|
  HSpec properties that each implementation of CanPow should satisfy.
 -}
specCanPow ::
  _ => T t1 -> T t2 -> Spec
specCanPow :: T t1 -> T t2 -> Spec
specCanPow (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanPow %s %s" String
typeName1 String
typeName2) (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
"x^0 = 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
        let one :: t1
one = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in
        let z :: t2
z = (Integer -> t2
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t2) in
        (t1
x t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
^ t2
z) PowType t1 t2 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
one
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^1 = x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
        let one :: t2
one = (Integer -> t2
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t2) in
        (t1
x t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
^ t2
one) PowType t1 t2 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^(y+1) = x*x^y" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> t2 -> Property) -> Property)
-> (t1 -> t2 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) ->
        (t2 -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          t1
x t1 -> PowType t1 t2 -> MulType t1 (PowType t1 t2)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t1
x t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
^ t2
y) MulType t1 (PowType t1 t2)
-> PowType t1 (AddType t2 Integer) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t1
x t1 -> AddType t2 Integer -> PowType t1 (AddType t2 Integer)
forall b e. CanPow b e => b -> e -> PowType b e
^ (t2
y t2 -> Integer -> AddType t2 Integer
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
  ?==?$ :: 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 CanPow Integer Integer where  
  type PowType Integer Integer = Rational
  pow :: Integer -> Integer -> PowType Integer Integer
pow Integer
b = Rational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanPow Integer Int where
  type PowType Integer Int = Rational
  pow :: Integer -> Int -> PowType Integer Int
pow Integer
b = Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanPow Int Integer where
  type PowType Int Integer = Rational
  pow :: Int -> Integer -> PowType Int Integer
pow Int
b = Rational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (Int -> Rational
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 = Rational -> Int -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^) (Int -> Rational
forall t. CanBeRational t => t -> Rational
rational Int
b)
instance CanPow Rational Int where
  pow :: Rational -> Int -> PowType Rational Int
pow = Rational -> Int -> PowType Rational Int
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Rational Integer where
  pow :: Rational -> Integer -> PowType Rational Integer
pow = Rational -> Integer -> PowType Rational Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Int where
  pow :: Double -> Int -> PowType Double Int
pow = Double -> Int -> PowType Double Int
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Integer where
  pow :: Double -> Integer -> PowType Double Integer
pow = Double -> Integer -> PowType Double Integer
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 = Double -> Double -> PowType Double Double
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 Double -> Double -> PowType Double Double
forall b e. CanPow b e => b -> e -> PowType b e
^ (Rational -> Double
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 = (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
b) Double -> Double -> PowType Double Double
forall b e. CanPow b e => b -> e -> PowType b e
^ Double
e
instance CanPow Integer Double where
  type PowType Integer Double = Double
  pow :: Integer -> Double -> PowType Integer Double
pow Integer
b Double
e = (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
b) Double -> Double -> PowType Double Double
forall b e. CanPow b e => b -> e -> PowType b e
^ Double
e
instance CanPow Int Double where
  type PowType Int Double = Double
  pow :: Int -> Double -> PowType Int Double
pow Int
b Double
e = (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
b) Double -> Double -> PowType Double Double
forall b e. CanPow b e => b -> e -> PowType b e
^ Double
e

-- instance (CanPow a b) => CanPow [a] [b] where
--   type PowType [a] [b] = [PowType a b]
--   pow (x:xs) (y:ys) = (pow x y) : (pow xs ys)
--   pow _ _ = []

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) = PowType a b -> Maybe (PowType a b)
forall a. a -> Maybe a
Just (a -> b -> PowType a b
forall b e. CanPow b e => b -> e -> PowType b e
pow a
x b
y)
  pow Maybe a
_ Maybe b
_ = PowType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing

instance
  (CanPow b e, HasOrderCertainly b Integer, HasOrderCertainly e Integer,
   HasEqCertainly b Integer, CanTestInteger e)
  =>
  CanPow (CN b) (CN e)
  where
  type PowType (CN b) (CN e) = CN (PowType b e)
  pow :: CN b -> CN e -> PowType (CN b) (CN e)
pow = (b -> e -> PowType b e) -> CN b -> CN e -> CN (PowType b e)
forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
 HasEqCertainly b Integer, CanTestInteger e) =>
(b -> e -> r) -> CN b -> CN e -> CN r
powCN b -> e -> PowType b e
forall b e. CanPow b e => b -> e -> PowType b e
pow

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
  (\ t -> [d|

    instance
      (CanPow $t e, HasOrderCertainly e Integer, CanTestInteger e)
      =>
      CanPow $t (CN e)
      where
      type PowType $t (CN e) = CN (PowType $t e)
      pow b e = powCN pow (cn b) e

    instance
      (CanPow b $t, HasOrderCertainly b Integer, HasEqCertainly b Integer)
      =>
      CanPow (CN b) $t
      where
      type PowType (CN b) $t = CN (PowType b $t)
      pow b e = powCN pow b (cn e)

  |]))