module Data.Maclaurin
(
(:>), powVal, derivative, derivativeAt
, (:~>), dZero, pureD
, fmapD, (<$>>), liftD2, liftD3
, idD, fstD, sndD
, linearD, distrib
, (@.), (>-<)
,(**^), (<*.>)
) where
import Data.VectorSpace
import Data.NumInstances ()
import Data.LinearMap
infixr 9 `D`, @.
infixl 4 <$>>
infix 0 >-<
data a :> b = D { powVal :: b, derivative :: a :-* (a :> b) }
type a :~> b = a -> (a:>b)
derivativeAt :: (VectorSpace b s, LMapDom a s) =>
(a :> b) -> a -> (a :> b)
derivativeAt d = lapply (derivative d)
noOv :: String -> a
noOv op = error (op ++ ": not defined on a :> b")
dZero :: (LMapDom a s, AdditiveGroup b) => a:>b
dZero = pureD zeroV
pureD :: (LMapDom a s, AdditiveGroup b) => b -> a:>b
pureD b = b `D` pureL dZero
fmapD, (<$>>) :: (LMapDom a s, VectorSpace b s) =>
(b -> c) -> (a :> b) -> (a :> c)
fmapD f (D b0 b') = D (f b0) ((fmapL.fmapD) f b')
(<$>>) = fmapD
liftD2 :: (VectorSpace b s, LMapDom a s, VectorSpace c s, VectorSpace d s) =>
(b -> c -> d) -> (a :> b) -> (a :> c) -> (a :> d)
liftD2 f (D b0 b') (D c0 c') = D (f b0 c0) (liftL2 (liftD2 f) b' c')
liftD3 :: ( LMapDom a s
, VectorSpace b s, VectorSpace c s
, VectorSpace d s, VectorSpace e s ) =>
(b -> c -> d -> e)
-> (a :> b) -> (a :> c) -> (a :> d) -> (a :> e)
liftD3 f (D b0 b') (D c0 c') (D d0 d') = D (f b0 c0 d0) (liftL3 (liftD3 f) b' c' d')
idD :: (LMapDom u s, VectorSpace u s) => u :~> u
idD = linearD id
linearD :: (LMapDom u s, VectorSpace v s) => (u -> v) -> (u :~> v)
linearD f u = D (f u) (linear (pureD . f))
fstD :: (VectorSpace a s, LMapDom b s, LMapDom a s) => (a,b) :~> a
fstD = linearD fst
sndD :: (VectorSpace b s, LMapDom b s, LMapDom a s) => (a,b) :~> b
sndD = linearD snd
distrib :: (LMapDom a s, VectorSpace b s, VectorSpace c s, VectorSpace u s) =>
(b -> c -> u) -> (a :> b) -> (a :> c) -> (a :> u)
distrib op = opD
where
opD u@(D u0 u') v@(D v0 v') =
D (u0 `op` v0) (linear (\ da -> u `opD` (v' `lapply` da) ^+^
(u' `lapply` da) `opD` v))
instance Show b => Show (a :> b) where show = noOv "show"
instance Eq b => Eq (a :> b) where (==) = noOv "(==)"
instance Ord b => Ord (a :> b) where compare = noOv "compare"
instance (LMapDom a s, VectorSpace u s) => AdditiveGroup (a :> u) where
zeroV = pureD zeroV
negateV = fmapD negateV
(^+^) = liftD2 (^+^)
instance (LMapDom a s, VectorSpace u s) => VectorSpace (a :> u) s where
(*^) s = fmapD ((*^) s)
(**^) :: (VectorSpace c s, VectorSpace s s, LMapDom a s) =>
(a :> s) -> (a :> c) -> (a :> c)
(**^) = distrib (*^)
(<*.>) :: (LMapDom a s, InnerSpace b s, VectorSpace s s) =>
(a :> b) -> (a :> b) -> (a :> s)
(<*.>) s = distrib (<.>) s
(@.) :: (LMapDom b s, LMapDom a s, VectorSpace c s) =>
(b :~> c) -> (a :~> b) -> (a :~> c)
(h @. g) a0 = D c0 (inL2 (@.) c' b')
where
D b0 b' = g a0
D c0 c' = h b0
(>-<) :: (LMapDom a s, VectorSpace s s, VectorSpace u s) =>
(u -> u) -> ((a :> u) -> (a :> s))
-> (a :> u) -> (a :> u)
f >-< f' = \ u@(D u0 u') -> D (f u0) ((f' u **^) <$>* u')
instance (LMapDom a b, Num b, VectorSpace b b) => Num (a:>b) where
fromInteger = pureD . fromInteger
(+) = liftD2 (+)
() = liftD2 ()
(*) = distrib (*)
negate = negate >-< 1
abs = abs >-< signum
signum = signum >-< 0
instance (LMapDom a b, Fractional b, VectorSpace b b) => Fractional (a:>b) where
fromRational = pureD . fromRational
recip = recip >-< recip sqr
sqr :: Num a => a -> a
sqr x = x*x
instance (LMapDom a b, Floating b, VectorSpace b b) => Floating (a:>b) where
pi = pureD pi
exp = exp >-< exp
log = log >-< recip
sqrt = sqrt >-< recip (2 * sqrt)
sin = sin >-< cos
cos = cos >-< sin
sinh = sinh >-< cosh
cosh = cosh >-< sinh
asin = asin >-< recip (sqrt (1sqr))
acos = acos >-< recip ( sqrt (1sqr))
atan = atan >-< recip (1+sqr)
asinh = asinh >-< recip (sqrt (1+sqr))
acosh = acosh >-< recip ( sqrt (sqr1))
atanh = atanh >-< recip (1sqr)