{-# LANGUAGE CPP #-}
module Numeric.AD.Rank1.Forward.Double
( ForwardDouble
, grad
, grad'
, gradWith
, gradWith'
, jacobian
, jacobian'
, jacobianWith
, jacobianWith'
, jacobianT
, jacobianWithT
, diff
, diff'
, diffF
, diffF'
, du
, du'
, duF
, duF'
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Traversable (Traversable)
#endif
import Numeric.AD.Mode
import Numeric.AD.Internal.Forward.Double
du :: Functor f => (f ForwardDouble -> ForwardDouble) -> f (Double, Double) -> Double
du f = tangent . f . fmap (uncurry bundle)
{-# INLINE du #-}
du' :: Functor f => (f ForwardDouble -> ForwardDouble) -> f (Double, Double) -> (Double, Double)
du' f = unbundle . f . fmap (uncurry bundle)
{-# INLINE du' #-}
duF :: (Functor f, Functor g) => (f ForwardDouble -> g ForwardDouble) -> f (Double, Double) -> g Double
duF f = fmap tangent . f . fmap (uncurry bundle)
{-# INLINE duF #-}
duF' :: (Functor f, Functor g) => (f ForwardDouble -> g ForwardDouble) -> f (Double, Double) -> g (Double, Double)
duF' f = fmap unbundle . f . fmap (uncurry bundle)
{-# INLINE duF' #-}
diff :: (ForwardDouble -> ForwardDouble) -> Double -> Double
diff f a = tangent $ apply f a
{-# INLINE diff #-}
diff' :: (ForwardDouble -> ForwardDouble) -> Double -> (Double, Double)
diff' f a = unbundle $ apply f a
{-# INLINE diff' #-}
diffF :: Functor f => (ForwardDouble -> f ForwardDouble) -> Double -> f Double
diffF f a = tangent <$> apply f a
{-# INLINE diffF #-}
diffF' :: Functor f => (ForwardDouble -> f ForwardDouble) -> Double -> f (Double, Double)
diffF' f a = unbundle <$> apply f a
{-# INLINE diffF' #-}
jacobianT :: (Traversable f, Functor g) => (f ForwardDouble -> g ForwardDouble) -> f Double -> f (g Double)
jacobianT f = bind (fmap tangent . f)
{-# INLINE jacobianT #-}
jacobianWithT :: (Traversable f, Functor g) => (Double -> Double -> b) -> (f ForwardDouble -> g ForwardDouble) -> f Double -> f (g b)
jacobianWithT g f = bindWith g' f where
g' a ga = g a . tangent <$> ga
{-# INLINE jacobianWithT #-}
{-# ANN jacobianWithT "HLint: ignore Eta reduce" #-}
jacobian :: (Traversable f, Traversable g) => (f ForwardDouble -> g ForwardDouble) -> f Double -> g (f Double)
jacobian f as = transposeWith (const id) t p where
(p, t) = bind' (fmap tangent . f) as
{-# INLINE jacobian #-}
jacobianWith :: (Traversable f, Traversable g) => (Double -> Double -> b) -> (f ForwardDouble -> g ForwardDouble) -> f Double -> g (f b)
jacobianWith g f as = transposeWith (const id) t p where
(p, t) = bindWith' g' f as
g' a ga = g a . tangent <$> ga
{-# INLINE jacobianWith #-}
jacobian' :: (Traversable f, Traversable g) => (f ForwardDouble -> g ForwardDouble) -> f Double -> g (Double, f Double)
jacobian' f as = transposeWith row t p where
(p, t) = bind' f as
row x as' = (primal x, tangent <$> as')
{-# INLINE jacobian' #-}
jacobianWith' :: (Traversable f, Traversable g) => (Double -> Double -> b) -> (f ForwardDouble -> g ForwardDouble) -> f Double -> g (Double, f b)
jacobianWith' g f as = transposeWith row t p where
(p, t) = bindWith' g' f as
row x as' = (primal x, as')
g' a ga = g a . tangent <$> ga
{-# INLINE jacobianWith' #-}
grad :: Traversable f => (f ForwardDouble -> ForwardDouble) -> f Double -> f Double
grad f = bind (tangent . f)
{-# INLINE grad #-}
grad' :: Traversable f => (f ForwardDouble -> ForwardDouble) -> f Double -> (Double, f Double)
grad' f as = (primal b, tangent <$> bs)
where
(b, bs) = bind' f as
{-# INLINE grad' #-}
gradWith :: Traversable f => (Double -> Double -> b) -> (f ForwardDouble -> ForwardDouble) -> f Double -> f b
gradWith g f = bindWith g (tangent . f)
{-# INLINE gradWith #-}
gradWith' :: Traversable f => (Double -> Double -> b) -> (f ForwardDouble -> ForwardDouble) -> f Double -> (Double, f b)
gradWith' g f as = (primal $ f (auto <$> as), bindWith g (tangent . f) as)
{-# INLINE gradWith' #-}