Copyright | (c) Edward Kmett 2010-2021 |
---|---|
License | BSD3 |
Maintainer | ekmett@gmail.com |
Stability | experimental |
Portability | GHC only |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This module provides reverse-mode Automatic Differentiation implementation using linear time topological sorting after the fact.
For this form of reverse-mode AD we use StableName
to recover
sharing information from the tape to avoid combinatorial explosion, and thus
run asymptotically faster than it could without such sharing information, but the use
of side-effects contained herein is benign.
Synopsis
- newtype KahnDouble = Kahn (Tape KahnDouble)
- data Tape t
- partials :: KahnDouble -> [(Int, Double)]
- partialArray :: (Int, Int) -> KahnDouble -> UArray Int Double
- partialMap :: KahnDouble -> IntMap Double
- derivative :: KahnDouble -> Double
- derivative' :: KahnDouble -> (Double, Double)
- vgrad :: Grad i o o' => i -> o
- vgrad' :: Grad i o o' => i -> o'
- class Grad i o o' | i -> o o', o -> i o', o' -> i o where
- pack :: i -> [KahnDouble] -> KahnDouble
- unpack :: (List -> List) -> o
- unpack' :: (List -> (Double, List)) -> o'
- bind :: Traversable f => f Double -> (f KahnDouble, (Int, Int))
- unbind :: Functor f => f KahnDouble -> UArray Int Double -> f Double
- unbindMap :: Functor f => f KahnDouble -> IntMap Double -> f Double
- unbindWithUArray :: (Functor f, IArray UArray b) => (Double -> b -> c) -> f KahnDouble -> UArray Int b -> f c
- unbindWithArray :: Functor f => (Double -> b -> c) -> f KahnDouble -> Array Int b -> f c
- unbindMapWithDefault :: Functor f => b -> (Double -> b -> c) -> f KahnDouble -> IntMap b -> f c
- primal :: KahnDouble -> Double
- var :: Double -> Int -> KahnDouble
- varId :: KahnDouble -> Int
Documentation
newtype KahnDouble Source #
Kahn
is a Mode
using reverse-mode automatic differentiation that provides fast diffFU
, diff2FU
, grad
, grad2
and a fast jacobian
when you have a significantly smaller number of outputs than inputs.
Instances
A Tape
records the information needed back propagate from the output to each input during reverse Mode
AD.
Instances
Data t => Data (Tape t) Source # | |
Defined in Numeric.AD.Internal.Kahn.Double gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Tape t -> c (Tape t) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Tape t) # toConstr :: Tape t -> Constr # dataTypeOf :: Tape t -> DataType # dataCast1 :: Typeable t0 => (forall d. Data d => c (t0 d)) -> Maybe (c (Tape t)) # dataCast2 :: Typeable t0 => (forall d e. (Data d, Data e) => c (t0 d e)) -> Maybe (c (Tape t)) # gmapT :: (forall b. Data b => b -> b) -> Tape t -> Tape t # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tape t -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tape t -> r # gmapQ :: (forall d. Data d => d -> u) -> Tape t -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Tape t -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Tape t -> m (Tape t) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Tape t -> m (Tape t) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Tape t -> m (Tape t) # | |
Show t => Show (Tape t) Source # | |
partials :: KahnDouble -> [(Int, Double)] Source #
This returns a list of contributions to the partials. The variable ids returned in the list are likely not unique!
partialArray :: (Int, Int) -> KahnDouble -> UArray Int Double Source #
partialMap :: KahnDouble -> IntMap Double Source #
Return an IntMap
of sparse partials
derivative :: KahnDouble -> Double Source #
derivative' :: KahnDouble -> (Double, Double) Source #
class Grad i o o' | i -> o o', o -> i o', o' -> i o where Source #
pack :: i -> [KahnDouble] -> KahnDouble Source #
Instances
Grad i o o' => Grad (KahnDouble -> i) (Double -> o) (Double -> o') Source # | |
Defined in Numeric.AD.Internal.Kahn.Double pack :: (KahnDouble -> i) -> [KahnDouble] -> KahnDouble Source # unpack :: (List -> List) -> Double -> o Source # unpack' :: (List -> (Double, List)) -> Double -> o' Source # |
bind :: Traversable f => f Double -> (f KahnDouble, (Int, Int)) Source #
unbindWithUArray :: (Functor f, IArray UArray b) => (Double -> b -> c) -> f KahnDouble -> UArray Int b -> f c Source #
unbindWithArray :: Functor f => (Double -> b -> c) -> f KahnDouble -> Array Int b -> f c Source #
unbindMapWithDefault :: Functor f => b -> (Double -> b -> c) -> f KahnDouble -> IntMap b -> f c Source #
primal :: KahnDouble -> Double Source #
varId :: KahnDouble -> Int Source #