module Data.Derivative
(
(:>)(..), (:~>), dZero, dConst
, idD, fstD, sndD
, linearD, distribD
, (@.), (>-<)
) where
import Control.Applicative
import Data.VectorSpace
import Data.NumInstances ()
infixr 9 `D`, @.
infix 0 >-<
data a :> b = D { dVal :: b, dDeriv :: a :-* (a :> b) }
type a :~> b = a -> (a:>b)
instance Functor ((:>) a) where
fmap f (D b b') = D (f b) ((fmap.fmap) f b')
noOv :: String -> a
noOv op = error (op ++ ": not defined on a :> b")
instance Applicative ((:>) a) where
pure = noOv "pure. use dConst instead."
D f f' <*> D b b' = D (f b) (liftA2 (<*>) f' b')
dConst :: VectorSpace b s => b -> a:>b
dConst b = b `D` const dZero
dZero :: VectorSpace b s => a:>b
dZero = dConst zeroV
idD :: VectorSpace u s => u :~> u
idD = linearD id
linearD :: VectorSpace v s => (u :-* v) -> (u :~> v)
linearD f u = D (f u) (dConst . f)
fstD :: VectorSpace a s => (a,b) :~> a
fstD = linearD fst
sndD :: VectorSpace b s => (a,b) :~> b
sndD = linearD snd
distribD :: (VectorSpace u s) =>
(b -> c -> u) -> ((a :> b) -> (a :> c) -> (a :> u))
-> (a :> b) -> (a :> c) -> (a :> u)
distribD op opD u@(D u0 u') v@(D v0 v') =
D (u0 `op` v0) ((u `opD`) . v' ^+^ (`opD` v) . u')
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 VectorSpace u s => VectorSpace (a :> u) (a :> s) where
zeroV = dConst zeroV
(*^) = distribD (*^) (*^)
negateV = fmap negateV
(^+^) = liftA2 (^+^)
(@.) :: (b :~> c) -> (a :~> b) -> (a :~> c)
(h @. g) a0 = D c0 (c' @. b')
where
D b0 b' = g a0
D c0 c' = h b0
(>-<) :: 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 (Num b, VectorSpace b b) => Num (a:>b) where
fromInteger = dConst . fromInteger
(+) = liftA2 (+)
() = liftA2 ()
(*) = distribD (*) (*)
negate = negate >-< 1
abs = abs >-< signum
signum = signum >-< 0
instance (Fractional b, VectorSpace b b) => Fractional (a:>b) where
fromRational = dConst . fromRational
recip = recip >-< recip sqr
sqr :: Num a => a -> a
sqr x = x*x
instance (Floating b, VectorSpace b b) => Floating (a:>b) where
pi = dConst 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)