backprop 0.1.0.0 → 0.1.1.0
raw patch · 13 files changed
+376/−84 lines, 13 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Numeric.Backprop.Tuple: T2 :: !a -> !b -> T2 a b
+ Numeric.Backprop.Tuple: T3 :: !a -> !b -> !c -> T3 a b c
+ Numeric.Backprop.Tuple: data T2 a b
+ Numeric.Backprop.Tuple: data T3 a b c
+ Numeric.Backprop.Tuple: instance (Control.DeepSeq.NFData a, Control.DeepSeq.NFData b) => Control.DeepSeq.NFData (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (Control.DeepSeq.NFData a, Control.DeepSeq.NFData b, Control.DeepSeq.NFData c) => Control.DeepSeq.NFData (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (Data.Data.Data b, Data.Data.Data a) => Data.Data.Data (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (Data.Data.Data c, Data.Data.Data b, Data.Data.Data a) => Data.Data.Data (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (Data.Semigroup.Semigroup a, Data.Semigroup.Semigroup b) => Data.Semigroup.Semigroup (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (Data.Semigroup.Semigroup a, Data.Semigroup.Semigroup b, Data.Semigroup.Semigroup c) => Data.Semigroup.Semigroup (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Base.Monoid a, GHC.Base.Monoid b) => GHC.Base.Monoid (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Base.Monoid a, GHC.Base.Monoid b, GHC.Base.Monoid c) => GHC.Base.Monoid (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Classes.Eq b, GHC.Classes.Eq a) => GHC.Classes.Eq (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Classes.Eq c, GHC.Classes.Eq b, GHC.Classes.Eq a) => GHC.Classes.Eq (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Classes.Ord b, GHC.Classes.Ord a) => GHC.Classes.Ord (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Classes.Ord c, GHC.Classes.Ord b, GHC.Classes.Ord a) => GHC.Classes.Ord (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Float.Floating a, GHC.Float.Floating b) => GHC.Float.Floating (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Float.Floating a, GHC.Float.Floating b, GHC.Float.Floating c) => GHC.Float.Floating (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Num.Num a, GHC.Num.Num b) => GHC.Num.Num (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Num.Num a, GHC.Num.Num b, GHC.Num.Num c) => GHC.Num.Num (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Read.Read b, GHC.Read.Read a) => GHC.Read.Read (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Read.Read c, GHC.Read.Read b, GHC.Read.Read a) => GHC.Read.Read (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Real.Fractional a, GHC.Real.Fractional b) => GHC.Real.Fractional (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Real.Fractional a, GHC.Real.Fractional b, GHC.Real.Fractional c) => GHC.Real.Fractional (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance (GHC.Show.Show b, GHC.Show.Show a) => GHC.Show.Show (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance (GHC.Show.Show c, GHC.Show.Show b, GHC.Show.Show a) => GHC.Show.Show (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance Data.Bifunctor.Bifunctor (Numeric.Backprop.Tuple.T3 a)
+ Numeric.Backprop.Tuple: instance Data.Bifunctor.Bifunctor Numeric.Backprop.Tuple.T2
+ Numeric.Backprop.Tuple: instance GHC.Base.Functor (Numeric.Backprop.Tuple.T2 a)
+ Numeric.Backprop.Tuple: instance GHC.Base.Functor (Numeric.Backprop.Tuple.T3 a b)
+ Numeric.Backprop.Tuple: instance GHC.Generics.Generic (Numeric.Backprop.Tuple.T2 a b)
+ Numeric.Backprop.Tuple: instance GHC.Generics.Generic (Numeric.Backprop.Tuple.T3 a b c)
+ Numeric.Backprop.Tuple: instance Lens.Micro.Internal.Field1 (Numeric.Backprop.Tuple.T2 a b) (Numeric.Backprop.Tuple.T2 a' b) a a'
+ Numeric.Backprop.Tuple: instance Lens.Micro.Internal.Field1 (Numeric.Backprop.Tuple.T3 a b c) (Numeric.Backprop.Tuple.T3 a' b c) a a'
+ Numeric.Backprop.Tuple: instance Lens.Micro.Internal.Field2 (Numeric.Backprop.Tuple.T2 a b) (Numeric.Backprop.Tuple.T2 a b') b b'
+ Numeric.Backprop.Tuple: instance Lens.Micro.Internal.Field2 (Numeric.Backprop.Tuple.T3 a b c) (Numeric.Backprop.Tuple.T3 a b' c) b b'
+ Numeric.Backprop.Tuple: instance Lens.Micro.Internal.Field3 (Numeric.Backprop.Tuple.T3 a b c) (Numeric.Backprop.Tuple.T3 a b c') c c'
+ Numeric.Backprop.Tuple: t2Tup :: T2 a b -> (a, b)
+ Numeric.Backprop.Tuple: t2_1 :: Lens (T2 a b) (T2 a' b) a a'
+ Numeric.Backprop.Tuple: t2_2 :: Lens (T2 a b) (T2 a b') b b'
+ Numeric.Backprop.Tuple: t3Tup :: T3 a b c -> (a, b, c)
+ Numeric.Backprop.Tuple: t3_1 :: Lens (T3 a b c) (T3 a' b c) a a'
+ Numeric.Backprop.Tuple: t3_2 :: Lens (T3 a b c) (T3 a b' c) b b'
+ Numeric.Backprop.Tuple: t3_3 :: Lens (T3 a b c) (T3 a b c') c c'
+ Numeric.Backprop.Tuple: tupT2 :: (a, b) -> T2 a b
+ Numeric.Backprop.Tuple: tupT3 :: (a, b, c) -> T3 a b c
Files
- CHANGELOG.md +15/−0
- README.md +8/−1
- backprop.cabal +7/−3
- renders/backprop-mnist.md +1/−3
- renders/backprop-mnist.pdf binary
- renders/extensible-neural.md +5/−6
- renders/extensible-neural.pdf binary
- samples/backprop-mnist.lhs +1/−3
- samples/extensible-neural.lhs +3/−5
- src/Data/Type/Util.hs +15/−9
- src/Numeric/Backprop.hs +23/−12
- src/Numeric/Backprop/Internal.hs +37/−42
- src/Numeric/Backprop/Tuple.hs +261/−0
CHANGELOG.md view
@@ -1,6 +1,21 @@ Changelog ========= +Version 0.1.1.0+---------------++*Feb 6, 2018*++<https://github.com/mstksg/backprop/releases/tag/v0.1.1.0>++* Added canonical strict tuple types with `Num` instances, in the module+ *Numeric.Backprop.Tuple*. This is meant to be a band-aid for the problem+ of orphan instances and potential mismatched tuple types.+* Fixed bug in `collectVar` that occurs if container sizes change+* Internal tweaks to the underlying automatic differentiation types that+ decouple backpropagation from `Num`, internally. `Num` is now just used+ externally as a part of the API, which might someday be made optional.+ Version 0.1.0.0 ---------------
README.md view
@@ -272,12 +272,19 @@ addition, it's often useful to have anonymous products and tuples in general. - However, this can be resolved by using the orphan instances in the+ This is bandaided-over by having *backprop* provide canonical+ tuple-with-`Num` types for different libraries to use, but it's not a+ perfect solution.++ This can be resolved by using the orphan instances in the *[NumInstances][]* package. Still, there might be some headache for application developers if different libraries using *backprop* accidentally pull in their orphan instances from different places. [NumInstances]: https://hackage.haskell.org/package/NumInstances++ Alternatively, one day we can get `Num` instances for tuples into+ *base*! The extra complexity that would come from adding a custom typeclass just for `+` / `0` / `1`, though, I feel, might not be worth the benefit. The
backprop.cabal view
@@ -2,14 +2,17 @@ -- -- see: https://github.com/sol/hpack ----- hash: 78d9facc552fa43f3b324fa4ffe1c526e33e67c5cf55fdde75b05f60f81e423c+-- hash: 910fed99cfe32b65c18c047c45e8694c914a2eb4f7bdceec90d9ab4e3eba535c name: backprop-version: 0.1.0.0-synopsis: Heterogeneous automatic backpropagation in Haskell+version: 0.1.1.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. .+ Implements heterogeneous reverse-mode automatic differentiation, commonly+ known as "backpropagation".+ . See <https://github.com/mstksg/backprop#readme README.md> category: Math homepage: https://github.com/mstksg/backprop#readme@@ -53,6 +56,7 @@ exposed-modules: Numeric.Backprop Numeric.Backprop.Op+ Numeric.Backprop.Tuple other-modules: Numeric.Backprop.Internal Data.Type.Util
renders/backprop-mnist.md view
@@ -25,16 +25,14 @@ [rendered pdf version is available on github.]: https://github.com/mstksg/backprop/blob/master/renders/backprop-mnist.pdf [literate haskell version that you can run]: https://github.com/mstksg/backprop/blob/master/samples/backprop-mnist.lhs -The packages involved are:+The (extra) packages involved are: -- deepseq - hmatrix - lens - mnist-idx - mwc-random - one-liner-instances - split-- vector ``` {.sourceCode .literate .haskell} {-# LANGUAGE BangPatterns #-}
renders/backprop-mnist.pdf view
binary file changed (133909 → 133763 bytes)
renders/extensible-neural.md view
@@ -13,9 +13,8 @@ [literate haskell file]: https://github.com/mstksg/backprop/blob/master/samples/extensible-neural.lhs [rendered as a pdf]: https://github.com/mstksg/backprop/blob/master/renders/extensible-neural.pdf -The packages involved are:+The (extra) packages involved are: -- deepseq - hmatrix - lens - mnist-idx@@ -23,7 +22,6 @@ - one-liner-instances - singletons - split-- vector ``` {.sourceCode .literate .haskell} {-# LANGUAGE BangPatterns #-}@@ -126,9 +124,10 @@ ``` Unfortunately, we can't automatically generate lenses for GADTs, so we-have to make them by hand.\[\^poly\]+have to make them by hand.[^1] -with type safety via paraemtric polymorphism.+[^1]: We write them originally as a polymorphic lens family to help us+ with type safety via paraemtric polymorphism. ``` {.sourceCode .literate .haskell} _NO :: Lens (Net i '[] o) (Net i' '[] o')@@ -192,7 +191,7 @@ -> BVar s (R o) runNetwork n = \case SNil -> softMax . runLayer (n ^^. _NO)- SCons SNat hs -> withSingI hs (runNetwork (n ^^. _NIN) hs)+ SCons SNat hs -> runNetwork (withSingI hs (n ^^. _NIN)) hs . logistic . runLayer (n ^^. _NIL) {-# INLINE runNetwork #-}
renders/extensible-neural.pdf view
binary file changed (108272 → 107850 bytes)
samples/backprop-mnist.lhs view
@@ -22,16 +22,14 @@ [rendered]: https://github.com/mstksg/backprop/blob/master/renders/backprop-mnist.pdf [lhs]: https://github.com/mstksg/backprop/blob/master/samples/backprop-mnist.lhs -The packages involved are:+The (extra) packages involved are: -* deepseq * hmatrix * lens * mnist-idx * mwc-random * one-liner-instances * split-* vector > {-# LANGUAGE BangPatterns #-} > {-# LANGUAGE DataKinds #-}
samples/extensible-neural.lhs view
@@ -11,9 +11,8 @@ [rendered]: https://github.com/mstksg/backprop/blob/master/renders/extensible-neural.pdf [lhs]: https://github.com/mstksg/backprop/blob/master/samples/extensible-neural.lhs -The packages involved are:+The (extra) packages involved are: -* deepseq * hmatrix * lens * mnist-idx@@ -21,7 +20,6 @@ * one-liner-instances * singletons * split-* vector > {-# LANGUAGE BangPatterns #-} > {-# LANGUAGE DataKinds #-}@@ -122,7 +120,7 @@ Unfortunately, we can't automatically generate lenses for GADTs, so we have to make them by hand.[^poly] -[poly]: We write them originally as a polymorphic lens family to help us+[^poly]: We write them originally as a polymorphic lens family to help us with type safety via paraemtric polymorphism. > _NO :: Lens (Net i '[] o) (Net i' '[] o')@@ -182,7 +180,7 @@ > -> BVar s (R o) > runNetwork n = \case > SNil -> softMax . runLayer (n ^^. _NO)-> SCons SNat hs -> withSingI hs (runNetwork (n ^^. _NIN) hs)+> SCons SNat hs -> runNetwork (withSingI hs (n ^^. _NIN)) hs > . logistic > . runLayer (n ^^. _NIL) > {-# INLINE runNetwork #-}
src/Data/Type/Util.hs view
@@ -15,7 +15,7 @@ , vecLen , prodToVec' , lengthProd- , listToVec+ , listToVecDef , fillProd ) where @@ -25,6 +25,7 @@ import Data.Type.Nat import Data.Type.Product import Data.Type.Vector+import Type.Class.Witness import Type.Family.Nat -- | @'Replicate' n a@ is a list of @a@s repeated @n@ times.@@ -103,15 +104,20 @@ LZ -> Ø LS l -> x :< lengthProd x l -listToVec- :: Nat n+listToVecDef+ :: forall f a n. ()+ => f a+ -> Nat n -> [f a]- -> Maybe (VecT n f a)-listToVec = \case- Z_ -> \_ -> Just ØV- S_ n -> \case- [] -> Nothing- x:xs -> (x :*) <$> listToVec n xs+ -> VecT n f a+listToVecDef d = go+ where+ go :: Nat m -> [f a] -> VecT m f a+ go = \case+ Z_ -> const ØV+ S_ n -> \case+ [] -> d :* vrep d \\ n+ x:xs -> x :* go n xs fillProd :: forall f g as c. ()
src/Numeric/Backprop.hs view
@@ -156,10 +156,15 @@ -- See the <https://github.com/mstksg/backprop README> for a more detailed -- discussion on this issue. ----- If you need a 'Num' instance for tuples, consider the+-- If you need a 'Num' instance for tuples, you can use the canonical 2-+-- and 3-tuples for the library in "Numeric.Backprop.Tuple". If you need+-- one for larger tuples, consider making a custom product type instead+-- (making Num instances with something like+-- <https://hackage.haskell.org/package/one-liner-instances one-liner-instances>).+-- You can also use the orphan instances in the -- <https://hackage.haskell.org/package/NumInstances NumInstances> package--- (in particular, "Data.NumInstances.Tuple"), or else using a named--- product type instead.+-- (in particular, "Data.NumInstances.Tuple") if you are writing an+-- application and do not have to worry about orphan instances. backprop :: forall a b. (Num a, Num b) => (forall s. Reifies s W => BVar s a -> BVar s b)@@ -219,11 +224,8 @@ -- | 'backprop' for a two-argument function. -- -- Not strictly necessary, because you can always uncurry a function by--- putting the arguments inside a data type, or using a tuple with--- <https://hackage.haskell.org/package/NumInstances NumInstances>.--- However, this can be convenient if you don't want to make a custom tuple--- type or pull in orphan instances. This could potentially also be more--- performant.+-- passing in all of the argument inside a data type, or use 'T2'. However,+-- this could potentially be more performant. -- -- For 3 and more arguments, consider using 'backpropN'. backprop2@@ -352,10 +354,19 @@ -- -- Note that many automatically-generated prisms by the /lens/ package use -- tuples, which cannot normally be backpropagated (because they do not--- have a 'Num' instance). However, you can pull in orphan instances from--- <https://hackage.haskell.org/package/NumInstances NumInstances>, or also--- chain those prisms with functions to convert tuples to your own custom--- product types (or tuple types with 'Num' instances).+-- have a 'Num' instance).+--+-- If you are writing an application or don't have to worry about orphan+-- instances, you can pull in the orphan instances from+-- <https://hackage.haskell.org/package/NumInstances NumInstances>.+-- Alternatively, you can chain those prisms with conversions to the+-- anonymous canonical strict tuple types in "Numeric.Backprop.Tuple",+-- which do have 'Num' instances.+--+-- @+-- myPrism :: 'Prism'' c (a, b)+-- myPrism . 'iso' 'tupT2' 't2Tup' :: 'Prism'' c ('T2' a b)+-- @ (^^?) :: forall b a s. (Num a, Reifies s W) => BVar s b
src/Numeric/Backprop/Internal.hs view
@@ -50,9 +50,9 @@ import Data.Proxy import Data.Reflection import Data.Type.Index-import Data.Type.Product hiding (toList)+import Data.Type.Product hiding (toList) import Data.Type.Util-import Data.Type.Vector hiding (itraverse, head')+import Data.Type.Vector hiding (itraverse) import GHC.Generics import Lens.Micro import Numeric.Backprop.Op@@ -60,8 +60,8 @@ import Type.Class.Higher import Type.Class.Witness import Unsafe.Coerce-import qualified Data.Vector as V-import qualified Data.Vector.Mutable as MV+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV -- | A @'BVar' s a@ is a value of type @a@ that can be "backpropagated". --@@ -128,14 +128,14 @@ {-# INLINE forceBVar #-} data InpRef :: Type -> Type where- IR :: Num a- => { _irIx :: !(BVar s b)+ IR :: { _irIx :: !(BVar s b) , _irUpd :: !(Lens' b a)+ , _irAdd :: !(a -> a -> a) } -> InpRef a forceInpRef :: InpRef a -> ()-forceInpRef (IR !v !_) = forceBVar v `seq` ()+forceInpRef (IR !v !_ !_) = forceBVar v `seq` () {-# INLINE forceInpRef #-} -- | Debugging string for an 'InpRef'.@@ -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)@@ -210,7 +210,7 @@ , _tnGrad = g } go :: forall a. Index as a -> BVar s a -> InpRef a- go i !v = forceBVar v `seq` (IR v id \\ every @_ @Num i)+ go i !v = forceBVar v `seq` (IR v id (+) \\ every @_ @Num i) {-# INLINE liftOp_ #-} -- | Lift an 'Op' with an arbitrary number of inputs to a function on the@@ -239,7 +239,7 @@ 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 :< Ø+ tn = TN { _tnInputs = IR v id (+) :< Ø , _tnGrad = g } {-# INLINE liftOp1_ #-}@@ -271,7 +271,7 @@ `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 :< Ø+ tn = TN { _tnInputs = IR v id (+) :< IR u id (+) :< Ø , _tnGrad = g } {-# INLINE liftOp2_ #-}@@ -307,7 +307,7 @@ `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 :< Ø+ tn = TN { _tnInputs = IR v id (+) :< IR u id (+) :< IR w id (+) :< Ø , _tnGrad = g } {-# INLINE liftOp3_ #-}@@ -337,7 +337,7 @@ viewVar_ l !v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s)) where y = _bvVal v ^. l- tn = TN { _tnInputs = IR v l :< Ø+ tn = TN { _tnInputs = IR v l (+) :< Ø , _tnGrad = only_ } {-# INLINE viewVar_ #-}@@ -365,7 +365,7 @@ `seq` insertNode tn y (reflect (Proxy @s)) where y = _bvVal v & l .~ _bvVal w- tn = TN { _tnInputs = IR w id :< IR v id :< Ø+ tn = TN { _tnInputs = IR w id (+) :< IR v id (+) :< Ø , _tnGrad = \d -> let (dw,dv) = l (,0) d in dw ::< dv ::< Ø }@@ -399,9 +399,9 @@ -> IO (BVar s (t a)) collectVar_ !vs = withV (toList vs) $ \(vVec :: Vec n (BVar s a)) -> do let tn :: TapeNode (t a)- tn = TN { _tnInputs = vecToProd (vmap ((`IR` id) . getI) vVec)- , _tnGrad = maybe (error "distributeVar") vecToProd- . listToVec (vecLen vVec)+ tn = TN { _tnInputs = vecToProd (vmap ((\v -> IR v id (+)) . getI) vVec)+ , _tnGrad = vecToProd+ . listToVecDef 0 (vecLen vVec) . map I . toList } traverse_ (evaluate . forceBVar) vs@@ -429,7 +429,7 @@ go :: Int -> a -> IO (BVar s a) go i y = insertNode tn y (reflect (Proxy @s)) where- tn = TN { _tnInputs = IR v (ixt t i) :< Ø+ tn = TN { _tnInputs = IR v (ixt t i) (+) :< Ø , _tnGrad = only_ } {-# INLINE traverseVar' #-}@@ -460,14 +460,8 @@ toListOfVar t !v = unsafePerformIO $ traverseVar' (toListOf t) t v {-# INLINE toListOfVar #-} -data SomeNum :: Type where- SN :: Num a- => Proxy a- -> a- -> SomeNum--data Runner s = R { _rDelta :: MV.MVector s SomeNum- , _rInputs :: MV.MVector s SomeNum+data Runner s = R { _rDelta :: MV.MVector s (Some I)+ , _rInputs :: MV.MVector s (Some I) } initRunner@@ -477,11 +471,11 @@ -> m (Runner s) initRunner (n, stns) (nx,xs) = do delts <- MV.new n- for_ (zip [n-1,n-2..] stns) $ \(i, STN (TN{..} :: TapeNode c)) -> do- MV.write delts i $ SN (Proxy @c) 0+ for_ (zip [n-1,n-2..] stns) $ \(i, STN (TN{..} :: TapeNode c)) ->+ MV.write delts i $ Some @_ @_ @c (I 0) inps <- MV.new nx- for_ (zip [0..] xs) $ \(i, Some (Wit1 :: Wit1 Num c)) -> do- MV.write inps i $ SN (Proxy @c) 0+ for_ (zip [0..] xs) $ \(i, Some (Wit1 :: Wit1 Num c)) ->+ MV.write inps i $ Some @_ @_ @c (I 0) return $ R delts inps {-# INLINE initRunner #-} @@ -493,22 +487,22 @@ -> m () gradRunner _ R{..} (n,stns) = do when (n > 0) $- MV.write _rDelta (n - 1) (SN (Proxy @b) 1)+ MV.write _rDelta (n - 1) (Some @_ @_ @b (I 1)) zipWithM_ go [n-1,n-2..] stns where go :: Int -> SomeTapeNode -> m () go i (STN TN{..}) = do- SN _ delt <- MV.read _rDelta i+ Some (I delt) <- MV.read _rDelta i let gs = _tnGrad (unsafeCoerce delt) zipWithPM_ propagate _tnInputs gs propagate :: forall x. InpRef x -> I x -> m ()- propagate (IR v ln) (I !d) = case _bvRef v of+ propagate (IR v ln (+*)) (I !d) = case _bvRef v of BRInp !i -> flip (MV.modify _rInputs) i $ \case- SN p !y -> let y' = unsafeCoerce y & ln %~ (+d)- in y' `seq` SN p (unsafeCoerce y')+ Some (I !y) -> let y' = unsafeCoerce y & ln %~ (+* d)+ in y' `seq` Some (I y') BRIx !i -> flip (MV.modify _rDelta) i $ \case- SN p !y -> let y' = unsafeCoerce y & ln %~ (+d)- in y' `seq` SN p (unsafeCoerce y')+ Some (I !y) -> let y' = unsafeCoerce y & ln %~ (+* d)+ in y' `seq` Some (I y') BRC -> return () {-# INLINE gradRunner #-} @@ -517,11 +511,12 @@ -- -- Not strictly necessary, because you can always uncurry a function by -- passing in all of the inputs in a data type containing all of the--- arguments. You could also pass in a giant tuple with+-- arguments or a tuple from "Numeric.Backprop.Tuple". You could also+-- pass in a giant tuple with -- <https://hackage.haskell.org/package/NumInstances NumInstances>.--- However, this can be convenient if you don't want to make a custom tuple--- type or pull in orphan instances. This could potentially also be more--- performant.+-- However, this can be convenient if you don't want to make a custom+-- larger tuple type or pull in orphan instances. This could potentially+-- also be more performant. -- -- A @'Prod' ('BVar' s) '[Double, Float, Double]@, for instance, is a tuple -- of @'BVar' s 'Double'@, @'BVar' s 'Float'@, and @'BVar' s 'Double'@, and@@ -552,7 +547,7 @@ gradRunner (Proxy @b) r tp delts <- toList <$> V.freeze (_rInputs r) return . fromMaybe (error "backpropN") $- fillProd (\_ (SN _ d) -> I (unsafeCoerce d)) xs delts+ fillProd (\_ (Some (I 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
+ src/Numeric/Backprop/Tuple.hs view
@@ -0,0 +1,261 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module : Numeric.Backprop.Tuple+-- Copyright : (c) Justin Le 2018+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Canonical strict tuples with 'Num' instances for usage with /backprop/.+-- This is here to solve the problem of orphan instances in libraries and+-- potential mismatched tuple types.+--+-- If you are writing a library that needs to export 'BVar's of tuples,+-- consider using the tuples in this module so that your library can have+-- easy interoperability with other libraries using /backprop/.+--+-- Because of API decisions, 'backprop' and 'gradBP' only work with things+-- with 'Num' instances. However, this disallows default 'Prelude' tuples+-- (without orphan instances from packages like+-- <https://hackage.haskell.org/package/NumInstances NumInstances>).+--+-- Until tuples have 'Num' instances in /base/, this module is intended to+-- be a workaround for situations where:+--+-- This comes up often in cases where:+--+-- (1) A function wants to return more than one value (@'BVar' s ('T2'+-- a b)@+-- (2) You want to uncurry a 'BVar' function to use with 'backprop' and+-- 'gradBP'.+-- (3) You want to use the useful 'Prism's automatically generated by+-- the lens library, which use tuples for multiple-constructor fields.+--+-- Only 2-tuples and 3-tuples are provided. Any more and you should+-- probably be using your own custom product types, with instances+-- automatically generated from something like+-- <https://hackage.haskell.org/package/one-liner-instances one-liner-instances>.+--+-- Lenses into the fields are provided, but they also work with '_1', '_2',+-- and '_3' from "Lens.Micro". However, note that these are incompatible+-- with '_1', '_2', and '_3' from "Control.Lens".+--+-- @since 0.1.1.0+--+++module Numeric.Backprop.Tuple (+ -- * Two-tuples+ T2(..)+ -- ** Conversions+ -- $t2iso+ , t2Tup, tupT2+ -- ** Lenses+ , t2_1, t2_2+ -- * Three-tuples+ , T3(..)+ -- ** Conversions+ -- $t3iso+ , t3Tup, tupT3+ -- ** Lenses+ , t3_1, t3_2, t3_3+ ) where++import Control.DeepSeq+import Data.Bifunctor+import Data.Data+import Data.Semigroup+import GHC.Generics (Generic)+import Lens.Micro+import Lens.Micro.Internal++-- | Strict 2-tuple with a 'Num' instance.+--+-- @since 0.1.1.0+data T2 a b = T2 !a !b+ deriving (Show, Read, Eq, Ord, Generic, Functor, Data)++-- | Strict 3-tuple with a 'Num' instance.+--+-- @since 0.1.1.0+data T3 a b c = T3 !a !b !c+ deriving (Show, Read, Eq, Ord, Generic, Functor, Data)++instance (NFData a, NFData b) => NFData (T2 a b)+instance (NFData a, NFData b, NFData c) => NFData (T3 a b c)++instance Bifunctor T2 where+ bimap f g (T2 x y) = T2 (f x) (g y)++instance Bifunctor (T3 a) where+ bimap f g (T3 x y z) = T3 x (f y) (g z)++-- | 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++-- | Convert to a Haskell tuple.+--+-- Forms an isomorphism with 'tupT3'.+t3Tup :: T3 a b c -> (a, b, c)+t3Tup (T3 x y z) = (x, y, z)++-- | Convert from Haskell tuple.+--+-- Forms an isomorphism with 't3Tup'.+tupT3 :: (a, b, c) -> T3 a b c+tupT3 (x, y, z) = T3 x y z++instance Field1 (T2 a b) (T2 a' b) a a' where+ _1 f (T2 x y) = (`T2` y) <$> f x++instance Field2 (T2 a b) (T2 a b') b b' where+ _2 f (T2 x y) = T2 x <$> f y++instance Field1 (T3 a b c) (T3 a' b c) a a' where+ _1 f (T3 x y z) = (\x' -> T3 x' y z) <$> f x++instance Field2 (T3 a b c) (T3 a b' c) b b' where+ _2 f (T3 x y z) = (\y' -> T3 x y' z) <$> f y++instance Field3 (T3 a b c) (T3 a b c') c c' where+ _3 f (T3 x y z) = T3 x y <$> f z++-- | Lens into the first field of a 'T2'. Also exported as '_1' from+-- "Lens.Micro".+t2_1 :: Lens (T2 a b) (T2 a' b) a a'+t2_1 = _1++-- | Lens into the second field of a 'T2'. Also exported as '_2' from+-- "Lens.Micro".+t2_2 :: Lens (T2 a b) (T2 a b') b b'+t2_2 = _2++-- | Lens into the first field of a 'T3'. Also exported as '_1' from+-- "Lens.Micro".+t3_1 :: Lens (T3 a b c) (T3 a' b c) a a'+t3_1 = _1++-- | Lens into the second field of a 'T3'. Also exported as '_2' from+-- "Lens.Micro".+t3_2 :: Lens (T3 a b c) (T3 a b' c) b b'+t3_2 = _2++-- | Lens into the third field of a 'T3'. Also exported as '_3' from+-- "Lens.Micro".+t3_3 :: Lens (T3 a b c) (T3 a b c') c c'+t3_3 = _3++instance (Num a, Num b) => Num (T2 a b) where+ T2 x1 y1 + T2 x2 y2 = T2 (x1 + x2) (y1 + y2)+ T2 x1 y1 - T2 x2 y2 = T2 (x1 - x2) (y1 - y2)+ T2 x1 y1 * T2 x2 y2 = T2 (x1 * x2) (y1 * y2)+ negate (T2 x y) = T2 (negate x) (negate y)+ abs (T2 x y) = T2 (abs x) (abs y)+ signum (T2 x y) = T2 (signum x) (signum y)+ fromInteger x = T2 (fromInteger x) (fromInteger x)++instance (Fractional a, Fractional b) => Fractional (T2 a b) where+ T2 x1 y1 / T2 x2 y2 = T2 (x1 / x2) (y1 / y2)+ recip (T2 x y) = T2 (recip x) (recip y)+ fromRational x = T2 (fromRational x) (fromRational x)++instance (Floating a, Floating b) => Floating (T2 a b) where+ pi = T2 pi pi+ T2 x1 y1 ** T2 x2 y2 = T2 (x1 ** x2) (y1 ** y2)+ logBase (T2 x1 y1) (T2 x2 y2) = T2 (logBase x1 x2) (logBase y1 y2)+ exp (T2 x y) = T2 (exp x) (exp y)+ log (T2 x y) = T2 (log x) (log y)+ sqrt (T2 x y) = T2 (sqrt x) (sqrt y)+ sin (T2 x y) = T2 (sin x) (sin y)+ cos (T2 x y) = T2 (cos x) (cos y)+ asin (T2 x y) = T2 (asin x) (asin y)+ acos (T2 x y) = T2 (acos x) (acos y)+ atan (T2 x y) = T2 (atan x) (atan y)+ sinh (T2 x y) = T2 (sinh x) (sinh y)+ cosh (T2 x y) = T2 (cosh x) (cosh y)+ asinh (T2 x y) = T2 (asinh x) (asinh y)+ acosh (T2 x y) = T2 (acosh x) (acosh y)+ atanh (T2 x y) = T2 (atanh x) (atanh y)++instance (Semigroup a, Semigroup b) => Semigroup (T2 a b) where+ T2 x1 y1 <> T2 x2 y2 = T2 (x1 <> x2) (y1 <> y2)++instance (Monoid a, Monoid b) => Monoid (T2 a b) where+ mappend (T2 x1 y1) (T2 x2 y2) = T2 (mappend x1 x2) (mappend y1 y2)+ mempty = T2 mempty mempty++instance (Num a, Num b, Num c) => Num (T3 a b c) where+ T3 x1 y1 z1 + T3 x2 y2 z2 = T3 (x1 + x2) (y1 + y2) (z1 + z2)+ T3 x1 y1 z1 - T3 x2 y2 z2 = T3 (x1 - x2) (y1 - y2) (z1 + z2)+ T3 x1 y1 z1 * T3 x2 y2 z2 = T3 (x1 * x2) (y1 * y2) (z1 + z2)+ negate (T3 x y z) = T3 (negate x) (negate y) (negate z)+ abs (T3 x y z) = T3 (abs x) (abs y) (abs z)+ signum (T3 x y z) = T3 (signum x) (signum y) (signum z)+ fromInteger x = T3 (fromInteger x) (fromInteger x) (fromInteger x)++instance (Fractional a, Fractional b, Fractional c) => Fractional (T3 a b c) where+ T3 x1 y1 z1 / T3 x2 y2 z2 = T3 (x1 / x2) (y1 / y2) (z1 / z2)+ recip (T3 x y z) = T3 (recip x) (recip y) (recip z)+ fromRational x = T3 (fromRational x) (fromRational x) (fromRational x)++instance (Floating a, Floating b, Floating c) => Floating (T3 a b c) where+ pi = T3 pi pi pi+ T3 x1 y1 z1 ** T3 x2 y2 z2 = T3 (x1 ** x2) (y1 ** y2) (z1 ** z2)+ logBase (T3 x1 y1 z1) (T3 x2 y2 z2) = T3 (logBase x1 x2) (logBase y1 y2) (logBase z1 z2)+ exp (T3 x y z) = T3 (exp x) (exp y) (exp z)+ log (T3 x y z) = T3 (log x) (log y) (log z)+ sqrt (T3 x y z) = T3 (sqrt x) (sqrt y) (sqrt z)+ sin (T3 x y z) = T3 (sin x) (sin y) (sin z)+ cos (T3 x y z) = T3 (cos x) (cos y) (cos z)+ asin (T3 x y z) = T3 (asin x) (asin y) (asin z)+ acos (T3 x y z) = T3 (acos x) (acos y) (acos z)+ atan (T3 x y z) = T3 (atan x) (atan y) (atan z)+ sinh (T3 x y z) = T3 (sinh x) (sinh y) (sinh z)+ cosh (T3 x y z) = T3 (cosh x) (cosh y) (cosh z)+ asinh (T3 x y z) = T3 (asinh x) (asinh y) (asinh z)+ acosh (T3 x y z) = T3 (acosh x) (acosh y) (acosh z)+ atanh (T3 x y z) = T3 (atanh x) (atanh y) (atanh z)++instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (T3 a b c) where+ T3 x1 y1 z1 <> T3 x2 y2 z2 = T3 (x1 <> x2) (y1 <> y2) (z1 <> z2)++instance (Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) where+ mappend (T3 x1 y1 z1) (T3 x2 y2 z2) = T3 (mappend x1 x2) (mappend y1 y2) (mappend z1 z2)+ mempty = T3 mempty mempty mempty++-- $t2iso+--+-- If using /lens/, the two conversion functions can be chained with prisms+-- and traversals and other optics using:+--+-- @+-- 'iso' 'tupT2' 't2Tup' :: 'Iso'' (a, b) ('T2' a b)+-- @++-- $t3iso+--+-- If using /lens/, the two conversion functions can be chained with prisms+-- and traversals and other optics using:+--+-- @+-- 'iso' 'tupT3' 't2Tup' :: 'Iso'' (a, b, c) ('T3' a b c)+-- @