packages feed

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 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)+-- @