backprop 0.1.1.0 → 0.1.2.0

raw patch · 5 files changed

+103/−42 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• backprop.cabal +2/−2
• src/Numeric/Backprop/Internal.hs +46/−36
• src/Numeric/Backprop/Op.hs +14/−1
• src/Numeric/Backprop/Tuple.hs +28/−3

@@ -1,6 +1,19 @@ Changelog ========= +Version 0.1.2.0+---------------++*Feb 7, 2018*++<https://github.com/mstksg/backprop/releases/tag/v0.1.2.0>++*   Added currying and uncurrying functions for tuples in+    *Numeric.Backprop.Tuple*.+*   `opIsoN`, for isomorphisms between a tuple of values and a value.+*   (Internal) AD engine now using `Any` from *ghc-prim* instead of `Some I`+    from *type-combinators*+ Version 0.1.1.0 --------------- 

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 910fed99cfe32b65c18c047c45e8694c914a2eb4f7bdceec90d9ab4e3eba535c+-- hash: d40da486697c0035648b98d75f36ea36bb66bdb648bb3406bf9eed465f497bb2  name:           backprop-version:        0.1.1.0+version:        0.1.2.0 synopsis:       Heterogeneous automatic differentation (backpropagation) description:    Write your functions to compute your result, and the library will                 automatically generate functions to compute your gradient.

@@ -2,7 +2,6 @@ {-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE GADTs               #-}-{-# LANGUAGE LambdaCase          #-} {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -46,13 +45,14 @@ import           Data.IORef import           Data.Kind import           Data.Maybe-import           Data.Monoid+import           Data.Monoid hiding        (Any(..)) import           Data.Proxy import           Data.Reflection import           Data.Type.Index import           Data.Type.Product hiding  (toList) import           Data.Type.Util import           Data.Type.Vector hiding   (itraverse)+import           GHC.Exts                  (Any) import           GHC.Generics import           Lens.Micro import           Numeric.Backprop.Op@@ -124,7 +124,7 @@ {-# INLINE bvConst #-}  forceBVar :: BVar s a -> ()-forceBVar (BV !r !_) = force r `seq` ()+forceBVar (BV r !_) = force r `seq` () {-# INLINE forceBVar #-}  data InpRef :: Type -> Type where@@ -135,7 +135,7 @@        -> InpRef a  forceInpRef :: InpRef a -> ()-forceInpRef (IR !v !_ !_) = forceBVar v `seq` ()+forceInpRef (IR v !_ !_) = forceBVar v `seq` () {-# INLINE forceInpRef #-}  -- | Debugging string for an 'InpRef'.@@ -149,7 +149,7 @@        -> TapeNode a  forceTapeNode :: TapeNode a -> ()-forceTapeNode (TN !inps !_) = foldMap1 forceInpRef inps `seq` ()+forceTapeNode (TN inps !_) = foldMap1 forceInpRef inps `seq` () {-# INLINE forceTapeNode #-}  data SomeTapeNode :: Type where@@ -158,7 +158,7 @@         -> SomeTapeNode  forceSomeTapeNode :: SomeTapeNode -> ()-forceSomeTapeNode (STN !tn) = forceTapeNode tn `seq` ()+forceSomeTapeNode (STN tn) = forceTapeNode tn `seq` () {-# INLINE forceSomeTapeNode #-}  -- | Debugging string for a 'SomeTapeMode'.@@ -182,7 +182,7 @@     -> a     -> W     -> IO (BVar s a)-insertNode !tn !x !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) ->+insertNode tn !x !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) ->     let n' = n + 1         t' = STN tn:t     in  forceTapeNode tn `seq` n' `seq` t' `seq` ((n', t'), n)@@ -211,6 +211,7 @@             }     go :: forall a. Index as a -> BVar s a -> InpRef a     go i !v = forceBVar v `seq` (IR v id (+) \\ every @_ @Num i)+    {-# INLINE go #-} {-# INLINE liftOp_ #-}  -- | Lift an 'Op' with an arbitrary number of inputs to a function on the@@ -236,7 +237,7 @@     -> BVar s a     -> IO (BVar s b) liftOp1_ o (bvConst->Just x) = return . constVar . evalOp o $ (x ::< Ø)-liftOp1_ o !v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s))+liftOp1_ o v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s))   where     (y,g) = runOpWith o (_bvVal v ::< Ø)     tn = TN { _tnInputs = IR v id (+) :< Ø@@ -266,9 +267,9 @@     -> BVar s b     -> IO (BVar s c) liftOp2_ o (bvConst->Just x) (bvConst->Just y) = return . constVar . evalOp o $ x ::< y ::< Ø-liftOp2_ o !v !u = forceBVar v-             `seq` forceBVar u-             `seq` insertNode tn y (reflect (Proxy @s))+liftOp2_ o v u = forceBVar v+           `seq` forceBVar u+           `seq` insertNode tn y (reflect (Proxy @s))   where     (y,g) = runOpWith o (_bvVal v ::< _bvVal u ::< Ø)     tn = TN { _tnInputs = IR v id (+) :< IR u id (+) :< Ø@@ -301,10 +302,10 @@     -> IO (BVar s d) liftOp3_ o (bvConst->Just x) (bvConst->Just y) (bvConst->Just z)     = return . constVar . evalOp o $ x ::< y ::< z ::< Ø-liftOp3_ o !v !u !w = forceBVar v-                `seq` forceBVar u-                `seq` forceBVar w-                `seq` insertNode tn y (reflect (Proxy @s))+liftOp3_ o v u w = forceBVar v+             `seq` forceBVar u+             `seq` forceBVar w+             `seq` insertNode tn y (reflect (Proxy @s))   where     (y, g) = runOpWith o (_bvVal v ::< _bvVal u ::< _bvVal w ::< Ø)     tn = TN { _tnInputs = IR v id (+) :< IR u id (+) :< IR w id (+) :< Ø@@ -334,7 +335,7 @@     => Lens' b a     -> BVar s b     -> IO (BVar s a)-viewVar_ l !v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s))+viewVar_ l v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s))   where     y = _bvVal v ^. l     tn = TN { _tnInputs = IR v l (+) :< Ø@@ -360,9 +361,9 @@     -> BVar s a     -> BVar s b     -> IO (BVar s b)-setVar_ l !w !v = forceBVar v-            `seq` forceBVar w-            `seq` insertNode tn y (reflect (Proxy @s))+setVar_ l w v = forceBVar v+          `seq` forceBVar w+          `seq` insertNode tn y (reflect (Proxy @s))   where     y = _bvVal v & l .~ _bvVal w     tn = TN { _tnInputs = IR w id (+) :< IR v id (+) :< Ø@@ -410,6 +411,11 @@  -- | Collect all of the 'BVar's in a container into a 'BVar' of that -- container's contents.+--+-- Note that this requires @t a@ to have a 'Num' instance.  If you are+-- using a list, I recommend using+-- <https://hackage.haskell.org/package/vector-sized vector-sized> instead:+-- it's a fixed-length vector type with a very appropriate 'Num' instance! collectVar     :: forall a t s. (Reifies s W, Foldable t, Functor t, Num (t a), Num a)     => t (BVar s a)@@ -423,8 +429,8 @@     -> Traversal' b a     -> BVar s b     -> IO (f (BVar s a))-traverseVar' f t !v = forceBVar v-              `seq` itraverse go (f (_bvVal v))+traverseVar' f t v = forceBVar v+               `seq` itraverse go (f (_bvVal v))   where     go :: Int -> a -> IO (BVar s a)     go i y = insertNode tn y (reflect (Proxy @s))@@ -432,6 +438,7 @@         tn = TN { _tnInputs = IR v (ixt t i) (+) :< Ø                 , _tnGrad   = only_                 }+    {-# INLINE go #-} {-# INLINE traverseVar' #-}  -- | Using a 'Traversal'', extract a single value /inside/ a 'BVar', if it@@ -460,8 +467,8 @@ toListOfVar t !v = unsafePerformIO $ traverseVar' (toListOf t) t v {-# INLINE toListOfVar #-} -data Runner s = R { _rDelta  :: MV.MVector s (Some I)-                  , _rInputs :: MV.MVector s (Some I)+data Runner s = R { _rDelta  :: !(MV.MVector s Any)+                  , _rInputs :: !(MV.MVector s Any)                   }  initRunner@@ -472,10 +479,10 @@ initRunner (n, stns) (nx,xs) = do     delts <- MV.new n     for_ (zip [n-1,n-2..] stns) $ \(i, STN (TN{..} :: TapeNode c)) ->-      MV.write delts i $ Some @_ @_ @c (I 0)+      MV.write delts i $ unsafeCoerce @c 0     inps <- MV.new nx     for_ (zip [0..] xs) $ \(i, Some (Wit1 :: Wit1 Num c)) ->-      MV.write inps i $ Some @_ @_ @c (I 0)+      MV.write inps i $ unsafeCoerce @c 0     return $ R delts inps {-# INLINE initRunner #-} @@ -487,23 +494,23 @@     -> m () gradRunner _ R{..} (n,stns) = do     when (n > 0) $-      MV.write _rDelta (n - 1) (Some @_ @_ @b (I 1))+      MV.write _rDelta (n - 1) (unsafeCoerce @b 1)     zipWithM_ go [n-1,n-2..] stns   where     go :: Int -> SomeTapeNode -> m ()     go i (STN TN{..}) = do-      Some (I delt) <- MV.read _rDelta i+      delt <- MV.read _rDelta i       let gs = _tnGrad (unsafeCoerce delt)       zipWithPM_ propagate _tnInputs gs+    {-# INLINE go #-}     propagate :: forall x. InpRef x -> I x -> m ()-    propagate (IR v ln (+*)) (I !d) = case _bvRef v of-      BRInp !i -> flip (MV.modify _rInputs) i $ \case-        Some (I !y) -> let y' = unsafeCoerce y & ln %~ (+* d)-                       in  y' `seq` Some (I y')-      BRIx !i -> flip (MV.modify _rDelta) i $ \case-        Some (I !y) -> let y' = unsafeCoerce y & ln %~ (+* d)-                       in  y' `seq` Some (I y')+    propagate (IR v ln (+*)) (I d) = case _bvRef v of+      BRInp i -> flip (MV.modify _rInputs) i $+        unsafeCoerce . (ln %~ (+* d)) . unsafeCoerce+      BRIx i -> flip (MV.modify _rDelta) i $+        unsafeCoerce . (ln %~ (+* d)) . unsafeCoerce       BRC     -> return ()+    {-# INLINE propagate #-} {-# INLINE gradRunner #-}  -- | 'backprop' generalized to multiple inputs of different types.  See the@@ -538,7 +545,7 @@     => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)     -> Tuple as     -> (b, Tuple as)-backpropN f xs = (y, g)+backpropN f !xs = (y, g)   where     !(!tp@(!_,!_),!y) = unsafePerformIO $ fillWengert f xs     g :: Tuple as@@ -547,10 +554,11 @@         gradRunner (Proxy @b) r tp         delts <- toList <$> V.freeze (_rInputs r)         return . fromMaybe (error "backpropN") $-          fillProd (\_ (Some (I d)) -> I (unsafeCoerce d)) xs delts+          fillProd (\_ d -> I (unsafeCoerce d)) xs delts       where         go :: forall a. Index as a -> I a -> (Sum Int, [Some (Wit1 Num)])         go i (I _) = (1, [Some (Wit1 :: Wit1 Num a)]) \\ every @_ @Num i+        {-# INLINE go #-} {-# INLINE backpropN #-}  -- | 'evalBP' generalized to multiple inputs of different types.  See@@ -583,6 +591,8 @@       where         go :: a -> Int -> (BVar s a, Int)         go x i = (BV (BRInp i) x, i + 1)+        {-# INLINE go #-}+    {-# INLINE inpProd #-} {-# INLINE fillWengert #-}  

@@ -51,7 +51,7 @@   -- ** Giving gradients directly   , op1, op2, op3   -- ** From Isomorphisms-  , opCoerce, opTup, opIso, opLens+  , opCoerce, opTup, opIso, opLens, opIsoN   -- * Manipulation   , composeOp, composeOp1, (~.)   , composeOp', composeOp1'@@ -360,6 +360,19 @@ opIso :: (a -> b) -> (b -> a) -> Op '[ a ] b opIso to' from' = op1 $ \x -> (to' x, from') {-# INLINE opIso #-}++-- | An 'Op' that runs the input value through an isomorphism between+-- a tuple of values and a value.+--+-- Warning: This is unsafe!  It assumes that the isomorphisms themselves+-- have derivative 1, so will break for things like+-- 'Numeric.Lens.exponentiating'.  Basically, don't use this for any+-- "numeric" isomorphisms.+--+-- @since 0.1.2.0+opIsoN :: (Tuple as -> b) -> (b -> Tuple as) -> Op as b+opIsoN to' from' = Op $ \xs -> (to' xs, from')+{-# INLINE opIsoN #-}  -- | An 'Op' that extracts a value from an input value using a 'Lens''. --

@@ -57,6 +57,8 @@   -- ** Conversions   -- $t2iso   , t2Tup, tupT2+  -- ** Consumption+  , uncurryT2, curryT2   -- ** Lenses   , t2_1, t2_2   -- * Three-tuples@@ -66,6 +68,8 @@   , t3Tup, tupT3   -- ** Lenses   , t3_1, t3_2, t3_3+  -- ** Consumption+  , uncurryT3, curryT3   ) where  import           Control.DeepSeq@@ -100,15 +104,12 @@ -- | Convert to a Haskell tuple. -- -- Forms an isomorphism with 'tupT2'.--- @since 0.1.1.0 t2Tup :: T2 a b -> (a, b) t2Tup (T2 x y) = (x, y)  -- | Convert from Haskell tuple. -- -- Forms an isomorphism with 't2Tup'.------ @since 0.1.1.0 tupT2 :: (a, b) -> T2 a b tupT2 (x, y) = T2 x y @@ -123,6 +124,30 @@ -- Forms an isomorphism with 't3Tup'. tupT3 :: (a, b, c) -> T3 a b c tupT3 (x, y, z) = T3 x y z++-- | Uncurry a function to take in a 'T2' of its arguments+--+-- @since 0.1.2.0+uncurryT2 :: (a -> b -> c) -> T2 a b -> c+uncurryT2 f (T2 x y) = f x y++-- | Curry a function taking a 'T2' of its arguments+--+-- @since 0.1.2.0+curryT2 :: (T2 a b -> c) -> a -> b -> c+curryT2 f x y = f (T2 x y)++-- | Uncurry a function to take in a 'T3' of its arguments+--+-- @since 0.1.2.0+uncurryT3 :: (a -> b -> c -> d) -> T3 a b c -> d+uncurryT3 f (T3 x y z) = f x y z++-- | Curry a function taking a 'T3' of its arguments+--+-- @since 0.1.2.0+curryT3 :: (T3 a b c -> d) -> a -> b -> c -> d+curryT3 f x y z = f (T3 x y z)  instance Field1 (T2 a b) (T2 a' b) a a' where     _1 f (T2 x y) = (`T2` y) <$> f x