ad 0.24 → 0.27

raw patch · 16 files changed

+590/−582 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Numeric/AD.hs +32/−25
• Numeric/AD/Classes.hs +0/−322
• Numeric/AD/Directed.hs +7/−7
• Numeric/AD/Forward.hs +24/−24
• Numeric/AD/Internal.hs +11/−3
• Numeric/AD/Internal/Classes.hs +293/−0
• Numeric/AD/Internal/Composition.hs +9/−9
• Numeric/AD/Internal/Forward.hs +1/−1
• Numeric/AD/Internal/Reverse.hs +1/−2
• Numeric/AD/Internal/Stream.hs +144/−0
• Numeric/AD/Internal/Tower.hs +1/−1
• Numeric/AD/Newton.hs +13/−13
• Numeric/AD/Reverse.hs +26/−26
• Numeric/AD/Stream.hs +1/−123
• Numeric/AD/Tower.hs +24/−24
• ad.cabal +3/−2

@@ -27,13 +27,19 @@     , jacobianWith     , jacobianWith' -    -- * Jacobians (Reverse Mode)+    -- * Monadic Gradient/Jacobian (Reverse Mode)+    , gradM+    , gradM'+    , gradWithM+    , gradWithM'++    -- * Functorial Gradient/Jacobian (Reverse Mode)     , gradF     , gradF'     , gradWithF     , gradWithF' -    -- * Jacobians (Forward Mode)+    -- * Transposed Jacobians (Forward Mode)     , jacobianT     , jacobianWithT @@ -66,6 +72,8 @@     , du'     , duF     , duF'++    -- * Directional Derivatives (Tower)     , dus     , dus0     , dusF@@ -83,13 +91,8 @@     , diffM     , diffM' -    -- * Monadic Combinators (Reverse Mode)-    , gradM-    , gradM'-    , gradWithM-    , gradWithM'-     -- * Exposed Types+    , UU, UF, FU, FF     , AD(..)     , Mode(..)     ) where@@ -97,8 +100,8 @@ import Data.Traversable (Traversable) import Data.Foldable (Foldable, foldr') import Control.Applicative-import Numeric.AD.Classes  (Mode(..))-import Numeric.AD.Internal (AD(..), probed, unprobe)+import Numeric.AD.Internal (AD(..), probed, unprobe, UU, UF, FU, FF)+import Numeric.AD.Internal.Classes  (Mode(..)) import Numeric.AD.Forward  (diff, diff', diffF, diffF', du, du', duF, duF', diffM, diffM', jacobianT, jacobianWithT)  import Numeric.AD.Tower    (diffsF, diffs0F , diffs, diffs0, taylor, taylor0, maclaurin, maclaurin0, dus, dus0, dusF, dus0F) import Numeric.AD.Reverse  (grad, grad', gradWith, gradWith', gradM, gradM', gradWithM, gradWithM', gradF, gradF', gradWithF, gradWithF')@@ -110,14 +113,14 @@ -- | Calculate the Jacobian of a non-scalar-to-non-scalar function, automatically choosing between forward and reverse mode AD based on the number of inputs and outputs. -- -- If you need to support functions where the output is only a 'Functor' or 'Monad', consider 'Numeric.AD.Reverse.jacobian' or 'Numeric.AD.Reverse.gradM' from "Numeric.AD.Reverse".-jacobian :: (Traversable f, Traversable g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f a)+jacobian :: (Traversable f, Traversable g, Num a) => FF f g a -> f a -> g (f a) jacobian f bs = snd <$> jacobian' f bs {-# INLINE jacobian #-}  -- | Calculate both the answer and Jacobian of a non-scalar-to-non-scalar function, automatically choosing between forward- and reverse- mode AD based on the relative, number of inputs and outputs. -- -- If you need to support functions where the output is only a 'Functor' or 'Monad', consider 'Numeric.AD.Reverse.jacobian'' or 'Numeric.AD.Reverse.gradM'' from "Numeric.AD.Reverse".-jacobian' :: (Traversable f, Traversable g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f a)+jacobian' :: (Traversable f, Traversable g, Num a) => FF f g a -> f a -> g (a, f a) jacobian' f bs | n == 0    = fmap (\x -> (unprobe x, bs)) as                | n > m     = Reverse.jacobian' f bs                | otherwise = Forward.jacobian' f bs@@ -134,7 +137,7 @@ -- The resulting Jacobian matrix is then recombined element-wise with the input using @g@. -- -- If you need to support functions where the output is only a 'Functor' or 'Monad', consider 'Numeric.AD.Reverse.jacobianWith' or 'Numeric.AD.Reverse.gradWithM' from "Numeric.AD.Reverse".-jacobianWith :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f b)+jacobianWith :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (f b) jacobianWith g f bs = snd <$> jacobianWith' g f bs {-# INLINE jacobianWith #-} @@ -143,7 +146,7 @@ -- The resulting Jacobian matrix is then recombined element-wise with the input using @g@. -- -- If you need to support functions where the output is only a 'Functor' or 'Monad', consider 'Numeric.AD.Reverse.jacobianWith'' or 'Numeric.AD.Reverse.gradWithM'' from "Numeric.AD.Reverse".-jacobianWith' :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f b)+jacobianWith' :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (a, f b) jacobianWith' g f bs     | n == 0    = fmap (\x -> (unprobe x, undefined <$> bs)) as     | n > m     = Reverse.jacobianWith' g f bs@@ -161,31 +164,35 @@ -- > H v = (d/dr) grad_w (w + r v) | r = 0 --  -- Or in other words, we take the directional derivative of the gradient.-hessianProduct :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> f a+hessianProduct :: (Traversable f, Num a) => FU f a -> f (a, a) -> f a hessianProduct f = duF (grad (decomposeMode . f . fmap composeMode)) --- | @'hessianProduct'' f wv@ computes both the gradient of a non-scalar-to-scalar @f@ at @w = 'fst' <$> wv@ and the product of the hessian @H@ at @w@ with a vector @v = snd <$> wv@ using \"Pearlmutter\'s method\". The outputs are returned wrapped in the same functor.+-- | @'hessianProduct'' f wv@ computes both the gradient of a non-scalar-to-scalar @f@ at @w = 'fst' <$> wv@ and the product of the hessian @H@ at @w@ with a vector @v = snd <$> wv@ using \"Pearlmutter's method\". The outputs are returned wrapped in the same functor. -- -- > H v = (d/dr) grad_w (w + r v) | r = 0 --  -- Or in other words, we take the directional derivative of the gradient. -- -hessianProduct' :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> f (a, a)+hessianProduct' :: (Traversable f, Num a) => FU f a -> f (a, a) -> f (a, a) hessianProduct' f = duF' (grad (decomposeMode . f . fmap composeMode))  -- hessianProductWith' :: (Traversable f, Num a) => (a -> a -> a -> a -> b) -> (forall s. Mode s. f (AD s a) -> AD s a) -> f (a, a) -> f b  -- | Compute the hessian via the jacobian of the gradient. gradient is computed in reverse mode and then the jacobian is computed in forward mode.-hessian :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f (f a)+hessian :: (Traversable f, Num a) => FU f a -> f a -> f (f a) hessian f = Forward.jacobian (grad (decomposeMode . f . fmap composeMode))  -- | Compute the order 3 Hessian tensor on a non-scalar-to-non-scalar function via the forward-mode Jacobian of the mixed-mode Jacobian of the function.-hessianTensor :: (Traversable f, Traversable g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f (f a))+hessianTensor :: (Traversable f, Traversable g, Num a) => FF f g a -> f a -> g (f (f a)) hessianTensor f = decomposeFunctor . Forward.jacobian (ComposeFunctor . jacobian (fmap decomposeMode . f . fmap composeMode)) --- the cofree comonad of f--- data f :> a = (f :> a) :> a---- gradients :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (f :> a) ---- jacobians :: (Traversable f, Traversable g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f :> a) +-- data f :> a = a :< f (f :> a)+-- data f :- a = a :- (f :- f a) | Zero+{-+flatten :: (f :> a) -> (f :- a)+grads :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (f :- a) +grads f b = a :- da :- d2a :- Zero+    (a, da) = grad2 f a+    dda = Forward.jacobian (grad (decomposeMode . f . fmap composeMode)+    ddda = Forward+-}

@@ -1,322 +0,0 @@-{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, FunctionalDependencies, UndecidableInstances, GeneralizedNewtypeDeriving, TemplateHaskell #-}--------------------------------------------------------------------------------- |--- Module      :  Numeric.AD.Classes--- Copyright   :  (c) Edward Kmett 2010--- License     :  BSD3--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  GHC only-----------------------------------------------------------------------------------module Numeric.AD.Classes-    (-    -- * AD modes-      Mode(..)-    , one-    -- * Automatically Deriving AD-    , Jacobian(..)-    , Primal(..)-    , deriveLifted-    , deriveNumeric-    , Lifted(..)-    ) where--import Control.Applicative-import Data.Char-import Language.Haskell.TH--- import Text.Show--infixl 8 **!-infixl 7 *!, /!, ^*, *^, ^/-infixl 6 +!, -!, <+>-infix 4 ==!---- | Higher-order versions of the stock numerical methods.-class Lifted t where--- class Show1 t where-    showsPrec1 :: Show a => Int -> t a -> ShowS---    show1 :: Show a => t a -> String---    showList1 :: Show a => [t a] -> String -> String---- class Eq1 t where-    (==!) :: (Num a, Eq a) => t a -> t a -> Bool-    -- (/=!) :: (Num a, Eq a) => t a -> t a -> Bool---- class Eq1 => Ord1 t where-    compare1 :: (Num a, Ord a) => t a -> t a -> Ordering-    -- (<!) :: (Num a, Ord a) => t a -> t a -> Bool-    -- (>=!) :: (Num a, Ord a) => t a -> t a -> Bool-    -- (>!) :: (Num a, Ord a) => t a -> t a -> Bool-    -- (<=!) :: (Num a, Ord a) => t a -> t a -> Bool-    -- min1 :: (Num a, Ord a) => t a -> t a -> t a-    -- max1 :: (Num a, Ord a) => t a -> t a -> t a---- class (Show1 t, Eq t) => Num1 t where-    fromInteger1 :: Num a => Integer -> t a-    (+!),(-!),(*!) :: Num a => t a -> t a -> t a-    negate1, abs1, signum1 :: Num a => t a -> t a---- class Num1 t => Fractional1 t where-    (/!) :: Fractional a => t a -> t a -> t a-    recip1 :: Fractional a => t a -> t a-    fromRational1 :: Fractional a => Rational -> t a---- class (Num1 t, Ord1 t) => Real1 t-    toRational1 :: Real a => t a -> Rational -- unsafe---- class Fractional1 t => Floating1 t-    pi1 :: Floating a => t a-    exp1, log1, sqrt1 :: Floating a => t a -> t a-    (**!), logBase1 :: Floating a => t a -> t a -> t a-    sin1, cos1, tan1, asin1, acos1, atan1 :: Floating a => t a -> t a-    sinh1, cosh1, tanh1, asinh1, acosh1, atanh1 :: Floating a => t a -> t a---- class (Real1 t, Fractional1 t) => RealFrac1 t where-    properFraction1 :: (RealFrac a, Integral b) => t a -> (b, t a)--    truncate1, round1, ceiling1, floor1 :: (RealFrac a, Integral b) => t a -> b---- class (RealFrac1 t, Floating1 t) => RealFloat1 t where-    floatRadix1 :: RealFloat a => t a -> Integer-    floatDigits1 :: RealFloat a => t a -> Int-    floatRange1  :: RealFloat a => t a -> (Int, Int)-    decodeFloat1 :: RealFloat a => t a -> (Integer, Int)-    encodeFloat1  :: RealFloat a => Integer -> Int -> t a-    exponent1     :: RealFloat a => t a -> Int-    significand1  :: RealFloat a => t a -> t a-    scaleFloat1   :: RealFloat a => Int -> t a -> t a-    isNaN1, isInfinite1, isDenormalized1, isNegativeZero1, isIEEE1 :: RealFloat a => t a -> Bool-    atan21 :: RealFloat a => t a -> t a -> t a---- class Enum1 t where-    succ1, pred1    :: (Num a, Enum a) => t a -> t a-    toEnum1         :: (Num a, Enum a) => Int -> t a-    fromEnum1       :: (Num a, Enum a) => t a -> Int-    enumFrom1       :: (Num a, Enum a) => t a -> [t a]-    enumFromThen1   :: (Num a, Enum a) => t a -> t a -> [t a]-    enumFromTo1     :: (Num a, Enum a) => t a -> t a -> [t a]-    enumFromThenTo1 :: (Num a, Enum a) => t a -> t a -> t a -> [t a]---- class Bounded1 t where-    minBound1 :: (Num a, Bounded a) => t a-    maxBound1 :: (Num a, Bounded a) => t a--class Lifted t => Mode t where--    -- | Embed a constant-    lift  :: Num a => a -> t a--    -- | Vector sum-    (<+>) :: Num a => t a -> t a -> t a--    -- | Scalar-vector multiplication-    (*^) :: Num a => a -> t a -> t a--    -- | Vector-scalar multiplication-    (^*) :: Num a => t a -> a -> t a--    -- | Scalar division-    (^/) :: Fractional a => t a -> a -> t a--    -- | > 'zero' = 'lift' 0-    zero :: Num a => t a--    a *^ b = lift a *! b-    a ^* b = a *! lift b--    a ^/ b = a ^* recip b--    zero = lift 0---- | > 'one' = 'lift' 1-one :: (Mode t, Num a) => t a-one = lift 1-{-# INLINE one #-}--negOne :: (Mode t, Num a) => t a-negOne = lift (-1)-{-# INLINE negOne #-}---- | 'Primal' is used by 'deriveMode' but is not exposed--- via the 'Mode' class to prevent its abuse by end users--- via the AD data type.------ It provides direct access to the result, stripped of its derivative information,--- but this is unsafe in general as (lift . primal) would discard derivative--- information. The end user is protected from accidentally using this function--- by the universal quantification on the various combinators we expose.--class Primal t where-    primal :: Num a => t a -> a---- | 'Jacobian' is used by 'deriveMode' but is not exposed--- via 'Mode' to prevent its abuse by end users--- via the 'AD' data type.-class (Mode t, Mode (D t)) => Jacobian t where-    type D t :: * -> *--    unary  :: Num a => (a -> a) -> D t a -> t a -> t a-    lift1  :: Num a => (a -> a) -> (D t a -> D t a) -> t a -> t a-    lift1_ :: Num a => (a -> a) -> (D t a -> D t a -> D t a) -> t a -> t a--    binary :: Num a => (a -> a -> a) -> D t a -> D t a -> t a -> t a -> t a-    lift2  :: Num a => (a -> a -> a) -> (D t a -> D t a -> (D t a, D t a)) -> t a -> t a -> t a-    lift2_ :: Num a => (a -> a -> a) -> (D t a -> D t a -> D t a -> (D t a, D t a)) -> t a -> t a -> t a--withPrimal :: (Jacobian t, Num a) => t a -> a -> t a-withPrimal t a = unary (const a) one t--fromBy :: (Jacobian t, Num a) => t a -> t a -> Int -> a -> t a-fromBy a delta n x = binary (\_ _ -> x) one (fromIntegral1 n) a delta--fromIntegral1 :: (Integral n, Lifted t, Num a) => n -> t a-fromIntegral1 = fromInteger1 . fromIntegral-{-# INLINE fromIntegral1 #-}--square1 :: (Lifted t, Num a) => t a -> t a-square1 x = x *! x-{-# INLINE square1 #-}--on :: (a -> a -> c) -> (b -> a) -> b -> b -> c-on f g a b = f (g a) (g b)--discrete1 :: (Primal t, Num a) => (a -> c) -> t a -> c-discrete1 f x = f (primal x)--discrete2 :: (Primal t, Num a) => (a -> a -> c) -> t a -> t a -> c-discrete2 f x y = f (primal x) (primal y)--discrete3 :: (Primal t, Num a) => (a -> a -> a -> d) -> t a -> t a -> t a -> d-discrete3 f x y z = f (primal x) (primal y) (primal z)---- | @'deriveLifted' t@ provides------ > instance Lifted $t------ given supplied instances for------ > instance Lifted $t => Primal $t where ...--- > instance Lifted $t => Jacobian $t where ...------ The seemingly redundant @'Lifted' $t@ constraints are caused by Template Haskell staging restrictions.-deriveLifted :: Q Type -> Q [Dec]-deriveLifted _t = [d|-    instance Lifted $_t where-        (==!)         = (==) `on` primal-        compare1      = compare `on` primal-        maxBound1     = lift maxBound-        minBound1     = lift minBound-        showsPrec1    = showsPrec-        fromInteger1  = lift . fromInteger-        (+!)          = (<+>) -- binary (+) one one-        (-!)          = binary (-) one negOne -- TODO: <-> ? as it is, this might be pretty bad for Tower-        (*!)          = lift2 (*) (\x y -> (y, x))-        negate1       = lift1 negate (const negOne)-        abs1          = lift1 abs signum1-        signum1       = lift1 signum (const zero)-        fromRational1 = lift . fromRational-        (/!)          = lift2 (/) $ \x y -> (recip1 y, x)-        recip1        = lift1 recip (negate1 . square1)--        pi1       = lift pi-        exp1      = lift1_ exp const-        log1      = lift1 log recip1-        logBase1 x y = log1 y /! log1 x-        sqrt1     = lift1_ sqrt (\z _ -> recip1 (lift 2 *! z))-        (**!)     = lift2_ (**) (\z x y -> (y *! z /! x, z *! log1 x)) -- error at 0 ** n-        sin1      = lift1 sin cos1-        cos1      = lift1 cos $ \x -> negate1 (sin1 x)-        tan1 x    = sin1 x /! cos1 x-        asin1     = lift1 asin $ \x -> recip1 (sqrt1 (one -! square1 x))-        acos1     = lift1 acos $ \x -> negate1 (recip1 (sqrt1 (one -! square1 x)))-        atan1     = lift1 atan $ \x -> recip1 (one +! square1 x)-        sinh1     = lift1 sinh cosh1-        cosh1     = lift1 cosh sinh1-        tanh1 x   = sinh1 x /! cosh1 x-        asinh1    = lift1 asinh $ \x -> recip1 (sqrt1 (one +! square1 x))-        acosh1    = lift1 acosh $ \x -> recip1 (sqrt1 (square1 x -! one))-        atanh1    = lift1 atanh $ \x -> recip1 (one -! square1 x)--        succ1                 = lift1 succ (const one)-        pred1                 = lift1 pred (const one)-        toEnum1               = lift . toEnum-        fromEnum1             = discrete1 fromEnum-        enumFrom1 a           = withPrimal a <$> discrete1 enumFrom a-        enumFromTo1 a b       = withPrimal a <$> discrete2 enumFromTo a b-        enumFromThen1 a b     = zipWith (fromBy a delta) [0..] $ discrete2 enumFromThen a b where delta = b -! a-        enumFromThenTo1 a b c = zipWith (fromBy a delta) [0..] $ discrete3 enumFromThenTo a b c where delta = b -! a--        toRational1      = discrete1 toRational-        floatRadix1      = discrete1 floatRadix-        floatDigits1     = discrete1 floatDigits-        floatRange1      = discrete1 floatRange-        decodeFloat1     = discrete1 decodeFloat-        encodeFloat1 m e = lift (encodeFloat m e)-        isNaN1           = discrete1 isNaN-        isInfinite1      = discrete1 isInfinite-        isDenormalized1  = discrete1 isDenormalized-        isNegativeZero1  = discrete1 isNegativeZero-        isIEEE1          = discrete1 isIEEE-        exponent1 = exponent . primal-        scaleFloat1 n = unary (scaleFloat n) (scaleFloat1 n one)-        significand1 x =  unary significand (scaleFloat1 (- floatDigits1 x) one) x-        atan21 = lift2 atan2 $ \vx vy -> let r = recip1 (square1 vx +! square1 vy) in (vy *! r, negate1 vx *! r)-        properFraction1 a = (w, a `withPrimal` pb) where-             pa = primal a-             (w, pb) = properFraction pa-        truncate1 = discrete1 truncate-        round1    = discrete1 round-        ceiling1  = discrete1 ceiling-        floor1    = discrete1 floor-    |]--varA :: Q Type-varA = varT (mkName "a")---- | Find all the members defined in the 'Lifted' data type-liftedMembers :: Q [String]-liftedMembers = do-    ClassI (ClassD _ _ _ _ ds) <- reify ''Lifted-    return [ nameBase n | SigD n _ <- ds]---- | @'deriveNumeric' f g@ provides the following instances:------ > instance ('Lifted' $f, 'Num' a, 'Enum' a) => 'Enum' ($g a)--- > instance ('Lifted' $f, 'Num' a, 'Eq' a) => 'Eq' ($g a)--- > instance ('Lifted' $f, 'Num' a, 'Ord' a) => 'Ord' ($g a)--- > instance ('Lifted' $f, 'Num' a, 'Bounded' a) => 'Bounded' ($g a)------ > instance ('Lifted' $f, 'Show' a) => 'Show' ($g a)--- > instance ('Lifted' $f, 'Num' a) => 'Num' ($g a)--- > instance ('Lifted' $f, 'Fractional' a) => 'Fractional' ($g a)--- > instance ('Lifted' $f, 'Floating' a) => 'Floating' ($g a)--- > instance ('Lifted' $f, 'RealFloat' a) => 'RealFloat' ($g a)--- > instance ('Lifted' $f, 'RealFrac' a) => 'RealFrac' ($g a)--- > instance ('Lifted' $f, 'Real' a) => 'Real' ($g a)-deriveNumeric :: ([Q Pred] -> [Q Pred]) -> Q Type -> Q [Dec]-deriveNumeric f t = do-    members <- liftedMembers-    let keep n = nameBase n `elem` members-    xs <- lowerInstance keep ((classP ''Num [varA]:) . f) t `mapM` [''Enum, ''Eq, ''Ord, ''Bounded]-    ys <- lowerInstance keep f                            t `mapM` [''Show, ''Num, ''Fractional, ''Floating, ''RealFloat,''RealFrac, ''Real]-    return (xs ++ ys)--lowerInstance :: (Name -> Bool) -> ([Q Pred] -> [Q Pred]) -> Q Type -> Name -> Q Dec-lowerInstance p f t n = do-    ClassI (ClassD _ _ _ _ ds) <- reify n-    instanceD (cxt (f [classP n [varA]]))-              (conT n `appT` (t `appT` varA))-              (concatMap lower1 ds)-    where-        lower1 :: Dec -> [Q Dec]-        lower1 (SigD n' _) | p n'' = [valD (varP n') (normalB (varE n'')) []] where n'' = primed n'-        lower1 _          = []--        primed n' = mkName $ base ++ [prime]-            where-                base = nameBase n'-                h = head base-                prime | isSymbol h || h `elem` "/*-<>" = '!'-                      | otherwise = '1'

@@ -24,13 +24,13 @@     , diff     , diff'     -- * Exposed Types+    , UU, UF, FU, FF     , Direction(..)     , Mode(..)     , AD(..)     ) where  import Prelude hiding (reverse)-import Numeric.AD.Classes import Numeric.AD.Internal import Data.Traversable (Traversable) import qualified Numeric.AD.Reverse as R@@ -48,42 +48,42 @@     | Mixed     deriving (Show, Eq, Ord, Read, Bounded, Enum, Ix) -diff :: Num a => Direction -> (forall s. Mode s => AD s a -> AD s a) -> a -> a+diff :: Num a => Direction -> UU a -> a -> a diff Forward = F.diff diff Reverse = R.diff diff Tower = T.diff diff Mixed = F.diff {-# INLINE diff #-} -diff' :: Num a => Direction -> (forall s. Mode s => AD s a -> AD s a) -> a -> (a, a)+diff' :: Num a => Direction -> UU a -> a -> (a, a) diff' Forward = F.diff' diff' Reverse = R.diff' diff' Tower = T.diff' diff' Mixed = F.diff' {-# INLINE diff' #-} -jacobian :: (Traversable f, Traversable g, Num a) => Direction -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f a)+jacobian :: (Traversable f, Traversable g, Num a) => Direction -> FF f g a -> f a -> g (f a) jacobian Forward = F.jacobian jacobian Reverse = R.jacobian jacobian Tower = F.jacobian -- error "jacobian Tower: unimplemented" jacobian Mixed = M.jacobian {-# INLINE jacobian #-} -jacobian' :: (Traversable f, Traversable g, Num a) => Direction -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f a)+jacobian' :: (Traversable f, Traversable g, Num a) => Direction -> FF f g a -> f a -> g (a, f a) jacobian' Forward = F.jacobian' jacobian' Reverse = R.jacobian' jacobian' Tower = F.jacobian' -- error "jacobian' Tower: unimplemented" jacobian' Mixed = M.jacobian' {-# INLINE jacobian' #-} -grad :: (Traversable f, Num a) => Direction -> (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f a+grad :: (Traversable f, Num a) => Direction -> FU f a -> f a -> f a grad Forward = F.grad grad Reverse = R.grad grad Tower   = F.grad -- error "grad Tower: unimplemented" grad Mixed   = M.grad {-# INLINE grad #-} -grad' :: (Traversable f, Num a) => Direction -> (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (a, f a)+grad' :: (Traversable f, Num a) => Direction -> FU f a -> f a -> (a, f a) grad' Forward = F.grad' grad' Reverse = R.grad' grad' Tower   = F.grad' -- error "grad' Tower: unimplemented"

@@ -44,6 +44,7 @@     , diffM     , diffM'     -- * Exposed Types+    , UU, UF, FU, FF     , AD(..)     , Mode(..)     ) where@@ -51,31 +52,30 @@ import Data.Traversable (Traversable) import Control.Applicative import Control.Monad (liftM)-import Numeric.AD.Classes import Numeric.AD.Internal import Numeric.AD.Internal.Composition import Numeric.AD.Internal.Forward -du :: (Functor f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> a+du :: (Functor f, Num a) => FU f a -> f (a, a) -> a du f = tangent . f . fmap (uncurry bundle) {-# INLINE du #-} -du' :: (Functor f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> (a, a)+du' :: (Functor f, Num a) => FU f a -> f (a, a) -> (a, a) du' f = unbundle . f . fmap (uncurry bundle) {-# INLINE du' #-} -duF :: (Functor f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f (a, a) -> g a+duF :: (Functor f, Functor g, Num a) => FF f g a -> f (a, a) -> g a duF f = fmap tangent . f . fmap (uncurry bundle) {-# INLINE duF #-} -duF' :: (Functor f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f (a, a) -> g (a, a)+duF' :: (Functor f, Functor g, Num a) => FF f g a -> f (a, a) -> g (a, a) duF' f = fmap unbundle . f . fmap (uncurry bundle) {-# INLINE duF' #-}  -- | The 'diff' function calculates the first derivative of a scalar-to-scalar function by forward-mode 'AD' -- -- > diff sin == cos-diff :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> a+diff :: Num a => UU a -> a -> a diff f a = tangent $ apply f a {-# INLINE diff #-} @@ -83,62 +83,62 @@ --  -- > d' sin == sin &&& cos -- > d' f = f &&& d f-diff' :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> (a, a)+diff' :: Num a => UU a -> a -> (a, a) diff' f a = unbundle $ apply f a {-# INLINE diff' #-}  -- | The 'diffF' function calculates the first derivative of scalar-to-nonscalar function by F'orward' 'AD'-diffF :: (Functor f, Num a) => (forall s. Mode s => AD s a -> f (AD s a)) -> a -> f a+diffF :: (Functor f, Num a) => UF f a -> a -> f a diffF f a = tangent <$> apply f a {-# INLINE diffF #-}  -- | The 'diffF'' function calculates the result and first derivative of a scalar-to-non-scalar function by F'orward' 'AD'-diffF' :: (Functor f, Num a) => (forall s. Mode s => AD s a -> f (AD s a)) -> a -> f (a, a)+diffF' :: (Functor f, Num a) => UF f a -> a -> f (a, a) diffF' f a = unbundle <$> apply f a {-# INLINE diffF' #-}  -- | The 'dUM' function calculates the first derivative of scalar-to-scalar monadic function by F'orward' 'AD'-diffM :: (Monad m, Num a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> m a+diffM :: (Monad m, Num a) => UF m a -> a -> m a diffM f a = tangent `liftM` apply f a {-# INLINE diffM #-}  -- | The 'd'UM' function calculates the result and first derivative of a scalar-to-scalar monadic function by F'orward' 'AD'-diffM' :: (Monad m, Num a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> m (a, a)+diffM' :: (Monad m, Num a) => UF m a -> a -> m (a, a) diffM' f a = unbundle `liftM` apply f a {-# INLINE diffM' #-}  -- | A fast, simple transposed Jacobian computed with forward-mode AD.-jacobianT :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> f (g a)+jacobianT :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> f (g a) jacobianT f = bind (fmap tangent . f) {-# INLINE jacobianT #-}  -- | A fast, simple transposed Jacobian computed with forward-mode AD.-jacobianWithT :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> f (g b)+jacobianWithT :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> FF f g a -> f a -> f (g b) jacobianWithT g f = bindWith g' f     where g' a ga = g a . tangent <$> ga {-# INLINE jacobianWithT #-} -jacobian :: (Traversable f, Traversable g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f a)+jacobian :: (Traversable f, Traversable g, Num a) => FF f g a -> f a -> g (f a) jacobian f as = transposeWith (const id) t p     where         (p, t) = bind' (fmap tangent . f) as {-# INLINE jacobian #-} -jacobianWith :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f b)+jacobianWith :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> FF f g a -> f a -> 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, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f a)+jacobian' :: (Traversable f, Traversable g, Num a) => FF f g a -> f a -> g (a, f a) 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, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f b)+jacobianWith' :: (Traversable f, Traversable g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (a, f b) jacobianWith' g f as = transposeWith row t p     where         (p, t) = bindWith' g' f as@@ -146,33 +146,33 @@         g' a ga = g a . tangent <$> ga {-# INLINE jacobianWith' #-} -grad :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f a+grad :: (Traversable f, Num a) => FU f a -> f a -> f a grad f = bind (tangent . f) {-# INLINE grad #-} -grad' :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (a, f a)+grad' :: (Traversable f, Num a) => FU f a -> f a -> (a, f a) grad' f as = (primal b, tangent <$> bs)     where         (b, bs) = bind' f as {-# INLINE grad' #-} -gradWith :: (Traversable f, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f b+gradWith :: (Traversable f, Num a) => (a -> a -> b) -> FU f a -> f a -> f b gradWith g f = bindWith g (tangent . f) {-# INLINE gradWith #-} -gradWith' :: (Traversable f, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (a, f b)+gradWith' :: (Traversable f, Num a) => (a -> a -> b) -> FU f a -> f a -> (a, f b) gradWith' g f = bindWith' g (tangent . f) {-# INLINE gradWith' #-}  -- | Compute the product of a vector with the Hessian using forward-on-forward-mode AD. -hessianProduct :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> f a+hessianProduct :: (Traversable f, Num a) => FU f a -> f (a, a) -> f a hessianProduct f = duF $ grad $ decomposeMode . f . fmap composeMode  -- | Compute the gradient and hessian product using forward-on-forward-mode AD. -hessianProduct' :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> f (a, a)+hessianProduct' :: (Traversable f, Num a) => FU f a -> f (a, a) -> f (a, a) hessianProduct' f = duF' $ grad $ decomposeMode . f . fmap composeMode  -- * Experimental  -- data f :> a = a :< f (f :> a)--- gradients :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (f :> a)+-- gradients :: (Traversable f, Num a) => FU f a -> f a -> (f :> a)

@@ -1,4 +1,5 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, TemplateHaskell, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.AD.Internal@@ -10,7 +11,9 @@ -- ----------------------------------------------------------------------------- module Numeric.AD.Internal-    ( zipWithT+    ( module Numeric.AD.Internal.Classes+    , UU, UF, FU, FF+    , zipWithT     , zipWithDefaultT     , on     , AD(..)@@ -24,10 +27,15 @@  import Control.Applicative import Language.Haskell.TH-import Numeric.AD.Classes+import Numeric.AD.Internal.Classes import Data.Monoid import Data.Traversable (Traversable, mapAccumL) import Data.Foldable (Foldable, toList)++type UU a = forall s. Mode s => AD s a -> AD s a+type UF f a = forall s. Mode s => AD s a -> f (AD s a)+type FU f a = forall s. Mode s => f (AD s a) -> AD s a+type FF f g a = forall s. Mode s => f (AD s a) -> g (AD s a)  on :: (a -> a -> b) -> (c -> a) -> c -> c -> b on f g a b = f (g a) (g b)

@@ -0,0 +1,293 @@+{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, FunctionalDependencies, UndecidableInstances, GeneralizedNewtypeDeriving, TemplateHaskell #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.AD.Internal.Classes+-- Copyright   :  (c) Edward Kmett 2010+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  GHC only+--+-----------------------------------------------------------------------------++module Numeric.AD.Internal.Classes+    (+    -- * AD modes+      Mode(..)+    , one+    -- * Automatically Deriving AD+    , Jacobian(..)+    , Primal(..)+    , deriveLifted+    , deriveNumeric+    , Lifted(..)+    ) where++import Control.Applicative+import Data.Char+import Language.Haskell.TH++infixl 8 **!+infixl 7 *!, /!, ^*, *^, ^/+infixl 6 +!, -!, <+>+infix 4 ==!++class Lifted t where+    showsPrec1          :: Show a => Int -> t a -> ShowS+    (==!)               :: (Num a, Eq a) => t a -> t a -> Bool+    compare1            :: (Num a, Ord a) => t a -> t a -> Ordering+    fromInteger1        :: Num a => Integer -> t a+    (+!),(-!),(*!)      :: Num a => t a -> t a -> t a+    negate1, abs1, signum1 :: Num a => t a -> t a+    (/!)                :: Fractional a => t a -> t a -> t a+    recip1              :: Fractional a => t a -> t a+    fromRational1       :: Fractional a => Rational -> t a+    toRational1         :: Real a => t a -> Rational -- unsafe+    pi1                 :: Floating a => t a+    exp1, log1, sqrt1   :: Floating a => t a -> t a+    (**!), logBase1     :: Floating a => t a -> t a -> t a+    sin1, cos1, tan1, asin1, acos1, atan1 :: Floating a => t a -> t a+    sinh1, cosh1, tanh1, asinh1, acosh1, atanh1 :: Floating a => t a -> t a+    properFraction1 :: (RealFrac a, Integral b) => t a -> (b, t a)+    truncate1, round1, ceiling1, floor1 :: (RealFrac a, Integral b) => t a -> b+    floatRadix1     :: RealFloat a => t a -> Integer+    floatDigits1    :: RealFloat a => t a -> Int+    floatRange1     :: RealFloat a => t a -> (Int, Int)+    decodeFloat1    :: RealFloat a => t a -> (Integer, Int)+    encodeFloat1    :: RealFloat a => Integer -> Int -> t a+    exponent1       :: RealFloat a => t a -> Int+    significand1    :: RealFloat a => t a -> t a+    scaleFloat1     :: RealFloat a => Int -> t a -> t a+    isNaN1, isInfinite1, isDenormalized1, isNegativeZero1, isIEEE1 :: RealFloat a => t a -> Bool+    atan21          :: RealFloat a => t a -> t a -> t a+    succ1, pred1    :: (Num a, Enum a) => t a -> t a+    toEnum1         :: (Num a, Enum a) => Int -> t a+    fromEnum1       :: (Num a, Enum a) => t a -> Int+    enumFrom1       :: (Num a, Enum a) => t a -> [t a]+    enumFromThen1   :: (Num a, Enum a) => t a -> t a -> [t a]+    enumFromTo1     :: (Num a, Enum a) => t a -> t a -> [t a]+    enumFromThenTo1 :: (Num a, Enum a) => t a -> t a -> t a -> [t a]+    minBound1       :: (Num a, Bounded a) => t a+    maxBound1       :: (Num a, Bounded a) => t a++class Lifted t => Mode t where++    -- | Embed a constant+    lift  :: Num a => a -> t a++    -- | Vector sum+    (<+>) :: Num a => t a -> t a -> t a++    -- | Scalar-vector multiplication+    (*^) :: Num a => a -> t a -> t a++    -- | Vector-scalar multiplication+    (^*) :: Num a => t a -> a -> t a++    -- | Scalar division+    (^/) :: Fractional a => t a -> a -> t a++    -- | > 'zero' = 'lift' 0+    zero :: Num a => t a++    a *^ b = lift a *! b+    a ^* b = a *! lift b++    a ^/ b = a ^* recip b++    zero = lift 0++one :: (Mode t, Num a) => t a+one = lift 1+{-# INLINE one #-}++negOne :: (Mode t, Num a) => t a+negOne = lift (-1)+{-# INLINE negOne #-}++-- | 'Primal' is used by 'deriveMode' but is not exposed+-- via the 'Mode' class to prevent its abuse by end users+-- via the AD data type.+--+-- It provides direct access to the result, stripped of its derivative information,+-- but this is unsafe in general as (lift . primal) would discard derivative+-- information. The end user is protected from accidentally using this function+-- by the universal quantification on the various combinators we expose.++class Primal t where+    primal :: Num a => t a -> a++-- | 'Jacobian' is used by 'deriveMode' but is not exposed+-- via 'Mode' to prevent its abuse by end users+-- via the 'AD' data type.+class (Mode t, Mode (D t)) => Jacobian t where+    type D t :: * -> *++    unary  :: Num a => (a -> a) -> D t a -> t a -> t a+    lift1  :: Num a => (a -> a) -> (D t a -> D t a) -> t a -> t a+    lift1_ :: Num a => (a -> a) -> (D t a -> D t a -> D t a) -> t a -> t a++    binary :: Num a => (a -> a -> a) -> D t a -> D t a -> t a -> t a -> t a+    lift2  :: Num a => (a -> a -> a) -> (D t a -> D t a -> (D t a, D t a)) -> t a -> t a -> t a+    lift2_ :: Num a => (a -> a -> a) -> (D t a -> D t a -> D t a -> (D t a, D t a)) -> t a -> t a -> t a++withPrimal :: (Jacobian t, Num a) => t a -> a -> t a+withPrimal t a = unary (const a) one t+{-# INLINE withPrimal #-}++fromBy :: (Jacobian t, Num a) => t a -> t a -> Int -> a -> t a+fromBy a delta n x = binary (\_ _ -> x) one (fromIntegral1 n) a delta++fromIntegral1 :: (Integral n, Lifted t, Num a) => n -> t a+fromIntegral1 = fromInteger1 . fromIntegral+{-# INLINE fromIntegral1 #-}++square1 :: (Lifted t, Num a) => t a -> t a+square1 x = x *! x+{-# INLINE square1 #-}++on :: (a -> a -> c) -> (b -> a) -> b -> b -> c+on f g a b = f (g a) (g b)++discrete1 :: (Primal t, Num a) => (a -> c) -> t a -> c+discrete1 f x = f (primal x)+{-# INLINE discrete1 #-}++discrete2 :: (Primal t, Num a) => (a -> a -> c) -> t a -> t a -> c+discrete2 f x y = f (primal x) (primal y)+{-# INLINE discrete2 #-}++discrete3 :: (Primal t, Num a) => (a -> a -> a -> d) -> t a -> t a -> t a -> d+discrete3 f x y z = f (primal x) (primal y) (primal z)+{-# INLINE discrete3 #-}++-- | @'deriveLifted' t@ provides+--+-- > instance Lifted $t+--+-- given supplied instances for+--+-- > instance Lifted $t => Primal $t where ...+-- > instance Lifted $t => Jacobian $t where ...+--+-- The seemingly redundant @'Lifted' $t@ constraints are caused by Template Haskell staging restrictions.+deriveLifted :: Q Type -> Q [Dec]+deriveLifted _t = [d|+    instance Lifted $_t where+        (==!)         = (==) `on` primal+        compare1      = compare `on` primal+        maxBound1     = lift maxBound+        minBound1     = lift minBound+        showsPrec1    = showsPrec+        fromInteger1  = lift . fromInteger+        (+!)          = (<+>) -- binary (+) one one+        (-!)          = binary (-) one negOne -- TODO: <-> ? as it is, this might be pretty bad for Tower+        (*!)          = lift2 (*) (\x y -> (y, x))+        negate1       = lift1 negate (const negOne)+        abs1          = lift1 abs signum1+        signum1       = lift1 signum (const zero)+        fromRational1 = lift . fromRational+        (/!)          = lift2 (/) $ \x y -> (recip1 y, x)+        recip1        = lift1 recip (negate1 . square1)++        pi1       = lift pi+        exp1      = lift1_ exp const+        log1      = lift1 log recip1+        logBase1 x y = log1 y /! log1 x+        sqrt1     = lift1_ sqrt (\z _ -> recip1 (lift 2 *! z))+        (**!)     = lift2_ (**) (\z x y -> (y *! z /! x, z *! log1 x)) -- error at 0 ** n+        sin1      = lift1 sin cos1+        cos1      = lift1 cos $ \x -> negate1 (sin1 x)+        tan1 x    = sin1 x /! cos1 x+        asin1     = lift1 asin $ \x -> recip1 (sqrt1 (one -! square1 x))+        acos1     = lift1 acos $ \x -> negate1 (recip1 (sqrt1 (one -! square1 x)))+        atan1     = lift1 atan $ \x -> recip1 (one +! square1 x)+        sinh1     = lift1 sinh cosh1+        cosh1     = lift1 cosh sinh1+        tanh1 x   = sinh1 x /! cosh1 x+        asinh1    = lift1 asinh $ \x -> recip1 (sqrt1 (one +! square1 x))+        acosh1    = lift1 acosh $ \x -> recip1 (sqrt1 (square1 x -! one))+        atanh1    = lift1 atanh $ \x -> recip1 (one -! square1 x)++        succ1                 = lift1 succ (const one)+        pred1                 = lift1 pred (const one)+        toEnum1               = lift . toEnum+        fromEnum1             = discrete1 fromEnum+        enumFrom1 a           = withPrimal a <$> discrete1 enumFrom a+        enumFromTo1 a b       = withPrimal a <$> discrete2 enumFromTo a b+        enumFromThen1 a b     = zipWith (fromBy a delta) [0..] $ discrete2 enumFromThen a b where delta = b -! a+        enumFromThenTo1 a b c = zipWith (fromBy a delta) [0..] $ discrete3 enumFromThenTo a b c where delta = b -! a++        toRational1      = discrete1 toRational+        floatRadix1      = discrete1 floatRadix+        floatDigits1     = discrete1 floatDigits+        floatRange1      = discrete1 floatRange+        decodeFloat1     = discrete1 decodeFloat+        encodeFloat1 m e = lift (encodeFloat m e)+        isNaN1           = discrete1 isNaN+        isInfinite1      = discrete1 isInfinite+        isDenormalized1  = discrete1 isDenormalized+        isNegativeZero1  = discrete1 isNegativeZero+        isIEEE1          = discrete1 isIEEE+        exponent1 = exponent . primal+        scaleFloat1 n = unary (scaleFloat n) (scaleFloat1 n one)+        significand1 x =  unary significand (scaleFloat1 (- floatDigits1 x) one) x+        atan21 = lift2 atan2 $ \vx vy -> let r = recip1 (square1 vx +! square1 vy) in (vy *! r, negate1 vx *! r)+        properFraction1 a = (w, a `withPrimal` pb) where+             pa = primal a+             (w, pb) = properFraction pa+        truncate1 = discrete1 truncate+        round1    = discrete1 round+        ceiling1  = discrete1 ceiling+        floor1    = discrete1 floor+    |]++varA :: Q Type+varA = varT (mkName "a")++-- | Find all the members defined in the 'Lifted' data type+liftedMembers :: Q [String]+liftedMembers = do+    ClassI (ClassD _ _ _ _ ds) <- reify ''Lifted+    return [ nameBase n | SigD n _ <- ds]++-- | @'deriveNumeric' f g@ provides the following instances:+--+-- > instance ('Lifted' $f, 'Num' a, 'Enum' a) => 'Enum' ($g a)+-- > instance ('Lifted' $f, 'Num' a, 'Eq' a) => 'Eq' ($g a)+-- > instance ('Lifted' $f, 'Num' a, 'Ord' a) => 'Ord' ($g a)+-- > instance ('Lifted' $f, 'Num' a, 'Bounded' a) => 'Bounded' ($g a)+--+-- > instance ('Lifted' $f, 'Show' a) => 'Show' ($g a)+-- > instance ('Lifted' $f, 'Num' a) => 'Num' ($g a)+-- > instance ('Lifted' $f, 'Fractional' a) => 'Fractional' ($g a)+-- > instance ('Lifted' $f, 'Floating' a) => 'Floating' ($g a)+-- > instance ('Lifted' $f, 'RealFloat' a) => 'RealFloat' ($g a)+-- > instance ('Lifted' $f, 'RealFrac' a) => 'RealFrac' ($g a)+-- > instance ('Lifted' $f, 'Real' a) => 'Real' ($g a)+deriveNumeric :: ([Q Pred] -> [Q Pred]) -> Q Type -> Q [Dec]+deriveNumeric f t = do+    members <- liftedMembers+    let keep n = nameBase n `elem` members+    xs <- lowerInstance keep ((classP ''Num [varA]:) . f) t `mapM` [''Enum, ''Eq, ''Ord, ''Bounded]+    ys <- lowerInstance keep f                            t `mapM` [''Show, ''Num, ''Fractional, ''Floating, ''RealFloat,''RealFrac, ''Real]+    return (xs ++ ys)++lowerInstance :: (Name -> Bool) -> ([Q Pred] -> [Q Pred]) -> Q Type -> Name -> Q Dec+lowerInstance p f t n = do+    ClassI (ClassD _ _ _ _ ds) <- reify n+    instanceD (cxt (f [classP n [varA]]))+              (conT n `appT` (t `appT` varA))+              (concatMap lower1 ds)+    where+        lower1 :: Dec -> [Q Dec]+        lower1 (SigD n' _) | p n'' = [valD (varP n') (normalB (varE n'')) []] where n'' = primed n'+        lower1 _          = []++        primed n' = mkName $ base ++ [prime]+            where+                base = nameBase n'+                h = head base+                prime | isSymbol h || h `elem` "/*-<>" = '!'+                      | otherwise = '1'

@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, TemplateHaskell, UndecidableInstances, TypeOperators #-}+{-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.AD.Internal.Composition@@ -21,7 +22,6 @@ import Data.Traversable import Control.Applicative import Data.Foldable-import Numeric.AD.Classes import Numeric.AD.Internal  -- * Functor composition@@ -30,10 +30,10 @@  instance (Functor f, Functor g) => Functor (ComposeFunctor f g) where     fmap f (ComposeFunctor a) = ComposeFunctor (fmap (fmap f) a)-    + instance (Foldable f, Foldable g) => Foldable (ComposeFunctor f g) where     foldMap f (ComposeFunctor a) = foldMap (foldMap f) a-    + instance (Traversable f, Traversable g) => Traversable (ComposeFunctor f g) where     traverse f (ComposeFunctor a) = ComposeFunctor <$> traverse (traverse f) a @@ -50,8 +50,8 @@  instance (Mode f, Mode g) => Mode (ComposeMode f g) where     lift = ComposeMode . lift . lift-    ComposeMode a <+> ComposeMode b = ComposeMode (a <+> b) -    a *^ ComposeMode b = ComposeMode (lift a *^ b) +    ComposeMode a <+> ComposeMode b = ComposeMode (a <+> b)+    a *^ ComposeMode b = ComposeMode (lift a *^ b)     ComposeMode a ^* b = ComposeMode (a ^* lift b)     ComposeMode a ^/ b = ComposeMode (a ^/ lift b) @@ -66,13 +66,13 @@     negate1 (ComposeMode a) = ComposeMode (negate1 a)     abs1 (ComposeMode a) = ComposeMode (abs1 a)     signum1 (ComposeMode a) = ComposeMode (signum1 a)-    ComposeMode a /! ComposeMode b = ComposeMode (a /! b) +    ComposeMode a /! ComposeMode b = ComposeMode (a /! b)     recip1 (ComposeMode a) = ComposeMode (recip1 a)     fromRational1 = ComposeMode . lift . fromRational1     toRational1 (ComposeMode a) = toRational1 a     pi1 = ComposeMode pi1     exp1 (ComposeMode a) = ComposeMode (exp1 a)-    log1 (ComposeMode a) = ComposeMode (log1 a) +    log1 (ComposeMode a) = ComposeMode (log1 a)     sqrt1 (ComposeMode a) = ComposeMode (sqrt1 a)     ComposeMode a **! ComposeMode b = ComposeMode (a **! b)     logBase1 (ComposeMode a) (ComposeMode b) = ComposeMode (logBase1 a b)@@ -102,7 +102,7 @@     exponent1 (ComposeMode a) = exponent1 a     significand1 (ComposeMode a) = ComposeMode (significand1 a)     scaleFloat1 n (ComposeMode a) = ComposeMode (scaleFloat1 n a)-    isNaN1 (ComposeMode a) = isNaN1 a +    isNaN1 (ComposeMode a) = isNaN1 a     isInfinite1 (ComposeMode a) = isInfinite1 a     isDenormalized1 (ComposeMode a) = isDenormalized1 a     isNegativeZero1 (ComposeMode a) = isNegativeZero1 a@@ -119,4 +119,4 @@     minBound1 = ComposeMode minBound1     maxBound1 = ComposeMode maxBound1 --- deriveNumeric (conT `appT` varT (mkName "f") `appT` varT (mkName "g")) +-- deriveNumeric (conT `appT` varT (mkName "f") `appT` varT (mkName "g"))

@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types, TypeFamilies, DeriveDataTypeable, TemplateHaskell, UndecidableInstances, BangPatterns #-}+{-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.AD.Internal.Forward@@ -32,7 +33,6 @@ import Data.Foldable (Foldable, toList) import Data.Data import Control.Applicative-import Numeric.AD.Classes import Numeric.AD.Internal  data Forward a = Forward a a deriving (Show, Data, Typeable)

@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types, TypeFamilies, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, TemplateHaskell, UndecidableInstances #-}+{-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- | -- Module      :  Numeric.AD.Internal.Reverse@@ -47,8 +48,6 @@ import Data.Traversable (Traversable, mapM) import System.IO.Unsafe (unsafePerformIO) import Language.Haskell.TH--import Numeric.AD.Classes import Numeric.AD.Internal  -- | A @Tape@ records the information needed back propagate from the output to each input during 'Reverse' 'Mode' AD.

@@ -0,0 +1,144 @@+{-# LANGUAGE TypeOperators, TemplateHaskell, ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Numeric.AD.Internal.Stream+-- Copyright   :  (c) Edward Kmett 2010+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  GHC only+--+-- A cofree comonad/f-branching stream  for use in returning towers of gradients. +--+-----------------------------------------------------------------------------++module Numeric.AD.Internal.Stream +    ( (:>)(..)+    , Comonad(..)+    , unfold+    , tails+    ) where++import Control.Applicative+import Data.Monoid+import Data.Foldable+import Data.Traversable+import Numeric.AD.Internal+import Language.Haskell.TH++infixl 3 :<, :>++class Functor f => Comonad f where+    extract :: (f :> a) -> a+    duplicate :: (f :> a) -> (f :> (f :> a))+    extend :: ((f :> a) -> b) -> (f :> a) -> (f :> b)++data (f :> a) = a :< f (f :> a)++instance Functor f => Functor ((:>)f) where+    fmap f (a :< as) = f a :< fmap f <$> as++instance Functor f => Comonad ((:>) f) where+    extract (a :< _) = a+    duplicate aas@(_ :< as) = aas :< duplicate <$> as+    extend f aas@(_ :< as) = f aas :< extend f <$> as++instance Foldable f => Foldable ((:>) f) where+    foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as++instance Traversable f => Traversable ((:>) f) where+    traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as++-- tails of the f-branching stream comonad/cofree comonad+tails :: (f :> a) -> f (f :> a)+tails (_ :< as) = as++unfold :: Functor f => (a -> (b, f a)) -> a -> (f :> b)+unfold f a = h :< unfold f <$> t +    where+        (h, t) = f a++instance Primal ((:>) f) where+    primal (a :< _) = a++instance Mode f => Mode ((:>) f) where+    lift a = as+        where as = a :< lift as+    (a :< as) <+> (b :< bs) = (a + b) :< (as <+> bs)+    a *^ (b :< bs) = (a * b) :< (lift a *^ bs)+    (a :< as) ^* b = (a * b) :< (as ^* lift b)+    (a :< as) ^/ b = (a / b) :< (as ^/ lift b)++instance Mode f => Lifted ((:>) f) where+    showsPrec1 n (a :< _) = showsPrec n a+    (==!) = (==) `on` primal+    compare1 = compare `on` primal+    fromInteger1 a = fromInteger a :< fromInteger1 a+    (a :< as) +! (b :< bs) = (a + b) :< (as +! bs)+    (a :< as) -! (b :< bs) = (a - b) :< (as -! bs)+    (a :< as) *! (b :< bs) = (a * b) :< (as *! bs)+    negate1 (a :< as) = negate a :< negate1 as+    abs1 (a :< as) = abs a :< abs1 as+    signum1 (a :< as) = signum a :< signum1 as+    (a :< as) /! (b :< bs) = (a / b) :< (as /! bs)+    recip1 (a :< as) = recip a :< recip1 as+    fromRational1 n = fromRational n :< fromRational1 n+    toRational1 = toRational . primal+    pi1 = pi :< pi1+    exp1 (a :< as) = exp a :< exp1 as+    log1 (a :< as) = log a :< log1 as+    sqrt1 (a :< as) = sqrt a :< sqrt1 as+    (a :< as) **! (b :< bs) = (a ** b) :< (as **! bs)+    logBase1 (a :< as) (b :< bs) = logBase a b :< logBase1 as bs+    sin1 (a :< as) = sin a :< sin1 as+    cos1 (a :< as) = cos a :< cos1 as+    tan1 (a :< as) = tan a :< tan1 as+    asin1 (a :< as) = asin a :< asin1 as+    acos1 (a :< as) = acos a :< acos1 as+    atan1 (a :< as) = atan a :< atan1 as+    sinh1 (a :< as) = sinh a :< sinh1 as+    cosh1 (a :< as) = cosh a :< cosh1 as+    tanh1 (a :< as) = tanh a :< tanh1 as+    asinh1 (a :< as) = asinh a :< asinh1 as+    acosh1 (a :< as) = acosh a :< acosh1 as+    atanh1 (a :< as) = atanh a :< atanh1 as+    properFraction1 (a :< as) = (b, c :< cs) +        where+            (b, c) = properFraction a+            (_ :: Int, cs) = properFraction1 as+    truncate1 = truncate . primal+    round1 = round . primal+    ceiling1 = ceiling . primal +    floor1  = floor . primal +    floatRadix1 = floatRadix . primal+    floatDigits1 = floatDigits . primal+    floatRange1 = floatRange . primal+    decodeFloat1 = decodeFloat . primal+    encodeFloat1 m e = encodeFloat m e :< encodeFloat1 m e+    exponent1 = exponent . primal +    significand1 (a :< as) = significand a :< significand1 as+    scaleFloat1 n (a :< as) = scaleFloat n a :< scaleFloat1 n as+    isNaN1 = isNaN . primal +    isInfinite1 = isInfinite . primal+    isDenormalized1 = isDenormalized . primal +    isNegativeZero1 = isNegativeZero . primal +    isIEEE1 = isIEEE . primal +    atan21 (a :< as) (b :< bs) = atan2 a b :< atan21 as bs+    succ1 (a :< as) = succ a :< succ1 as+    pred1 (a :< as) = pred a :< pred1 as+    toEnum1 n = toEnum n :< toEnum1 n+    fromEnum1 = fromEnum . primal+    enumFrom1 = error "TODO"+    enumFromThen1 = error "TODO"+    enumFromTo1 = error "TODO"+    enumFromThenTo1 = error "TODO"+    minBound1 = minBound :< minBound1+    maxBound1 = maxBound :< maxBound1+    -- TODO:+++-- instance (Mode f, Foo a) => Foo ((:>) f) ...+deriveNumeric +    (classP (mkName "Mode") [varT $ mkName "f"]:) +    (conT (mkName ":>") `appT` varT (mkName "f")) 

@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types, TypeFamilies, FlexibleContexts, UndecidableInstances, TemplateHaskell #-}+{-# OPTIONS_HADDOCK hide, prune #-} ----------------------------------------------------------------------------- -- | -- Module      : Numeric.AD.Tower.Internal@@ -29,7 +30,6 @@ import Control.Applicative import Data.Foldable import Language.Haskell.TH-import Numeric.AD.Classes import Numeric.AD.Internal  -- | @Tower@ is an AD 'Mode' that calculates a tangent tower by forward AD, and provides fast 'diffsUU', 'diffsUF'

@@ -27,6 +27,7 @@     , gradientAscent     , gradientAscentM     -- * Exposed Types+    , UU, UF, FU, FF     , AD(..)     , Mode(..)     ) where@@ -34,7 +35,6 @@ import Prelude hiding (all) import Control.Monad (liftM) import Data.MList-import Numeric.AD.Classes import Numeric.AD.Internal import Data.Foldable (all) import Data.Traversable (Traversable)@@ -53,7 +53,7 @@ --  > module Data.Complex --  > take 10 $ findZero ((+1).(^2)) (1 :+ 1)  -- converge to (0 :+ 1)@ ---findZero :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+findZero :: Fractional a => UU a -> a -> [a] findZero f = go     where         go x = x : go (x - y/y') @@ -61,7 +61,7 @@                 (y,y') = diff' f x {-# INLINE findZero #-} -findZeroM :: (Monad m, Fractional a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> MList m a+findZeroM :: (Monad m, Fractional a) => UF m a -> a -> MList m a findZeroM f x0 = MList (go x0)     where         go x = return $ @@ -79,11 +79,11 @@ -- -- > take 10 $ inverseNewton sqrt 1 (sqrt 10)  -- converges to 10 ---inverse :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> a -> [a]+inverse :: Fractional a => UU a -> a -> a -> [a] inverse f x0 y = findZero (\x -> f x - lift y) x0 {-# INLINE inverse  #-} -inverseM :: (Monad m, Fractional a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> a -> MList m a+inverseM :: (Monad m, Fractional a) => UF m a -> a -> a -> MList m a inverseM f x0 y = findZeroM (\x -> subtract (lift y) `liftM` f x) x0 {-# INLINE inverseM  #-} @@ -92,11 +92,11 @@ -- increasingly accurate results.  (Modulo the usual caveats.) --  -- > take 10 $ fixedPoint cos 1 -- converges to 0.7390851332151607-fixedPoint :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+fixedPoint :: Fractional a => UU a -> a -> [a] fixedPoint f = findZero (\x -> f x - x) {-# INLINE fixedPoint #-} -fixedPointM :: (Monad m, Fractional a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> MList m a+fixedPointM :: (Monad m, Fractional a) => UF m a -> a -> MList m a fixedPointM f = findZeroM (\x -> subtract x `liftM` f x) {-# INLINE fixedPointM #-} @@ -105,11 +105,11 @@ -- accurate results.  (Modulo the usual caveats.) -- -- > take 10 $ extremum cos 1 -- convert to 0 -extremum :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+extremum :: Fractional a => UU a -> a -> [a] extremum f = findZero (diff (decomposeMode . f . composeMode)) {-# INLINE extremum #-} -extremumM :: (Monad m, Fractional a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> MList m a+extremumM :: (Monad m, Fractional a) => UF m a -> a -> MList m a extremumM f = findZeroM (diffM (liftM decomposeMode . f . composeMode)) {-# INLINE extremumM #-} @@ -120,7 +120,7 @@ -- increasingly accurate results.  (Modulo the usual caveats.) -- -- It uses reverse mode automatic differentiation to compute the gradient.-gradientDescent :: (Traversable f, Fractional a, Ord a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> [f a]+gradientDescent :: (Traversable f, Fractional a, Ord a) => FU f a -> f a -> [f a] gradientDescent f x0 = go x0 fx0 xgx0 0.1 (0 :: Int)     where         (fx0, xgx0) = gradWith' (,) f x0@@ -137,12 +137,12 @@                 (fx1, xgx1) = gradWith' (,) f x1 {-# INLINE gradientDescent #-} -gradientAscent :: (Traversable f, Fractional a, Ord a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> [f a]+gradientAscent :: (Traversable f, Fractional a, Ord a) => FU f a -> f a -> [f a] gradientAscent f = gradientDescent (negate . f) {-# INLINE gradientAscent #-}  -- monadic gradient descent-gradientDescentM :: (Traversable f, Monad m, Fractional a, Ord a) => (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> MList m (f a)+gradientDescentM :: (Traversable f, Monad m, Fractional a, Ord a) => FF f m a -> f a -> MList m (f a) gradientDescentM f x0 = MList $ do         (fx0, xgx0) <- gradWithM' (,) f x0         go x0 fx0 xgx0 0.1 (0 :: Int)@@ -165,6 +165,6 @@                 zeroGrad = all (\(_,g) -> g == 0) {-# INLINE gradientDescentM #-} -gradientAscentM :: (Traversable f, Monad m, Fractional a, Ord a) => (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> MList m (f a)+gradientAscentM :: (Traversable f, Monad m, Fractional a, Ord a) => FF f m a -> f a -> MList m (f a) gradientAscentM f = gradientDescentM (liftM negate . f) {-# INLINE gradientAscentM #-}

@@ -52,6 +52,7 @@     , gradWithF     , gradWithF'     -- * Exposed Types+    , UU, UF, FU, FF     , AD(..)     , Mode(..)     ) where@@ -60,19 +61,18 @@ import Control.Applicative (WrappedMonad(..),(<$>)) import Data.Traversable (Traversable) -import Numeric.AD.Classes import Numeric.AD.Internal import Numeric.AD.Internal.Composition import Numeric.AD.Internal.Reverse  -- | The 'grad' function calculates the gradient of a non-scalar-to-scalar function with 'Reverse' AD in a single pass.-grad :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f a+grad :: (Traversable f, Num a) => FU f a -> f a -> f a grad f as = unbind vs (partialArray bds $ f vs)     where (vs,bds) = bind as {-# INLINE grad #-}  -- | The 'grad'' function calculates the result and gradient of a non-scalar-to-scalar function with 'Reverse' AD in a single pass.-grad' :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (a, f a)+grad' :: (Traversable f, Num a) => FU f a -> f a -> (a, f a) grad' f as = (primal r, unbind vs $ partialArray bds r)     where (vs, bds) = bind as           r = f vs@@ -83,7 +83,7 @@ -- -- > grad == gradWith (\_ dx -> dx) -- > id == gradWith const-gradWith :: (Traversable f, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f b+gradWith :: (Traversable f, Num a) => (a -> a -> b) -> FU f a -> f a -> f b gradWith g f as = unbindWith g vs (partialArray bds $ f vs)     where (vs,bds) = bind as {-# INLINE gradWith #-}@@ -92,31 +92,31 @@ -- the gradient is combined element-wise with the argument using the function @g@. -- -- > grad' == gradWith' (\_ dx -> dx)-gradWith' :: (Traversable f, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (a, f b)+gradWith' :: (Traversable f, Num a) => (a -> a -> b) -> FU f a -> f a -> (a, f b) gradWith' g f as = (primal r, unbindWith g vs $ partialArray bds r)     where (vs, bds) = bind as           r = f vs {-# INLINE gradWith' #-}  -- | The 'gradF' function calculates the jacobian of a non-scalar-to-non-scalar function with reverse AD lazily in @m@ passes for @m@ outputs.-gradF :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f a)+gradF :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> g (f a) gradF = jacobian {-# INLINE gradF #-}  -- | An alias for 'gradF'-jacobian :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f a)+jacobian :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> g (f a) jacobian f as = unbind vs . partialArray bds <$> f vs where     (vs, bds) = bind as {-# INLINE jacobian #-}  -- | The 'gradF'' function calculates both the result and the Jacobian of a nonscalar-to-nonscalar function, using @m@ invocations of reverse AD, -- where @m@ is the output dimensionality. Applying @fmap snd@ to the result will recover the result of 'gradF'-gradF' :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f a)+gradF' :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> g (a, f a) gradF' = jacobian'  {-# INLINE gradF' #-}  -- | An alias for 'gradF''-jacobian' :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f a)+jacobian' :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> g (a, f a) jacobian' f as = row <$> f vs where     (vs, bds) = bind as     row a = (primal a, unbind vs (partialArray bds a))@@ -129,13 +129,13 @@ -- > gradF == gradWithF (\_ dx -> dx) -- > gradWithF const == (\f x -> const x <$> f x) ---gradWithF :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f b)+gradWithF :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (f b) gradWithF g f as = unbindWith g vs . partialArray bds <$> f vs where     (vs, bds) = bind as {-# INLINE gradWithF #-}  -- | An alias for 'gradWithF'.-jacobianWith :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f b)+jacobianWith :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (f b) jacobianWith = gradWithF  {-# INLINE jacobianWith #-} @@ -146,73 +146,73 @@ -- -- > jacobian' == gradWithF' (\_ dx -> dx) ---gradWithF' :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f b)+gradWithF' :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (a, f b) gradWithF' g f as = row <$> f vs where     (vs, bds) = bind as     row a = (primal a, unbindWith g vs (partialArray bds a)) {-# INLINE gradWithF' #-}  -- | An alias for 'gradWithF''-jacobianWith' :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (a, f b)+jacobianWith' :: (Traversable f, Functor g, Num a) => (a -> a -> b) -> FF f g a -> f a -> g (a, f b) jacobianWith' = gradWithF' {-# INLINE jacobianWith' #-} -diff :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> a+diff :: Num a => UU a -> a -> a diff f a = derivative $ f (var a 0) {-# INLINE diff #-}  -- | The 'd'' function calculates the value and derivative, as a -- pair, of a scalar-to-scalar function.-diff' :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> (a, a)+diff' :: Num a => UU a -> a -> (a, a) diff' f a = derivative' $ f (var a 0) {-# INLINE diff' #-} -diffF :: (Functor f, Num a) => (forall s. Mode s => AD s a -> f (AD s a)) -> a -> f a+diffF :: (Functor f, Num a) => UF f a -> a -> f a diffF f a = derivative <$> f (var a 0) {-# INLINE diffF #-} -diffF' :: (Functor f, Num a) => (forall s. Mode s => AD s a -> f (AD s a)) -> a -> f (a, a)+diffF' :: (Functor f, Num a) => UF f a -> a -> f (a, a) diffF' f a = derivative' <$> f (var a 0) {-# INLINE diffF' #-}  -- * Monadic Combinators -diffM :: (Monad m, Num a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> m a+diffM :: (Monad m, Num a) => UF m a -> a -> m a diffM f a = liftM derivative $ f (var a 0) {-# INLINE diffM #-} -diffM' :: (Monad m, Num a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> m (a, a)+diffM' :: (Monad m, Num a) => UF m a -> a -> m (a, a) diffM' f a = liftM derivative' $ f (var a 0) {-# INLINE diffM' #-} -gradM :: (Traversable f, Monad m, Num a) => (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> m (f a)+gradM :: (Traversable f, Monad m, Num a) => FF f m a -> f a -> m (f a) gradM f = unwrapMonad . jacobian (WrapMonad . f) {-# INLINE gradM #-} -gradM' :: (Traversable f, Monad m, Num a) => (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> m (a, f a)+gradM' :: (Traversable f, Monad m, Num a) => FF f m a -> f a -> m (a, f a) gradM' f = unwrapMonad . jacobian' (WrapMonad . f) {-# INLINE gradM' #-} -gradWithM :: (Traversable f, Monad m, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> m (f b)+gradWithM :: (Traversable f, Monad m, Num a) => (a -> a -> b) -> FF f m a -> f a -> m (f b) gradWithM g f = unwrapMonad . jacobianWith g (WrapMonad . f) -gradWithM' :: (Traversable f, Monad m, Num a) => (a -> a -> b) -> (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> m (a, f b)+gradWithM' :: (Traversable f, Monad m, Num a) => (a -> a -> b) -> FF f m a -> f a -> m (a, f b) gradWithM' g f = unwrapMonad . jacobianWith' g (WrapMonad . f)  -- | Compute the hessian via the jacobian of the gradient. gradient is computed in reverse mode and then the jacobian is computed in reverse mode. -- -- However, since the @'grad f :: f a -> f a'@ is square this is not as fast as using the forward-mode Jacobian of a reverse mode gradient provided by 'Numeric.AD.hessian' in "Numeric.AD".-hessian :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f (f a)+hessian :: (Traversable f, Num a) => FU f a -> f a -> f (f a) hessian f = jacobian (grad (decomposeMode . f . fmap composeMode))  -- | Compute the order 3 Hessian tensor on a non-scalar-to-non-scalar function via the forward-mode Jacobian of the mixed-mode Jacobian of the function. -- -- While this is less efficient than 'Numeric.AD.hessianTensor' from "Numeric.AD" or 'Numeric.AD.Forward.hessianTensor' from "Numeric.AD.Forward", the type signature is more permissive with regards to the output non-scalar, and it may be more efficient if only a few coefficients of the result are consumed.-hessianTensor :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f (f a))+hessianTensor :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> g (f (f a)) hessianTensor f = decomposeFunctor . jacobian (ComposeFunctor . jacobian (fmap decomposeMode . f . fmap composeMode))  -- | Compute the hessian via the reverse-mode jacobian of the reverse-mode gradient of a non-scalar-to-scalar monadic action.  -- -- While this is less efficient than 'Numeric.AD.hessianTensor' from "Numeric.AD" or 'Numeric.AD.Forward.hessianTensor' from "Numeric.AD.Forward", the type signature is more permissive with regards to the output non-scalar, and it may be more efficient if only a few coefficients of the result are consumed.-hessianM :: (Traversable f, Monad m, Num a) => (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> m (f (f a))+hessianM :: (Traversable f, Monad m, Num a) => FF f m a -> f a -> m (f (f a)) hessianM f = unwrapMonad . hessianTensor (WrapMonad . f)

@@ -19,126 +19,4 @@     , tails     ) where -import Control.Applicative-import Data.Monoid-import Data.Foldable-import Data.Traversable-import Numeric.AD.Classes-import Numeric.AD.Internal-import Language.Haskell.TH--infixl 3 :<, :>--class Functor f => Comonad f where-    extract :: (f :> a) -> a-    duplicate :: (f :> a) -> (f :> (f :> a))-    extend :: ((f :> a) -> b) -> (f :> a) -> (f :> b)--data (f :> a) = a :< f (f :> a)--instance Functor f => Functor ((:>)f) where-    fmap f (a :< as) = f a :< fmap f <$> as--instance Functor f => Comonad ((:>) f) where-    extract (a :< _) = a-    duplicate aas@(_ :< as) = aas :< duplicate <$> as-    extend f aas@(_ :< as) = f aas :< extend f <$> as--instance Foldable f => Foldable ((:>) f) where-    foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as--instance Traversable f => Traversable ((:>) f) where-    traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as---- tails of the f-branching stream comonad/cofree comonad-tails :: (f :> a) -> f (f :> a)-tails (_ :< as) = as--unfold :: Functor f => (a -> (b, f a)) -> a -> (f :> b)-unfold f a = h :< unfold f <$> t -    where-        (h, t) = f a--instance Primal ((:>) f) where-    primal (a :< _) = a--instance Mode f => Mode ((:>) f) where-    lift a = as-        where as = a :< lift as-    (a :< as) <+> (b :< bs) = (a + b) :< (as <+> bs)-    a *^ (b :< bs) = (a * b) :< (lift a *^ bs)-    (a :< as) ^* b = (a * b) :< (as ^* lift b)-    (a :< as) ^/ b = (a / b) :< (as ^/ lift b)--instance Mode f => Lifted ((:>) f) where-    showsPrec1 n (a :< _) = showsPrec n a-    (==!) = (==) `on` primal-    compare1 = compare `on` primal-    fromInteger1 a = fromInteger a :< fromInteger1 a-    (a :< as) +! (b :< bs) = (a + b) :< (as +! bs)-    (a :< as) -! (b :< bs) = (a - b) :< (as -! bs)-    (a :< as) *! (b :< bs) = (a * b) :< (as *! bs)-    negate1 (a :< as) = negate a :< negate1 as-    abs1 (a :< as) = abs a :< abs1 as-    signum1 (a :< as) = signum a :< signum1 as-    (a :< as) /! (b :< bs) = (a / b) :< (as /! bs)-    recip1 (a :< as) = recip a :< recip1 as-    fromRational1 n = fromRational n :< fromRational1 n-    toRational1 = toRational . primal-    pi1 = pi :< pi1-    exp1 (a :< as) = exp a :< exp1 as-    log1 (a :< as) = log a :< log1 as-    sqrt1 (a :< as) = sqrt a :< sqrt1 as-    (a :< as) **! (b :< bs) = (a ** b) :< (as **! bs)-    logBase1 (a :< as) (b :< bs) = logBase a b :< logBase1 as bs-    sin1 (a :< as) = sin a :< sin1 as-    cos1 (a :< as) = cos a :< cos1 as-    tan1 (a :< as) = tan a :< tan1 as-    asin1 (a :< as) = asin a :< asin1 as-    acos1 (a :< as) = acos a :< acos1 as-    atan1 (a :< as) = atan a :< atan1 as-    sinh1 (a :< as) = sinh a :< sinh1 as-    cosh1 (a :< as) = cosh a :< cosh1 as-    tanh1 (a :< as) = tanh a :< tanh1 as-    asinh1 (a :< as) = asinh a :< asinh1 as-    acosh1 (a :< as) = acosh a :< acosh1 as-    atanh1 (a :< as) = atanh a :< atanh1 as-    properFraction1 (a :< as) = (b, c :< cs) -        where-            (b, c) = properFraction a-            (_ :: Int, cs) = properFraction1 as-    truncate1 = truncate . primal-    round1 = round . primal-    ceiling1 = ceiling . primal -    floor1  = floor . primal -    floatRadix1 = floatRadix . primal-    floatDigits1 = floatDigits . primal-    floatRange1 = floatRange . primal-    decodeFloat1 = decodeFloat . primal-    encodeFloat1 m e = encodeFloat m e :< encodeFloat1 m e-    exponent1 = exponent . primal -    significand1 (a :< as) = significand a :< significand1 as-    scaleFloat1 n (a :< as) = scaleFloat n a :< scaleFloat1 n as-    isNaN1 = isNaN . primal -    isInfinite1 = isInfinite . primal-    isDenormalized1 = isDenormalized . primal -    isNegativeZero1 = isNegativeZero . primal -    isIEEE1 = isIEEE . primal -    atan21 (a :< as) (b :< bs) = atan2 a b :< atan21 as bs-    succ1 (a :< as) = succ a :< succ1 as-    pred1 (a :< as) = pred a :< pred1 as-    toEnum1 n = toEnum n :< toEnum1 n-    fromEnum1 = fromEnum . primal-    enumFrom1 = error "TODO"-    enumFromThen1 = error "TODO"-    enumFromTo1 = error "TODO"-    enumFromThenTo1 = error "TODO"-    minBound1 = minBound :< minBound1-    maxBound1 = maxBound :< maxBound1-    -- TODO:----- instance (Mode f, Foo a) => Foo ((:>) f) ...-deriveNumeric -    (classP (mkName "Mode") [varT $ mkName "f"]:) -    (conT (mkName ":>") `appT` varT (mkName "f")) +import Numeric.AD.Internal.Stream

@@ -40,100 +40,100 @@     , diffsM  -- answer and all derivatives of the monadic action (a -> m a)     , diffs0M -- answer and all zero padded derivatives of (a -> m a)     -- * Exposed Types+    , UU, UF, FU, FF     , Mode(..)     , AD(..)     ) where  import Control.Monad (liftM) import Control.Applicative ((<$>))-import Numeric.AD.Classes import Numeric.AD.Internal import Numeric.AD.Internal.Tower -diffs :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+diffs :: Num a => UU a -> a -> [a] diffs f a = getADTower $ apply f a {-# INLINE diffs #-} -diffs0 :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+diffs0 :: Num a => UU a -> a -> [a] diffs0 f a = zeroPad (diffs f a) {-# INLINE diffs0 #-} -diffsF :: (Functor f, Num a) => (forall s. Mode s => AD s a -> f (AD s a)) -> a -> f [a]+diffsF :: (Functor f, Num a) => UF f a -> a -> f [a] diffsF f a = getADTower <$> apply f a {-# INLINE diffsF #-} -diffs0F :: (Functor f, Num a) => (forall s. Mode s => AD s a -> f (AD s a)) -> a -> f [a]+diffs0F :: (Functor f, Num a) => UF f a -> a -> f [a] diffs0F f a = (zeroPad . getADTower) <$> apply f a {-# INLINE diffs0F #-} -diffsM :: (Monad m, Num a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> m [a]+diffsM :: (Monad m, Num a) => UF m a -> a -> m [a] diffsM f a = getADTower `liftM` apply f a {-# INLINE diffsM #-} -diffs0M :: (Monad m, Num a) => (forall s. Mode s => AD s a -> m (AD s a)) -> a -> m [a]+diffs0M :: (Monad m, Num a) => UF m a -> a -> m [a] diffs0M f a = (zeroPad . getADTower) `liftM` apply f a {-# INLINE diffs0M #-} -taylor :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> a -> [a]+taylor :: Fractional a => UU a -> a -> a -> [a] taylor f x dx = go 1 1 (diffs f x)     where         go !n !acc (a:as) = a * acc : go (n + 1) (acc * dx / n) as         go _ _ [] = [] -taylor0 :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> a -> [a]+taylor0 :: Fractional a => UU a -> a -> a -> [a] taylor0 f x dx = zeroPad (taylor f x dx) {-# INLINE taylor0 #-} -maclaurin :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+maclaurin :: Fractional a => UU a -> a -> [a] maclaurin f = taylor f 0 {-# INLINE maclaurin #-} -maclaurin0 :: Fractional a => (forall s. Mode s => AD s a -> AD s a) -> a -> [a]+maclaurin0 :: Fractional a => UU a -> a -> [a] maclaurin0 f = taylor0 f 0 {-# INLINE maclaurin0 #-} -diff :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> a+diff :: Num a => UU a -> a -> a diff f = d . diffs f {-# INLINE diff #-} -diff' :: Num a => (forall s. Mode s => AD s a -> AD s a) -> a -> (a, a)+diff' :: Num a => UU a -> a -> (a, a) diff' f = d' . diffs f {-# INLINE diff' #-} -du :: (Functor f, Num a) => (forall s. f (AD s a) -> AD s a) -> f (a, a) -> a+du :: (Functor f, Num a) => FU f a -> f (a, a) -> a du f = d . getADTower . f . fmap withD {-# INLINE du #-} -du' :: (Functor f, Num a) => (forall s. f (AD s a) -> AD s a) -> f (a, a) -> (a, a)+du' :: (Functor f, Num a) => FU f a -> f (a, a) -> (a, a) du' f = d' . getADTower . f . fmap withD {-# INLINE du' #-} -duF :: (Functor f, Functor g, Num a) => (forall s. f (AD s a) -> g (AD s a)) -> f (a, a) -> g a+duF :: (Functor f, Functor g, Num a) => FF f g a -> f (a, a) -> g a duF f = fmap (d . getADTower) . f . fmap withD {-# INLINE duF #-} -duF' :: (Functor f, Functor g, Num a) => (forall s. f (AD s a) -> g (AD s a)) -> f (a, a) -> g (a, a)+duF' :: (Functor f, Functor g, Num a) => FF f g a -> f (a, a) -> g (a, a) duF' f = fmap (d' . getADTower) . f . fmap withD {-# INLINE duF' #-} -dus :: (Functor f, Num a) => (forall s. f (AD s a) -> AD s a) -> f [a] -> [a]+dus :: (Functor f, Num a) => FU f a -> f [a] -> [a] dus f = getADTower . f . fmap tower {-# INLINE dus #-} -dus0 :: (Functor f, Num a) => (forall s. f (AD s a) -> AD s a) -> f [a] -> [a]+dus0 :: (Functor f, Num a) => FU f a -> f [a] -> [a] dus0 f = zeroPad . getADTower . f . fmap tower {-# INLINE dus0 #-} -dusF :: (Functor f, Functor g, Num a) => (forall s. f (AD s a) -> g (AD s a)) -> f [a] -> g [a]+dusF :: (Functor f, Functor g, Num a) => FF f g a -> f [a] -> g [a] dusF f = fmap getADTower . f . fmap tower {-# INLINE dusF #-} -dus0F :: (Functor f, Functor g, Num a) => (forall s. f (AD s a) -> g (AD s a)) -> f [a] -> g [a]+dus0F :: (Functor f, Functor g, Num a) => FF f g a -> f [a] -> g [a] dus0F f = fmap getADTower . f . fmap tower {-# INLINE dus0F #-}  -- TODO: higher order gradients -- data f :> a = a :< f (f :> a) --- gradients  :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> f :> a--- gradientsF, jacobians :: (Traversable f, Functor g, Num a) => (forall s. Mode s => f (AD s a) -> g (AD s a)) -> f a -> g (f :> a)--- gradientsM :: (Traversable f, Monad m, Num a) => (forall s. Mode s => f (AD s a) -> m (AD s a)) -> f a -> m (f :> a)+-- gradients  :: (Traversable f, Num a) => FU f a -> f a -> f :> a+-- gradientsF, jacobians :: (Traversable f, Functor g, Num a) => FF f g a -> f a -> g (f :> a)+-- gradientsM :: (Traversable f, Monad m, Num a) => FF f m a -> f a -> m (f :> a)

@@ -1,5 +1,5 @@ Name:         ad-Version:      0.24+Version:      0.27 License:      BSD3 License-File: LICENSE Copyright:    (c) Edward Kmett 2010,@@ -31,13 +31,14 @@     Numeric.AD.Tower     Numeric.AD.Directed     Numeric.AD.Newton-    Numeric.AD.Classes     Numeric.AD.Stream     Numeric.AD.Internal+    Numeric.AD.Internal.Classes     Numeric.AD.Internal.Composition     Numeric.AD.Internal.Forward     Numeric.AD.Internal.Reverse     Numeric.AD.Internal.Tower+    Numeric.AD.Internal.Stream  Extra-Source-Files: TODO GHC-Options: -Wall