backprop 0.1.5.2 → 0.2.0.0

raw patch · 21 files changed

+2552/−1147 lines, 21 filesdep +containersdep −binarydep −randomPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependencies removed: binary, random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +30/−0
• README.md +0/−47
• backprop.cabal +8/−5
• bench/bench.hs +11/−16
• renders/backprop-mnist.md +27/−0
• renders/backprop-mnist.pdf binary
• renders/extensible-neural.md +18/−0
• renders/extensible-neural.pdf binary
• samples/backprop-mnist.lhs +22/−0
• samples/extensible-neural.lhs +20/−0
• src/Data/Type/Util.hs +34/−0
• src/Numeric/Backprop.hs +272/−91
• src/Numeric/Backprop/Class.hs +649/−0
• src/Numeric/Backprop/Explicit.hs +321/−0
• src/Numeric/Backprop/Internal.hs +271/−234
• src/Numeric/Backprop/Num.hs +426/−0
• src/Numeric/Backprop/Op.hs +6/−0
• src/Numeric/Backprop/Tuple.hs +0/−712
• src/Prelude/Backprop.hs +25/−42
• src/Prelude/Backprop/Explicit.hs +225/−0
• src/Prelude/Backprop/Num.hs +187/−0

@@ -1,6 +1,36 @@ Changelog ========= +Version 0.2.0.0+---------------++*May 1, 2018*++<https://github.com/mstksg/backprop/releases/tag/v0.2.0.0>++*   Added `Backprop` class in *Numeric.Backprop.Class*, which is a typeclass+    specifically for "backpropagatable" values.  This will replace `Num`.+*   API of *Numeric.Backprop* completely re-written to require values be+    instances of `Backprop` instead of `Num`.  This closes some outstanding+    issues with the reliance of `Num`, and allows backpropagation to work with+    non-Num instances like variable-length vectors, matrices, lists, tuples,+    etc. (including types from *accelerate*)+*   *Numeric.Backprop.Num* and *Prelude.Backprop.Num* modules added, providing+    the old interface that uses `Num` instances instead of `Backprop`+    instances, for those who wish to avoid writing orphan instances when+    working with external types.+*   *Numeric.Backprop.Explicit* and *Prelude.Backprop.Explicit* modules added,+    providing an interface that allows users to manually specify how zeroing,+    addition, and one-ing works on a per-value basis.  Useful for those who+    wish to avoid writing orphan instances of `Backprop` for types with no+    `Num` instances, or if you are mixing and matching styles.+*   `backpropWith` variants added, allowing you to specify a "final gradient",+    instead of assuming it to be 1.+*   Added `auto`, a shorter alias for `constVar` inspired by the *ad* library.+*   *Numeric.Backprop.Tuple* module removed.  I couldn't find a significant+    reason to keep it now that `Num` is no longer required for backpropagation.++ Version 0.1.5.2 --------------- 

@@ -246,53 +246,6 @@  2.  Write tests! -3.  Explore potentially ditching `Num` for another typeclass that only has `+`,-    `0`, and `1`.  Currently, `Num` is required for all backpropagated types,-    but only `+`, `fromInteger 0`, and `fromInteger 1` are ever used.--    The main upside to using `Num` is that it integrates well with the rest of-    the Haskell ecosystem, and many things already have useful `Num` instances.--    There are two downsides -- one minor and one major.--    *   It requires more work to make a type backpropagatable.  Instead of-        writing only `+`, `0` and `1`, users must also define `*`, `-` or-        `negate`, `abs`, `signum`, and all of `fromInteger`.  However, I don't-        see this being a big issue in practice, since most values that will be-        used with *backprop* would presumably also benefit from having a full-        `Num` instance even without the need to backprop.--    *   Automatically generated prisms (used with `^^?`) work with tuples, and-        so cannot work out-of-the-box without a `Num` instance for tuples.  In-        addition, it's often useful to have anonymous products and tuples in-        general.--        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-    entire numeric Haskell ecosystem, at the time, revolves around `Num`.--    However, it is worth noting that it wouldn't be too hard to add "Additive-    Typeclass" instances for any custom types -- one would just need to define-    `(<+>) = (+)`, `zero = fromInteger 0`, and `one = fromInteger 1` (a-    three-liner), so it might not be too bad.--    But really, a lot of this would all resolve itself if we got `Num`-    instances for tuples in base :)- 3.  Explore opportunities for parallelization.  There are some naive ways of     directly parallelizing right now, but potential overhead should be     investigated.

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1a3823df38b9b0fe0ecb1481bea9f4b591e24a0abe5f96c21bf88c2b6055851b+-- hash: 0ba2801ba9787e38a25a6b3a1f48172558ed7066726034c01b1f3b01b9ee17fa  name:           backprop-version:        0.1.5.2+version:        0.2.0.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.@@ -47,20 +47,23 @@   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -fprint-explicit-kinds   build-depends:       base >=4.7 && <5-    , binary+    , containers     , deepseq     , microlens     , primitive-    , random     , reflection     , transformers     , type-combinators     , vector   exposed-modules:       Numeric.Backprop+      Numeric.Backprop.Class+      Numeric.Backprop.Explicit+      Numeric.Backprop.Num       Numeric.Backprop.Op-      Numeric.Backprop.Tuple       Prelude.Backprop+      Prelude.Backprop.Explicit+      Prelude.Backprop.Num   other-modules:       Numeric.Backprop.Internal       Data.Type.Util

@@ -25,6 +25,7 @@ import           GHC.Generics                 (Generic) import           GHC.TypeLits import           Numeric.Backprop+import           Numeric.Backprop.Class import           Numeric.LinearAlgebra.Static import           System.Directory import qualified Data.Vector.Generic          as VG@@ -314,21 +315,15 @@     uniform g = Net <$> MWC.uniform g <*> MWC.uniform g <*> MWC.uniform g     uniformR (l, h) g = (\x -> x * (h - l) + l) <$> MWC.uniform g -instance (Num a, Num b) => Num (a, b) where-    (x1,y1) + (x2,y2) = (x1 + x2, y1 + y2)-    (x1,y1) * (x2,y2) = (x1 * x2, y1 * y2)-    (x1,y1) - (x2,y2) = (x1 - x2, y1 - y2)-    abs (x, y)        = (abs x, abs y)-    signum (x, y)     = (signum x, signum y)-    fromInteger x     = (fromInteger x, fromInteger x)+instance Backprop (R n) where+    zero = zeroNum+    add  = addNum+    one  = oneNum --- softMaxCrossEntropy---     :: KnownNat n---     => R n---     -> BPOpI s '[ R n ] Double--- softMaxCrossEntropy targ (r :< Ø) =  realToFrac tsum * log (vsum .$ (r :< Ø))---                                        - (dot .$ (r :< t :< Ø))---   where---     tsum = HM.sumElements . extract $ targ---     t    = constVar targ+instance (KnownNat n, KnownNat m) => Backprop (L m n) where+    zero = zeroNum+    add  = addNum+    one  = oneNum +instance (KnownNat i, KnownNat o) => Backprop (Layer i o)+instance (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o) => Backprop (Network i h1 h2 o)

@@ -67,6 +67,7 @@ import           GHC.Generics                        (Generic) import           GHC.TypeLits import           Numeric.Backprop+import           Numeric.Backprop.Class import           Numeric.LinearAlgebra.Static import           Numeric.OneLiner import           Text.Printf@@ -206,6 +207,15 @@ refer to the numbers in its type and use it to go about its normal hmatrixy business. +Now we need instances of `Backprop` for our types in order to use them+for automatic differentiation. Luckily, these can be generated+automatically using GHC Generics:++``` {.sourceCode .literate .haskell}+instance (KnownNat i, KnownNat o) => Backprop (Layer i o)+instance (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o) => Backprop (Network i h1 h2 o)+```+ Ops === @@ -688,4 +698,21 @@       => MWC.Variate (Network i h1 h2 o) where     uniform g = Net <$> MWC.uniform g <*> MWC.uniform g <*> MWC.uniform g     uniformR (l, h) g = (\x -> x * (h - l) + l) <$> MWC.uniform g+```++Also, some orphan instances of `Backprop` for vector and matrix types.+These are provided by the [hmatrix-backprop] library normally:++  [hmatrix-backprop]: http://hackage.haskell.org/package/hmatrix-backprop++``` {.sourceCode .literate .haskell}+instance Backprop (R n) where+    zero = zeroNum+    add  = addNum+    one  = oneNum++instance (KnownNat n, KnownNat m) => Backprop (L m n) where+    zero = zeroNum+    add  = addNum+    one  = oneNum ```

binary file changed (133763 → 134752 bytes)

@@ -62,6 +62,7 @@ import           Data.Tuple import           GHC.Generics                    (Generic) import           Numeric.Backprop+import           Numeric.Backprop.Class import           Numeric.LinearAlgebra.Static import           Numeric.OneLiner import           Text.Printf@@ -436,7 +437,9 @@     recip        = gRecip     fromRational = gFromRational +instance (KnownNat i, KnownNat o) => Backprop (Layer i o) + liftNet0     :: forall i hs o. (KnownNat i, KnownNat o)     => (forall m n. (KnownNat m, KnownNat n) => Layer m n)@@ -518,6 +521,11 @@     recip          = liftNet1 negate sing     fromRational x = liftNet0 (fromRational x) sing +instance (KnownNat i, KnownNat o, SingI hs) => Backprop (Net i hs o) where+    zero = liftNet1 zero sing+    add  = liftNet2 add sing+    one  = liftNet1 one sing+ instance KnownNat n => MWC.Variate (R n) where     uniform g = randomVector <$> MWC.uniform g <*> pure Uniform     uniformR (l, h) g = (\x -> x * (h - l) + l) <$> MWC.uniform g@@ -548,4 +556,14 @@     rnf = \case       NO l    -> rnf l       x :~ xs -> rnf x `seq` rnf xs++instance Backprop (R n) where+    zero = zeroNum+    add  = addNum+    one  = oneNum++instance (KnownNat n, KnownNat m) => Backprop (L m n) where+    zero = zeroNum+    add  = addNum+    one  = oneNum ```

binary file changed (107850 → 107912 bytes)

@@ -63,6 +63,7 @@ > import           GHC.Generics                        (Generic) > import           GHC.TypeLits > import           Numeric.Backprop+> import           Numeric.Backprop.Class > import           Numeric.LinearAlgebra.Static > import           Numeric.OneLiner > import           Text.Printf@@ -192,6 +193,13 @@ to the numbers in its type and use it to go about its normal hmatrixy business. +Now we need instances of `Backprop` for our types in order to use them for+automatic differentiation.  Luckily, these can be generated automatically+using GHC Generics:++> instance (KnownNat i, KnownNat o) => Backprop (Layer i o)+> instance (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o) => Backprop (Network i h1 h2 o)+ Ops === @@ -626,3 +634,17 @@ >     uniform g = Net <$> MWC.uniform g <*> MWC.uniform g <*> MWC.uniform g >     uniformR (l, h) g = (\x -> x * (h - l) + l) <$> MWC.uniform g +Also, some orphan instances of `Backprop` for vector and matrix types.  These+are provided by the [hmatrix-backprop][] library normally:++> instance Backprop (R n) where+>     zero = zeroNum+>     add  = addNum+>     one  = oneNum+>+> instance (KnownNat n, KnownNat m) => Backprop (L m n) where+>     zero = zeroNum+>     add  = addNum+>     one  = oneNum++[hmatrix-backprop]: http://hackage.haskell.org/package/hmatrix-backprop

@@ -59,6 +59,7 @@ > import           Data.Tuple > import           GHC.Generics                    (Generic) > import           Numeric.Backprop+> import           Numeric.Backprop.Class > import           Numeric.LinearAlgebra.Static > import           Numeric.OneLiner > import           Text.Printf@@ -414,7 +415,9 @@ >     recip        = gRecip >     fromRational = gFromRational >+> instance (KnownNat i, KnownNat o) => Backprop (Layer i o) >+> > liftNet0 >     :: forall i hs o. (KnownNat i, KnownNat o) >     => (forall m n. (KnownNat m, KnownNat n) => Layer m n)@@ -496,6 +499,11 @@ >     recip          = liftNet1 negate sing >     fromRational x = liftNet0 (fromRational x) sing >+> instance (KnownNat i, KnownNat o, SingI hs) => Backprop (Net i hs o) where+>     zero = liftNet1 zero sing+>     add  = liftNet2 add sing+>     one  = liftNet1 one sing+> > instance KnownNat n => MWC.Variate (R n) where >     uniform g = randomVector <$> MWC.uniform g <*> pure Uniform >     uniformR (l, h) g = (\x -> x * (h - l) + l) <$> MWC.uniform g@@ -526,3 +534,15 @@ >     rnf = \case >       NO l    -> rnf l >       x :~ xs -> rnf x `seq` rnf xs+>+> instance Backprop (R n) where+>     zero = zeroNum+>     add  = addNum+>     one  = oneNum+>+> instance (KnownNat n, KnownNat m) => Backprop (L m n) where+>     zero = zeroNum+>     add  = addNum+>     one  = oneNum++[hmatrix-backprop]: http://hackage.haskell.org/package/hmatrix-backprop

@@ -11,11 +11,13 @@   , unzipP   , zipP   , zipWithPM_+  , zipWithPM3_   , vecToProd   , vecLen   , lengthProd   , listToVecDef   , fillProd+  , zipVecList   ) where  import           Data.Bifunctor@@ -66,6 +68,23 @@       x :< xs -> \case         y :< ys -> f x y *> go xs ys +zipWithPM3_+    :: forall m f g h as. Applicative m+    => (forall a. f a -> g a -> h a -> m ())+    -> Prod f as+    -> Prod g as+    -> Prod h as+    -> m ()+zipWithPM3_ f = go+  where+    go :: forall bs. Prod f bs -> Prod g bs -> Prod h bs -> m ()+    go = \case+      Ø -> \case+        Ø -> \case+          Ø -> pure ()+      x :< xs -> \case+        y :< ys -> \case+          z :< zs -> f x y z *> go xs ys zs  zipP     :: Prod f as@@ -122,3 +141,18 @@       x :< xs -> \case         []   -> Nothing         y:ys -> (f x y :<) <$> go xs ys++zipVecList+    :: forall a b c f g n. ()+    => (f a -> Maybe b -> g c)+    -> VecT n f a+    -> [b]+    -> VecT n g c+zipVecList f = go+  where+    go :: VecT m f a -> [b] -> VecT m g c+    go = \case+      ØV -> const ØV+      x :* xs -> \case+        []   -> f x Nothing  :* go xs []+        y:ys -> f x (Just y) :* go xs ys

@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs            #-}-{-# LANGUAGE PatternSynonyms  #-}-{-# LANGUAGE RankNTypes       #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE PatternSynonyms   #-}+{-# LANGUAGE RankNTypes        #-}  -- | -- Module      : Numeric.Backprop@@ -46,17 +47,28 @@ -- and links to demonstrations and tutorials, or dive striaght in by -- reading the docs for 'BVar'. --+-- In the original version 0.1, this module required 'Num' instances for+-- methods instead of 'Backprop' instances.  This interface is still+-- available in "Numeric.Backprop.Num", which has the same API as this+-- module, except with 'Num' constraints on all values instead of+-- 'Backprop' constraints.+--+-- See "Prelude.Backprop.Explicit" for a version allowing you to provide+-- 'zero', 'add', and 'one' explicitly, which can be useful when attempting+-- to avoid orphan instances or when mixing both 'Backprop' and 'Num'+-- styles.+--  module Numeric.Backprop (     -- * Types-    BVar, W+    BVar, W, Backprop(..)     -- * Running-  , backprop, evalBP, gradBP+  , backprop, E.evalBP, gradBP, backpropWith     -- ** Multiple inputs-  , backprop2, evalBP2, gradBP2-  , backpropN, evalBPN, gradBPN, Every+  , backprop2, E.evalBP2, gradBP2, backpropWith2+  , backpropN, E.evalBPN, gradBPN, backpropWithN, Every     -- * Manipulating 'BVar'-  , constVar, coerceVar+  , E.constVar, E.auto, E.coerceVar   , (^^.), (.~~), (^^?), (^^..)   , viewVar, setVar   , sequenceVar, collectVar@@ -87,12 +99,15 @@   , Reifies   ) where -import           Data.Bifunctor import           Data.Reflection import           Data.Type.Index+import           Data.Type.Length import           Lens.Micro-import           Numeric.Backprop.Internal+import           Numeric.Backprop.Class+import           Numeric.Backprop.Explicit (BVar, W) import           Numeric.Backprop.Op+import           Type.Class.Known+import qualified Numeric.Backprop.Explicit as E  -- $liftops --@@ -138,6 +153,51 @@ -- -> b@, using 'evalBP', and this carries virtually zero overhead, so some -- libraries might even provide 'BVar' versions by default. +-- | 'backprop' generalized to multiple inputs of different types.  See the+-- "Numeric.Backprop.Op#prod" for a mini-tutorial on heterogeneous lists.+--+-- 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 or a giant tuple.  However, 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+-- can be pattern matched on using ':<' (cons) and 'Ø' (nil).+--+-- Tuples can be built and pattern matched on using '::<' (cons) and 'Ø'+-- (nil), as well.+--+-- The @'Every' 'Backprop' as@ in the constraint says that every value in+-- the type-level list @as@ must have a 'Backprop' instance.  This means+-- you can use, say, @'[Double, Float, Int]@, but not @'[Double, Bool,+-- String]@.+--+-- If you stick to /concerete/, monomorphic usage of this (with specific+-- types, typed into source code, known at compile-time), then @'Every'+-- 'Backprop' as@ should be fulfilled automatically.+backpropN+    :: (Every Backprop as, Known Length as, Backprop b)+    => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> (b, Tuple as)+backpropN = E.backpropN E.zeroFuncs E.oneFunc+{-# INLINE backpropN #-}++-- | 'backpropN', but allows you to provide the gradient of the "final+-- result" with respect to the output of your function.  See 'backpropWith'+-- for more details.+--+-- @since 0.2.0.0+backpropWithN+    :: (Every Backprop as, Known Length as)+    => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> (b -> b)                 -- ^ Gradient of final result with respect to output of function+    -> (b, Tuple as)+backpropWithN = E.backpropWithN E.zeroFuncs+{-# INLINE backpropWithN #-}+ -- | Turn a function @'BVar' s a -> 'BVar' s b@ into the function @a -> b@ -- that it represents, also computing its gradient @a@ as well. --@@ -145,55 +205,37 @@ -- that 'BVar's do not leak out of the context (similar to how it is used -- in "Control.Monad.ST"), and also as a reference to an ephemeral Wengert -- tape used to track the graph of references.------ Note that every type involved has to be an instance of 'Num'.  This is--- because gradients all need to be "summable" (which is implemented using--- 'sum' and '+'), and we also need to able to generate gradients of 1--- and 0.  Really, only '+' and 'fromInteger' methods are used from the--- 'Num' typeclass.------ This might change in the future, to allow easier integration with tuples--- (which typically do not have a 'Num' instance), and potentially make--- types easier to use (by only requiring '+', 0, and 1, and not the rest--- of the 'Num' class).------ See the <https://github.com/mstksg/backprop README> for a more detailed--- discussion on this issue.------ 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") if you are writing an--- application and do not have to worry about orphan instances. backprop-    :: forall a b. (Num a, Num b)+    :: (Backprop a, Backprop b)     => (forall s. Reifies s W => BVar s a -> BVar s b)     -> a     -> (b, a)-backprop f = second (getI . head')-           . backpropN (f . head')-           . only_+backprop = E.backprop E.zeroFunc E.oneFunc {-# INLINE backprop #-} --- | Turn a function @'BVar' s a -> 'BVar' s b@ into the function @a -> b@--- that it represents.+-- | A version of 'backprop' that allows you to specify the gradent of your+-- "final result" in with respect to the output of your function. ----- Benchmarks show that this should have virtually no overhead over--- directly writing a @a -> b@. 'BVar' is, in this situation, a zero-cost--- abstraction, performance-wise.+-- Typically, this is just the scalar 1, or a value of components that are+-- all 1. ----- Has a nice advantage over using 'backprop' in that it doesn't require--- 'Num' constraints on the input and output.+-- Instead of taking the @b@ gradient, the you may provide a @b -> b@,+-- which 'backpropWith' calls with the result of your function as the+-- argument.  This allows you to return something with the correct "shape",+-- if not a scalar. ----- See documentation of 'backprop' for more information.+-- 'backprop' is essentially 'backpropWith' with @'const' 1@ for scalars+-- and 'Num' instances. ---evalBP :: (forall s. Reifies s W => BVar s a -> BVar s b) -> a -> b-evalBP f = evalBPN (f . head') . only_-{-# INLINE evalBP #-}+-- @since 0.2.0.0+backpropWith+    :: Backprop a+    => (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> (b -> b)                 -- ^ Gradient of final result with respect to output of function+    -> (b, a)+backpropWith = E.backpropWith E.zeroFunc+{-# INLINE backpropWith #-}  -- | Take a function @'BVar' s a -> 'BVar' s b@, interpreted as a function -- @a -> b@, and compute its gradient with respect to its input.@@ -207,58 +249,65 @@ -- -- See documentation of 'backprop' for more information. --+-- If you want to provide an explicit "final gradient" for the end, see+-- 'backpropWith'. gradBP-    :: forall a b. (Num a, Num b)+    :: (Backprop a, Backprop b)     => (forall s. Reifies s W => BVar s a -> BVar s b)     -> a     -> a-gradBP f = snd . backprop f+gradBP = E.gradBP E.zeroFunc E.oneFunc {-# INLINE gradBP #-}  -- | 'gradBP' generalized to multiple inputs of different types.  See -- documentation for 'backpropN' for more details. gradBPN-    :: forall as b. (Every Num as, Num b)+    :: (Every Backprop as, Known Length as, Backprop b)     => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)     -> Tuple as     -> Tuple as-gradBPN f = snd . backpropN f+gradBPN = E.gradBPN E.zeroFuncs E.oneFunc {-# INLINE gradBPN #-}  -- | 'backprop' for a two-argument function. -- -- Not strictly necessary, because you can always uncurry a function by--- passing in all of the argument inside a data type, or use 'T2'. However,--- this could potentially be more performant.+-- passing in all of the argument inside a data type, or just use a tuple.+-- However, this could potentially be more performant. -- -- For 3 and more arguments, consider using 'backpropN'. backprop2-    :: forall a b c. (Num a, Num b, Num c)+    :: (Backprop a, Backprop b, Backprop c)     => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)     -> a     -> b     -> (c, (a, b))-backprop2 f x y = second (\(dx ::< dy ::< Ø) -> (dx, dy))-                $ backpropN (\(x' :< y' :< Ø) -> f x' y') (x ::< y ::< Ø)+backprop2 = E.backprop2 E.zeroFunc E.zeroFunc E.oneFunc {-# INLINE backprop2 #-} --- | 'evalBP' for a two-argument function.  See 'backprop2' for notes.-evalBP2-    :: (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+-- | 'backprop2', but allows you to provide the gradient of the "final+-- result" with respect to the output of your function.  See 'backpropWith'+-- for more details.+--+-- @since 0.2.0.0+backpropWith2+    :: (Backprop a, Backprop b)+    => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)     -> a     -> b-    -> c-evalBP2 f x y = evalBPN (\(x' :< y' :< Ø) -> f x' y') (x ::< y ::< Ø)-{-# INLINE evalBP2 #-}+    -> (c -> c)                 -- ^ Gradient of final result with respect to output of function+    -> (c, (a, b))+backpropWith2 = E.backpropWith2 E.zeroFunc E.zeroFunc+{-# INLINE backpropWith2 #-}  -- | 'gradBP' for a two-argument function.  See 'backprop2' for notes. gradBP2-    :: (Num a, Num b, Num c)+    :: (Backprop a, Backprop b, Backprop c)     => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)     -> a     -> b     -> (a, b)-gradBP2 f x = snd . backprop2 f x+gradBP2 = E.gradBP2 E.zeroFunc E.zeroFunc E.oneFunc {-# INLINE gradBP2 #-}  -- | An infix version of 'viewVar', meant to evoke parallels to '^.' from@@ -288,7 +337,7 @@ -- the contents (like 'multiplying'). -- (^^.)-    :: forall a b s. (Reifies s W, Num a)+    :: forall a b s. (Reifies s W, Backprop a)     => BVar s b     -> Lens' b a     -> BVar s a@@ -296,6 +345,19 @@ infixl 8 ^^. {-# INLINE (^^.) #-} +-- | Using a 'Lens'', extract a value /inside/ a 'BVar'.  Meant to evoke+-- parallels to 'view' from lens.+--+-- See documentation for '^^.' for more information.+viewVar+    :: forall a b s. (Reifies s W, Backprop a)+    => Lens' b a+    -> BVar s b+    -> BVar s a+viewVar = E.viewVar E.addFunc E.zeroFunc+{-# INLINE viewVar #-}++ -- | An infix version of 'setVar', meant to evoke parallels to '.~' from -- lens. --@@ -320,7 +382,7 @@ -- This is the main way to set values inside 'BVar's of container types. -- (.~~)-    :: forall a b s. (Reifies s W, Num a, Num b)+    :: forall a b s. (Reifies s W, Backprop a, Backprop b)     => Lens' b a     -> BVar s a     -> BVar s b@@ -329,6 +391,20 @@ infixl 8 .~~ {-# INLINE (.~~) #-} +-- | Using a 'Lens'', set a value /inside/ a 'BVar'.  Meant to evoke+-- parallels to "set" from lens.+--+-- See documentation for '.~~' for more information.+setVar+    :: forall a b s. (Reifies s W, Backprop a, Backprop b)+    => Lens' b a+    -> BVar s a+    -> BVar s b+    -> BVar s b+setVar = E.setVar E.addFunc E.addFunc E.zeroFunc E.zeroFunc+{-# INLINE setVar #-}++ -- | An infix version of 'previewVar', meant to evoke parallels to '^?' -- from lens. --@@ -358,30 +434,28 @@ -- -- This can be used to "pattern match" on 'BVar's, by using prisms on -- constructors.------ 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).------ 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)+    :: forall b a s. (Backprop a, Reifies s W)     => BVar s b     -> Traversal' b a     -> Maybe (BVar s a) v ^^? t = previewVar t v {-# INLINE (^^?) #-} +-- | Using a 'Traversal'', extract a single value /inside/ a 'BVar', if it+-- exists.  If more than one traversal target exists, returns te first.+-- Meant to evoke parallels to 'preview' from lens.  Really only intended+-- to be used wth 'Prism''s, or up-to-one target traversals.+--+-- See documentation for '^^?' for more information.+previewVar+    :: forall b a s. (Reifies s W, Backprop a)+    => Traversal' b a+    -> BVar s b+    -> Maybe (BVar s a)+previewVar = E.previewVar E.addFunc E.zeroFunc+{-# INLINE previewVar #-}+ -- | An infix version of 'toListOfVar', meant to evoke parallels to '^..' -- from lens. --@@ -404,13 +478,120 @@ -- has type @['BVar' s a]@ (A list of 'BVar's holding @a@s). -- (^^..)-    :: forall b a s. (Num a, Reifies s W)+    :: forall b a s. (Backprop a, Reifies s W)     => BVar s b     -> Traversal' b a     -> [BVar s a] v ^^.. t = toListOfVar t v {-# INLINE (^^..) #-} +-- | Using a 'Traversal'', extract all targeted values /inside/ a 'BVar'.+-- Meant to evoke parallels to 'toListOf' from lens.+--+-- See documentation for '^^..' for more information.+toListOfVar+    :: forall b a s. (Backprop a, Reifies s W)+    => Traversal' b a+    -> BVar s b+    -> [BVar s a]+toListOfVar = E.toListOfVar E.addFunc E.zeroFunc+{-# INLINE toListOfVar #-}++-- | Extract all of the 'BVar's out of a 'Traversable' container of+-- 'BVar's.+--+-- Note that this associates gradients in order of occurrence in the+-- original data structure; the second item in the gradient is assumed to+-- correspond with the second item in the input, etc.; this can cause+-- unexpected behavior in 'Foldable' instances that don't have a fixed+-- number of items.+sequenceVar+    :: forall t a s. (Backprop a, Reifies s W, Traversable t)+    => BVar s (t a)+    -> t (BVar s a)+sequenceVar = E.sequenceVar E.addFunc E.zeroFunc+{-# INLINE sequenceVar #-}++-- | Collect all of the 'BVar's in a container into a 'BVar' of that+-- container's contents.+--+-- Note that this associates gradients in order of occurrence in the+-- original data structure; the second item in the total derivative and+-- gradient is assumed to correspond with the second item in the input,+-- etc.; this can cause unexpected behavior in 'Foldable' instances that+-- don't have a fixed number of items.+collectVar+    :: forall t a s. (Backprop a, Backprop (t a), Reifies s W, Foldable t, Functor t)+    => t (BVar s a)+    -> BVar s (t a)+collectVar = E.collectVar E.addFunc E.zeroFunc E.zeroFunc+{-# INLINE collectVar #-}++-- | Lift an 'Op' with an arbitrary number of inputs to a function on the+-- appropriate number of 'BVar's.+--+-- Should preferably be used only by libraries to provide primitive 'BVar'+-- functions for their types for users.+--+-- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more+-- information, and "Numeric.Backprop.Op#prod" for a mini-tutorial on using+-- 'Prod' and 'Tuple'.+liftOp+    :: forall as b s. (Every Backprop as, Known Length as, Backprop b, Reifies s W)+    => Op as b+    -> Prod (BVar s) as+    -> BVar s b+liftOp = E.liftOp E.addFuncs E.zeroFunc+{-# INLINE liftOp #-}++-- | Lift an 'Op' with a single input to be a function on a single 'BVar'.+--+-- Should preferably be used only by libraries to provide primitive 'BVar'+-- functions for their types for users.+--+-- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more+-- information.+liftOp1+    :: forall a b s. (Backprop a, Backprop b, Reifies s W)+    => Op '[a] b+    -> BVar s a+    -> BVar s b+liftOp1 = E.liftOp1 E.addFunc E.zeroFunc+{-# INLINE liftOp1 #-}++-- | Lift an 'Op' with two inputs to be a function on a two 'BVar's.+--+-- Should preferably be used only by libraries to provide primitive 'BVar'+-- functions for their types for users.+--+-- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more+-- information.+liftOp2+    :: forall a b c s. (Backprop a, Backprop b, Backprop c, Reifies s W)+    => Op '[a,b] c+    -> BVar s a+    -> BVar s b+    -> BVar s c+liftOp2 = E.liftOp2 E.addFunc E.addFunc E.zeroFunc+{-# INLINE liftOp2 #-}++-- | Lift an 'Op' with three inputs to be a function on a three 'BVar's.+--+-- Should preferably be used only by libraries to provide primitive 'BVar'+-- functions for their types for users.+--+-- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more+-- information.+liftOp3+    :: forall a b c d s. (Backprop a, Backprop b, Backprop c, Backprop d, Reifies s W)+    => Op '[a,b,c] d+    -> BVar s a+    -> BVar s b+    -> BVar s c+    -> BVar s d+liftOp3 = E.liftOp3 E.addFunc E.addFunc E.addFunc E.zeroFunc+{-# INLINE liftOp3 #-}+ -- | Convert the value inside a 'BVar' using a given isomorphism.  Useful -- for things like constructors. --@@ -420,7 +601,7 @@ -- -- @since 0.1.4.0 isoVar-    :: (Num a, Num b, Reifies s W)+    :: (Backprop a, Backprop b, Reifies s W)     => (a -> b)     -> (b -> a)     -> BVar s a@@ -433,7 +614,7 @@ -- -- @since 0.1.4.0 isoVar2-    :: (Num a, Num b, Num c, Reifies s W)+    :: (Backprop a, Backprop b, Backprop c, Reifies s W)     => (a -> b -> c)     -> (c -> (a, b))     -> BVar s a@@ -447,7 +628,7 @@ -- -- @since 0.1.4.0 isoVar3-    :: (Num a, Num b, Num c, Num d, Reifies s W)+    :: (Backprop a, Backprop b, Backprop c, Backprop d, Reifies s W)     => (a -> b -> c -> d)     -> (d -> (a, b, c))     -> BVar s a@@ -463,7 +644,7 @@ -- -- @since 0.1.4.0 isoVarN-    :: (Every Num as, Num b, Reifies s W)+    :: (Every Backprop as, Known Length as, Backprop b, Reifies s W)     => (Tuple as -> b)     -> (b -> Tuple as)     -> Prod (BVar s) as

@@ -0,0 +1,649 @@+{-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE EmptyCase            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE GADTs                #-}+{-# LANGUAGE LambdaCase           #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Numeric.Backprop.Class+-- Copyright   : (c) Justin Le 2018+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provides the 'Backprop' typeclass, a class for values that can be used+-- for backpropagation.+--+-- This class replaces the old (version 0.1) API relying on 'Num'.+--+-- @since 0.2.0.0++module Numeric.Backprop.Class (+  -- * Backpropagatable types+    Backprop(..)+  -- * Derived methods+  , zeroNum, addNum, oneNum+  , zeroVec, addVec, oneVec+  , zeroFunctor, addIsList, addAsList, oneFunctor+  , genericZero, genericAdd, genericOne+  -- * Generics+  , GZero(..), GAdd(..), GOne(..)+  ) where++import           Data.Complex+import           Data.Foldable hiding        (toList)+import           Data.Functor.Identity+import           Data.List.NonEmpty          (NonEmpty(..))+import           Data.Proxy+import           Data.Ratio+import           Data.Type.Combinator hiding ((:.:), Comp1)+import           Data.Type.Option+import           Data.Type.Product hiding    (toList)+import           Data.Void+import           GHC.Exts+import           GHC.Generics+import           Type.Family.List+import qualified Data.IntMap                 as IM+import qualified Data.Map                    as M+import qualified Data.Sequence               as Seq+import qualified Data.Vector                 as V+import qualified Data.Vector.Generic         as VG+import qualified Data.Vector.Primitive       as VP+import qualified Data.Vector.Storable        as VS+import qualified Data.Vector.Unboxed         as VU+import qualified Type.Family.Maybe           as M++-- | Class of values that can be backpropagated in general.+--+-- For instances of 'Num', these methods can be given by 'zeroNum',+-- 'addNum', and 'oneNum'.  There are also generic options given in+-- "Numeric.Backprop.Class" for functors, 'IsList' instances, and 'Generic'+-- instances.+--+-- @+-- instance 'Backprop' 'Double' where+--     'zero' = 'zeroNum'+--     'add' = 'addNum'+--     'one' = 'oneNum'+-- @+--+-- If you leave the body of an instance declaration blank, GHC Generics+-- will be used to derive instances if the type has a single constructor+-- and each field is an instance of 'Backprop'.+--+-- To ensure that backpropagation works in a sound way, should obey the+-- laws:+--+-- [/identity/]+--+--   * @'add' x ('zero' y) = x@+--+--   * @'add' ('zero' x) y = y@+--+-- Also implies preservation of information, making @'zipWith' ('+')@ an+-- illegal implementation for lists and vectors.+--+-- This is only expected to be true up to potential "extra zeroes" in @x@+-- and @y@ in the result.+--+-- [/commutativity/]+--+--   * @'add' x y = 'add' y x@+--+-- [/associativity/]+--+--   * @'add' x ('add' y z) = 'add' ('add' x y) z@+--+-- [/idempotence/]+--+--   * @'zero' '.' 'zero' = 'zero'@+--+--   * @'one' '.' 'one' = 'one'@+--+-- Note that not all values in the backpropagation process needs all of+-- these methods: Only the "final result" needs 'one', for example.  These+-- are all grouped under one typeclass for convenience in defining+-- instances, and also to talk about sensible laws.  For fine-grained+-- control, use the "explicit" versions of library functions (for example,+-- in "Numeric.Backprop.Explicit") instead of 'Backprop' based ones.+--+-- This typeclass replaces the reliance on 'Num' of the previous API+-- (v0.1).  'Num' is strictly more powerful than 'Backprop', and is+-- a stronger constraint on types than is necessary for proper+-- backpropagating.  In particular, 'fromInteger' is a problem for many+-- types, preventing useful backpropagation for lists, variable-length+-- vectors (like "Data.Vector") and variable-size matrices from linear+-- algebra libraries like /hmatrix/ and /accelerate/.+--+-- @since 0.2.0.0+class Backprop a where+    -- | "Zero out" all components of a value.  For scalar values, this+    -- should just be @'const' 0@.  For vectors and matrices, this should+    -- set all components to zero, the additive identity.+    --+    -- Should be idempotent:+    --+    --   * @'zero' '.' 'zero' = 'zero'@+    --+    -- Should be as /lazy/ as possible.  This behavior is observed for+    -- all instances provided by this library.+    --+    -- See 'zeroNum' for a pre-built definition for instances of 'Num' and+    -- 'zeroFunctor' for a definition for instances of 'Functor'.  If left+    -- blank, will automatically be 'genericZero', a pre-built definition+    -- for instances of 'GHC.Generic' whose fields are all themselves+    -- instances of 'Backprop'.+    zero :: a -> a+    -- | Add together two values of a type.  To combine contributions of+    -- gradients, so should be information-preserving:+    --+    --   * @'add' x ('zero' y) = x@+    --+    --   * @'add' ('zero' x) y = y@+    --+    -- Should be as /strict/ as possible.  This behavior is observed for+    -- all instances provided by this library.+    --+    -- See 'addNum' for a pre-built definition for instances of 'Num' and+    -- 'addFunctor' for a definition for instances of 'Functor'.  If left+    -- blank, will automatically be 'genericAdd', a pre-built definition+    -- for instances of 'GHC.Generic' with one constructor whose fields are+    -- all themselves instances of 'Backprop'.+    add  :: a -> a -> a+    -- | "One" all components of a value.  For scalar values, this should+    -- just be @'const' 1@.  For vectors and matrices, this should set all+    -- components to one, the multiplicative identity.+    --+    -- Should be idempotent:+    --+    --   * @'one' '.' 'one' = 'one'@+    --+    -- Should be as /lazy/ as possible.  This behavior is observed for+    -- all instances provided by this library.+    --+    -- See 'oneNum' for a pre-built definition for instances of 'Num' and+    -- 'oneFunctor' for a definition for instances of 'Functor'.  If left+    -- blank, will automatically be 'genericOne', a pre-built definition+    -- for instances of 'GHC.Generic' whose fields are all themselves+    -- instances of 'Backprop'.+    one  :: a -> a++    default zero :: (Generic a, GZero (Rep a)) => a -> a+    zero = genericZero+    {-# INLINE zero #-}+    default add :: (Generic a, GAdd (Rep a)) => a -> a -> a+    add = genericAdd+    {-# INLINE add #-}+    default one :: (Generic a, GOne (Rep a)) => a -> a+    one = genericOne+    {-# INLINE one #-}++-- | 'zero' using GHC Generics; works if all fields are instances of+-- 'Backprop'.+genericZero :: (Generic a, GZero (Rep a)) => a -> a+genericZero = to . gzero . from+{-# INLINE genericZero #-}++-- | 'add' using GHC Generics; works if all fields are instances of+-- 'Backprop', but only for values with single constructors.+genericAdd :: (Generic a, GAdd (Rep a)) => a -> a -> a+genericAdd x y = to $ gadd (from x) (from y)+{-# INLINE genericAdd #-}++-- | 'one' using GHC Generics; works if all fields are instaces of+-- 'Backprop'.+genericOne :: (Generic a, GOne (Rep a)) => a -> a+genericOne = to . gone . from+{-# INLINE genericOne #-}++-- | 'zero' for instances of 'Num'.+--+-- Is lazy in its argument.+zeroNum :: Num a => a -> a+zeroNum _ = 0+{-# INLINE zeroNum #-}++-- | 'add' for instances of 'Num'.+addNum :: Num a => a -> a -> a+addNum = (+)+{-# INLINE addNum #-}++-- | 'one' for instances of 'Num'.+--+-- Is lazy in its argument.+oneNum :: Num a => a -> a+oneNum _ = 1+{-# INLINE oneNum #-}++-- | 'zero' for instances of 'VG.Vector'.+zeroVec :: (VG.Vector v a, Backprop a) => v a -> v a+zeroVec = VG.map zero+{-# INLINE zeroVec #-}++-- | 'add' for instances of 'VG.Vector'.  Automatically pads the end of the+-- shorter vector with zeroes.+addVec :: (VG.Vector v a, Backprop a) => v a -> v a -> v a+addVec x y = case compare lX lY of+    LT -> let (y1,y2) = VG.splitAt (lY - lX) y+          in  VG.zipWith add x y1 VG.++ y2+    EQ -> VG.zipWith add x y+    GT -> let (x1,x2) = VG.splitAt (lX - lY) x+          in  VG.zipWith add x1 y VG.++ x2+  where+    lX = VG.length x+    lY = VG.length y++-- | 'one' for instances of 'VG.Vector'.+oneVec :: (VG.Vector v a, Backprop a) => v a -> v a+oneVec = VG.map one+{-# INLINE oneVec #-}++-- | 'zero' for 'Functor' instances.+zeroFunctor :: (Functor f, Backprop a) => f a -> f a+zeroFunctor = fmap zero+{-# INLINE zeroFunctor #-}++-- | 'add' for instances of 'IsList'.  Automatically pads the end of the+-- "shorter" value with zeroes.+addIsList :: (IsList a, Backprop (Item a)) => a -> a -> a+addIsList = addAsList toList fromList+{-# INLINE addIsList #-}++-- | 'add' for types that are isomorphic to a list.+-- Automatically pads the end of the "shorter" value with zeroes.+addAsList+    :: Backprop b+    => (a -> [b])       -- ^ convert to list (should form isomorphism)+    -> ([b] -> a)       -- ^ convert from list (should form isomorphism)+    -> a+    -> a+    -> a+addAsList f g x y = g $ go (f x) (f y)+  where+    go = \case+      [] -> id+      o@(x':xs) -> \case+        []    -> o+        y':ys -> add x' y' : go xs ys++-- | 'one' for instances of 'Functor'.+oneFunctor :: (Functor f, Backprop a) => f a -> f a+oneFunctor = fmap one+{-# INLINE oneFunctor #-}++++++-- | Helper class for automatically deriving 'zero' using GHC Generics.+class GZero f where+    gzero :: f t -> f t++instance Backprop a => GZero (K1 i a) where+    gzero (K1 x) = K1 (zero x)+    {-# INLINE gzero #-}++instance (GZero f, GZero g) => GZero (f :*: g) where+    gzero (x :*: y) = gzero x :*: gzero y+    {-# INLINE gzero #-}++instance (GZero f, GZero g) => GZero (f :+: g) where+    gzero (L1 x) = L1 (gzero x)+    gzero (R1 x) = R1 (gzero x)+    {-# INLINE gzero #-}++instance GZero V1 where+    gzero = \case {}+    {-# INLINE gzero #-}++instance GZero U1 where+    gzero _ = U1+    {-# INLINE gzero #-}++instance GZero f => GZero (M1 i c f) where+    gzero (M1 x) = M1 (gzero x)+    {-# INLINE gzero #-}++instance GZero f => GZero (f :.: g) where+    gzero (Comp1 x) = Comp1 (gzero x)+    {-# INLINE gzero #-}+++-- | Helper class for automatically deriving 'add' using GHC Generics.+class GAdd f where+    gadd :: f t -> f t -> f t++instance Backprop a => GAdd (K1 i a) where+    gadd (K1 x) (K1 y) = K1 (add x y)+    {-# INLINE gadd #-}++instance (GAdd f, GAdd g) => GAdd (f :*: g) where+    gadd (x1 :*: y1) (x2 :*: y2) = x3 :*: y3+      where+        !x3 = gadd x1 x2+        !y3 = gadd y1 y2+    {-# INLINE gadd #-}++instance GAdd V1 where+    gadd = \case {}+    {-# INLINE gadd #-}++instance GAdd U1 where+    gadd _ _ = U1+    {-# INLINE gadd #-}++instance GAdd f => GAdd (M1 i c f) where+    gadd (M1 x) (M1 y) = M1 (gadd x y)+    {-# INLINE gadd #-}++instance GAdd f => GAdd (f :.: g) where+    gadd (Comp1 x) (Comp1 y) = Comp1 (gadd x y)+    {-# INLINE gadd #-}+++-- | Helper class for automatically deriving 'one' using GHC Generics.+class GOne f where+    gone :: f t -> f t++instance Backprop a => GOne (K1 i a) where+    gone (K1 x) = K1 (one x)+    {-# INLINE gone #-}++instance (GOne f, GOne g) => GOne (f :*: g) where+    gone (x :*: y) = gone x :*: gone y+    {-# INLINE gone #-}++instance (GOne f, GOne g) => GOne (f :+: g) where+    gone (L1 x) = L1 (gone x)+    gone (R1 x) = R1 (gone x)+    {-# INLINE gone #-}++instance GOne V1 where+    gone = \case {}+    {-# INLINE gone #-}++instance GOne U1 where+    gone _ = U1+    {-# INLINE gone #-}++instance GOne f => GOne (M1 i c f) where+    gone (M1 x) = M1 (gone x)+    {-# INLINE gone #-}++instance GOne f => GOne (f :.: g) where+    gone (Comp1 x) = Comp1 (gone x)+    {-# INLINE gone #-}++instance Backprop Int where+    zero = zeroNum+    {-# INLINE zero #-}+    add  = addNum+    {-# INLINE add #-}+    one  = oneNum+    {-# INLINE one #-}++instance Backprop Integer where+    zero = zeroNum+    {-# INLINE zero #-}+    add  = addNum+    {-# INLINE add #-}+    one  = oneNum+    {-# INLINE one #-}++instance Integral a => Backprop (Ratio a) where+    zero = zeroNum+    {-# INLINE zero #-}+    add  = addNum+    {-# INLINE add #-}+    one  = oneNum+    {-# INLINE one #-}++instance RealFloat a => Backprop (Complex a) where+    zero = zeroNum+    {-# INLINE zero #-}+    add  = addNum+    {-# INLINE add #-}+    one  = oneNum+    {-# INLINE one #-}++instance Backprop Float where+    zero = zeroNum+    {-# INLINE zero #-}+    add  = addNum+    {-# INLINE add #-}+    one  = oneNum+    {-# INLINE one #-}++instance Backprop Double where+    zero = zeroNum+    {-# INLINE zero #-}+    add  = addNum+    {-# INLINE add #-}+    one  = oneNum+    {-# INLINE one #-}++instance Backprop a => Backprop (V.Vector a) where+    zero = zeroVec+    {-# INLINE zero #-}+    add  = addVec+    {-# INLINE add #-}+    one  = oneVec+    {-# INLINE one #-}++instance (VU.Unbox a, Backprop a) => Backprop (VU.Vector a) where+    zero = zeroVec+    {-# INLINE zero #-}+    add  = addVec+    {-# INLINE add #-}+    one  = oneVec+    {-# INLINE one #-}++instance (VS.Storable a, Backprop a) => Backprop (VS.Vector a) where+    zero = zeroVec+    {-# INLINE zero #-}+    add  = addVec+    {-# INLINE add #-}+    one  = oneVec+    {-# INLINE one #-}++instance (VP.Prim a, Backprop a) => Backprop (VP.Vector a) where+    zero = zeroVec+    {-# INLINE zero #-}+    add  = addVec+    {-# INLINE add #-}+    one  = oneVec+    {-# INLINE one #-}++-- | 'add' assumes the shorter list has trailing zeroes, and the result has+-- the length of the longest input.+instance Backprop a => Backprop [a] where+    zero = zeroFunctor+    {-# INLINE zero #-}+    add  = addIsList+    {-# INLINE add #-}+    one  = oneFunctor+    {-# INLINE one #-}++-- | 'add' assumes the shorter list has trailing zeroes, and the result has+-- the length of the longest input.+instance Backprop a => Backprop (NonEmpty a) where+    zero = zeroFunctor+    {-# INLINE zero #-}+    add  = addIsList+    {-# INLINE add #-}+    one  = oneFunctor+    {-# INLINE one #-}++-- | 'add' assumes the shorter sequence has trailing zeroes, and the result+-- has the length of the longest input.+instance Backprop a => Backprop (Seq.Seq a) where+    zero = zeroFunctor+    {-# INLINE zero #-}+    add  = addIsList+    {-# INLINE add #-}+    one  = oneFunctor+    {-# INLINE one #-}++-- | 'Nothing' is treated the same as @'Just' 0@.  However, 'zero', 'add',+-- and 'one' preserve 'Nothing' if all inputs are also 'Nothing'.+instance Backprop a => Backprop (Maybe a) where+    zero = zeroFunctor+    {-# INLINE zero #-}+    add x y = asum [ add <$> x <*> y+                   , x+                   , y+                   ]+    {-# INLINE add #-}+    one  = oneFunctor+    {-# INLINE one #-}++-- | 'add' is strict, but 'zero' and 'one' are lazy in their arguments.+instance Backprop () where+    zero _ = ()+    add () () = ()+    one _ = ()++-- | 'add' is strict+instance (Backprop a, Backprop b) => Backprop (a, b) where+    zero (x, y) = (zero x, zero y)+    {-# INLINE zero #-}+    add (x1, y1) (x2, y2) = (x3, y3)+      where+        !x3 = add x1 x2+        !y3 = add y1 y2+    {-# INLINE add #-}+    one (x, y) = (one x, one y)+    {-# INLINE one #-}++-- | 'add' is strict+instance (Backprop a, Backprop b, Backprop c) => Backprop (a, b, c) where+    zero (x, y, z) = (zero x, zero y, zero z)+    {-# INLINE zero #-}+    add (x1, y1, z1) (x2, y2, z2) = (x3, y3, z3)+      where+        !x3 = add x1 x2+        !y3 = add y1 y2+        !z3 = add z1 z2+    {-# INLINE add #-}+    one (x, y, z) = (one x, one y, one z)+    {-# INLINE one #-}++-- | 'add' is strict+instance (Backprop a, Backprop b, Backprop c, Backprop d) => Backprop (a, b, c, d) where+    zero (x, y, z, w) = (zero x, zero y, zero z, zero w)+    {-# INLINE zero #-}+    add (x1, y1, z1, w1) (x2, y2, z2, w2) = (x3, y3, z3, w3)+      where+        !x3 = add x1 x2+        !y3 = add y1 y2+        !z3 = add z1 z2+        !w3 = add w1 w2+    {-# INLINE add #-}+    one (x, y, z, w) = (one x, one y, one z, one w)+    {-# INLINE one #-}++-- | 'add' is strict+instance (Backprop a, Backprop b, Backprop c, Backprop d, Backprop e) => Backprop (a, b, c, d, e) where+    zero (x, y, z, w, v) = (zero x, zero y, zero z, zero w, zero v)+    {-# INLINE zero #-}+    add (x1, y1, z1, w1, v1) (x2, y2, z2, w2, v2) = (x3, y3, z3, w3, v3)+      where+        !x3 = add x1 x2+        !y3 = add y1 y2+        !z3 = add z1 z2+        !w3 = add w1 w2+        !v3 = add v1 v2+    {-# INLINE add #-}+    one (x, y, z, w, v) = (one x, one y, one z, one w, one v)+    {-# INLINE one #-}++instance Backprop a => Backprop (Identity a) where+    zero (Identity x) = Identity (zero x)+    {-# INLINE zero #-}+    add (Identity x) (Identity y) = Identity (add x y)+    {-# INLINE add #-}+    one (Identity x) = Identity (one x)+    {-# INLINE one #-}++instance Backprop a => Backprop (I a) where+    zero (I x) = I (zero x)+    {-# INLINE zero #-}+    add (I x) (I y) = I (add x y)+    {-# INLINE add #-}+    one (I x) = I (one x)+    {-# INLINE one #-}++-- | 'add' is strict, but 'zero' and 'one' are lazy in their arguments.+instance Backprop (Proxy a) where+    zero _ = Proxy+    {-# INLINE zero #-}+    add Proxy Proxy = Proxy+    {-# INLINE add #-}+    one _ = Proxy+    {-# INLINE one #-}++instance Backprop Void where+    zero = \case {}+    {-# INLINE zero #-}+    add = \case {}+    {-# INLINE add #-}+    one = \case {}+    {-# INLINE one #-}++-- | 'zero' and 'one' replace all current values, and 'add' merges keys+-- from both maps, adding in the case of double-occurrences.+instance (Backprop a, Ord k) => Backprop (M.Map k a) where+    zero = zeroFunctor+    {-# INLINE zero #-}+    add  = M.unionWith add+    {-# INLINE add #-}+    one  = oneFunctor+    {-# INLINE one #-}++-- | 'zero' and 'one' replace all current values, and 'add' merges keys+-- from both maps, adding in the case of double-occurrences.+instance (Backprop a) => Backprop (IM.IntMap a) where+    zero = zeroFunctor+    {-# INLINE zero #-}+    add  = IM.unionWith add+    {-# INLINE add #-}+    one  = oneFunctor+    {-# INLINE one #-}++instance ListC (Backprop <$> (f <$> as)) => Backprop (Prod f as) where+    zero = \case+      Ø -> Ø+      x :< xs -> zero x :< zero xs+    {-# INLINE zero #-}+    add = \case+      Ø -> \case+        Ø -> Ø+      x :< xs -> \case+        y :< ys -> add x y :< add xs ys+    {-# INLINE add #-}+    one = \case+      Ø       -> Ø+      x :< xs -> one x :< one xs+    {-# INLINE one #-}++instance M.MaybeC (Backprop M.<$> (f M.<$> a)) => Backprop (Option f a) where+    zero = \case+      Nothing_ -> Nothing_+      Just_ x  -> Just_ (zero x)+    {-# INLINE zero #-}+    add = \case+      Nothing_ -> \case+        Nothing_ -> Nothing_+      Just_ x -> \case+        Just_ y -> Just_ (add x y)+    {-# INLINE add #-}+    one = \case+      Nothing_ -> Nothing_+      Just_ x  -> Just_ (one x)+    {-# INLINE one #-}+

@@ -0,0 +1,321 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs            #-}+{-# LANGUAGE PatternSynonyms  #-}+{-# LANGUAGE RankNTypes       #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      : Numeric.Backprop.Explicit+-- Copyright   : (c) Justin Le 2018+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provides "explicit" versions of all of the functions in+-- "Numeric.Backprop".  Instead of relying on a 'Backprop' instance, allows+-- you to manually provide 'zero', 'add', and 'one' on a per-value basis.+--+-- It is recommended you use 'Numeric.Backprop' or 'Numeric.Backprop.Num'+-- instead, unless your type has no 'Num' instance, or you else you want to+-- avoid defining orphan 'Backprop' instances for external types.  Can also+-- be useful if mixing and matching styles.+--+-- See "Numeric.Backprop" for fuller documentation on using these+-- functions.+--+-- @since 0.2.0.0++module Numeric.Backprop.Explicit (+    -- * Types+    BVar, W, Backprop(..)+    -- * Explicit 'zero', 'add', and 'one'+  , ZeroFunc(..), zfNum, zfNums, zeroFunc, zeroFuncs+  , AddFunc(..), afNum, afNums, addFunc, addFuncs+  , OneFunc(..), ofNum, ofNums, oneFunc, oneFuncs+    -- * Running+  , backprop, evalBP, gradBP, backpropWith+    -- ** Multiple inputs+  , backprop2, evalBP2, gradBP2, backpropWith2+  , backpropN, evalBPN, gradBPN, backpropWithN, Every+    -- * Manipulating 'BVar'+  , constVar, auto, coerceVar+  -- , (^^.), (.~~), (^^?), (^^..)+  , viewVar, setVar+  , sequenceVar, collectVar+  , previewVar, toListOfVar+    -- ** With Isomorphisms+  , isoVar, isoVar2, isoVar3, isoVarN+    -- ** With 'Op's+  , liftOp+  , liftOp1, liftOp2, liftOp3+    -- * 'Op'+  , Op(..)+    -- ** Creation+  , op0, opConst, idOp+  , opConst'+    -- *** Giving gradients directly+  , op1, op2, op3+    -- *** From Isomorphisms+  , opCoerce, opTup, opIso, opIsoN, opLens+    -- *** No gradients+  , noGrad1, noGrad+    -- * Utility+    -- ** Inductive tuples/heterogeneous lists+  , Prod(..), pattern (:>), only, head'+  , Tuple, pattern (::<), only_+  , I(..)+    -- ** Misc+  , Reifies+  ) where++import           Data.Bifunctor+import           Data.Reflection+import           Data.Type.Index+import           Data.Type.Length+import           Data.Type.Product+import           Numeric.Backprop.Class+import           Numeric.Backprop.Internal+import           Numeric.Backprop.Op+import           Type.Class.Higher+import           Type.Class.Known+import           Type.Class.Witness++-- | 'ZeroFunc's for every item in a type level list based on their+-- 'Num' instances+--+-- @since 0.2.0.0+zfNums :: (Every Num as, Known Length as) => Prod ZeroFunc as+zfNums = map1 (\i -> zfNum \\ every @_ @Num i) indices++-- | 'ZeroFunc's for every item in a type level list based on their+-- 'Num' instances+--+-- @since 0.2.0.0+afNums :: (Every Num as, Known Length as) => Prod AddFunc as+afNums = map1 (\i -> afNum \\ every @_ @Num i) indices++-- | 'ZeroFunc's for every item in a type level list based on their+-- 'Num' instances+--+-- @since 0.2.0.0+ofNums :: (Every Num as, Known Length as) => Prod OneFunc as+ofNums = map1 (\i -> ofNum \\ every @_ @Num i) indices++-- | The canonical 'ZeroFunc' for instances of 'Backprop'.+--+-- @since 0.2.0.0+zeroFunc :: Backprop a => ZeroFunc a+zeroFunc = ZF zero+{-# INLINE zeroFunc #-}++-- | The canonical 'AddFunc' for instances of 'Backprop'.+--+-- @since 0.2.0.0+addFunc :: Backprop a => AddFunc a+addFunc = AF add+{-# INLINE addFunc #-}++-- | The canonical 'OneFunc' for instances of 'Backprop'.+--+-- @since 0.2.0.0+oneFunc :: Backprop a => OneFunc a+oneFunc = OF one+{-# INLINE oneFunc #-}++-- | Generate an 'ZeroFunc' for every type in a type-level list, if every+-- type has an instance of 'Backprop'.+--+-- @since 0.2.0.0+zeroFuncs :: (Every Backprop as, Known Length as) => Prod ZeroFunc as+zeroFuncs = map1 (\i -> zeroFunc \\ every @_ @Backprop i) indices++-- | Generate an 'AddFunc' for every type in a type-level list, if every+-- type has an instance of 'Backprop'.+--+-- @since 0.2.0.0+addFuncs :: (Every Backprop as, Known Length as) => Prod AddFunc as+addFuncs = map1 (\i -> addFunc \\ every @_ @Backprop i) indices++-- | Generate an 'OneFunc' for every type in a type-level list, if every+-- type has an instance of 'Backprop'.+--+-- @since 0.2.0.0+oneFuncs :: (Every Backprop as, Known Length as) => Prod OneFunc as+oneFuncs = map1 (\i -> oneFunc \\ every @_ @Backprop i) indices++-- | Shorter alias for 'constVar', inspired by the /ad/ library.+--+-- @since 0.2.0.0+auto :: a -> BVar s a+auto = constVar+{-# INLINE auto #-}++-- | 'Numeric.Backprop.backpropWithN', but with explicit 'zero'.+backpropWithN+    :: Prod ZeroFunc as+    -> (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> (b -> b)                 -- ^ Gradient of final result with respect to output of function+    -> (b, Tuple as)+backpropWithN zfs f xs g = backpropN zfs (OF g) f xs+{-# INLINE backpropWithN #-}++-- | 'Numeric.Backprop.backprop', but with explicit 'zero' and 'one'.+backprop+    :: ZeroFunc a+    -> OneFunc b+    -> (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> (b, a)+backprop zfa ofb f = second (getI . head')+                   . backpropN (zfa :< Ø) ofb (f . head')+                   . only_+{-# INLINE backprop #-}++-- | 'Numeric.Backprop.backpropWith', but with explicit 'zero'.+backpropWith+    :: ZeroFunc a+    -> (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> (b -> b)                 -- ^ Gradient of final result with respect to output of function+    -> (b, a)+backpropWith zfa f x g = backprop zfa (OF g) f x+{-# INLINE backpropWith #-}++-- | Turn a function @'BVar' s a -> 'BVar' s b@ into the function @a -> b@+-- that it represents.+--+-- Benchmarks show that this should have virtually no overhead over+-- directly writing a @a -> b@. 'BVar' is, in this situation, a zero-cost+-- abstraction, performance-wise.+--+-- See documentation of 'Numeric.Backprop.backprop' for more information.+evalBP :: (forall s. Reifies s W => BVar s a -> BVar s b) -> a -> b+evalBP f = evalBPN (f . head') . only_+{-# INLINE evalBP #-}++-- | 'Numeric.Backprop.gradBP', but with explicit 'zero' and 'one'.+gradBP+    :: ZeroFunc a+    -> OneFunc b+    -> (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> a+gradBP zfa ofb f = snd . backprop zfa ofb f+{-# INLINE gradBP #-}++-- | 'Numeric.Backprop.gradBP', Nbut with explicit 'zero' and 'one'.+gradBPN+    :: Prod ZeroFunc as+    -> OneFunc b+    -> (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> Tuple as+gradBPN zfas ofb f = snd . backpropN zfas ofb f+{-# INLINE gradBPN #-}++-- | 'Numeric.Backprop.backprop2', but with explicit 'zero' and 'one'.+backprop2+    :: ZeroFunc a+    -> ZeroFunc b+    -> OneFunc c+    -> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> (c, (a, b))+backprop2 zfa zfb ofc f x y = second (\(dx ::< dy ::< Ø) -> (dx, dy)) $+    backpropN (zfa :< zfb :< Ø) ofc+        (\(x' :< y' :< Ø) -> f x' y')+        (x ::< y ::< Ø)+{-# INLINE backprop2 #-}++-- | 'Numeric.Backprop.backpropWith2', but with explicit 'zero'.+backpropWith2+    :: ZeroFunc a+    -> ZeroFunc b+    -> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> (c -> c)                 -- ^ Gradient of final result with respect to output of function+    -> (c, (a, b))+backpropWith2 zfa zfb f x y g = backprop2 zfa zfb (OF g) f x y+{-# INLINE backpropWith2 #-}++-- | 'evalBP' for a two-argument function.  See+-- 'Numeric.Backprop.backprop2' for notes.+evalBP2+    :: (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> c+evalBP2 f x y = evalBPN (\(x' :< y' :< Ø) -> f x' y') (x ::< y ::< Ø)+{-# INLINE evalBP2 #-}++-- | 'gradBP' for a two-argument function.  See+-- 'Numeric.Backprop.backprop2' for notes.+gradBP2+    :: ZeroFunc a+    -> ZeroFunc b+    -> OneFunc c+    -> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> (a, b)+gradBP2 zfa zfb ofc f x = snd . backprop2 zfa zfb ofc f x+{-# INLINE gradBP2 #-}++-- | 'Numeric.Backprop.isoVar' with explicit 'add' and 'zero'.+isoVar+    :: Reifies s W+    => AddFunc a+    -> ZeroFunc b+    -> (a -> b)+    -> (b -> a)+    -> BVar s a+    -> BVar s b+isoVar af z f g = liftOp1 af z (opIso f g)+{-# INLINE isoVar #-}++-- | 'Numeric.Backprop.isoVar2' with explicit 'add' and 'zero'.+isoVar2+    :: Reifies s W+    => AddFunc a+    -> AddFunc b+    -> ZeroFunc c+    -> (a -> b -> c)+    -> (c -> (a, b))+    -> BVar s a+    -> BVar s b+    -> BVar s c+isoVar2 afa afb z f g = liftOp2 afa afb z (opIso2 f g)+{-# INLINE isoVar2 #-}++-- | 'Numeric.Backprop.isoVar3' with explicit 'add' and 'zero'.+isoVar3+    :: Reifies s W+    => AddFunc a+    -> AddFunc b+    -> AddFunc c+    -> ZeroFunc d+    -> (a -> b -> c -> d)+    -> (d -> (a, b, c))+    -> BVar s a+    -> BVar s b+    -> BVar s c+    -> BVar s d+isoVar3 afa afb afc z f g = liftOp3 afa afb afc z (opIso3 f g)+{-# INLINE isoVar3 #-}++-- | 'Numeric.Backprop.isoVarN' with explicit 'add' and 'zero'.+isoVarN+    :: Reifies s W+    => Prod AddFunc as+    -> ZeroFunc b+    -> (Tuple as -> b)+    -> (b -> Tuple as)+    -> Prod (BVar s) as+    -> BVar s b+isoVarN afs z f g = liftOp afs z (opIsoN f g)+{-# INLINE isoVarN #-}

@@ -10,6 +10,7 @@ {-# LANGUAGE TupleSections       #-} {-# LANGUAGE TypeApplications    #-} {-# LANGUAGE TypeInType          #-}+{-# LANGUAGE TypeOperators       #-} {-# LANGUAGE ViewPatterns        #-}  -- |@@ -32,6 +33,10 @@   , liftOp, liftOp1, liftOp2, liftOp3   , viewVar, setVar, sequenceVar, collectVar, previewVar, toListOfVar   , coerceVar+  -- * Func wrappers+  , ZeroFunc(..), zfNum+  , AddFunc(..), afNum+  , OneFunc(..), ofNum   -- * Debug   , debugSTN   , debugIR@@ -53,7 +58,7 @@ import           Data.Monoid hiding        (Any(..)) import           Data.Proxy import           Data.Reflection-import           Data.Type.Index+import           Data.Type.Conjunction import           Data.Type.Product hiding  (toList) import           Data.Type.Util import           Data.Type.Vector hiding   (itraverse)@@ -64,11 +69,70 @@ import           Numeric.Backprop.Op import           System.IO.Unsafe import           Type.Class.Higher-import           Type.Class.Witness import           Unsafe.Coerce import qualified Data.Vector               as V import qualified Data.Vector.Mutable       as MV +-- | "Zero out" all components of a value.  For scalar values, this should+-- just be @'const' 0@.  For vectors and matrices, this should set all+-- components to zero, the additive identity.+--+-- Should be idempotent: Applying the function twice is the same as+-- applying it just once.+--+-- Each type should ideally only have one 'ZeroFunc'.  This coherence+-- constraint is given by the typeclass 'Backprop'.+--+-- @since 0.2.0.0+newtype ZeroFunc a = ZF { runZF :: a -> a }++-- | Add together two values of a type.  To combine contributions of+-- gradients, so should ideally be information-preserving.+--+-- See laws for 'Backprop' for the laws this should be expected to+-- preserve.  Namely, it should be commutative and associative, with an+-- identity for a valid 'ZeroFunc'.+--+-- Each type should ideally only have one 'AddFunc'.  This coherence+-- constraint is given by the typeclass 'Backprop'.+--+-- @since 0.2.0.0+newtype AddFunc  a = AF { runAF :: a -> a -> a }++-- | "One" all components of a value.  For scalar values, this should+-- just be @'const' 1@.  For vectors and matrices, this should set all+-- components to one, the multiplicative identity.+--+-- Should be idempotent: Applying the function twice is the same as+-- applying it just once.+--+-- Each type should ideally only have one 'OneFunc'.  This coherence+-- constraint is given by the typeclass 'Backprop'.+--+-- @since 0.2.0.0+newtype OneFunc  a = OF { runOF :: a -> a }++-- | If a type has a 'Num' instance, this is the canonical 'ZeroFunc'.+--+-- @since 0.2.0.0+zfNum :: Num a => ZeroFunc a+zfNum = ZF (const 0)+{-# INLINE zfNum #-}++-- | If a type has a 'Num' instance, this is the canonical 'AddFunc'.+--+-- @since 0.2.0.0+afNum :: Num a => AddFunc a+afNum = AF (+)+{-# INLINE afNum #-}++-- | If a type has a 'Num' instance, this is the canonical 'OneFunc'.+--+-- @since 0.2.0.0+ofNum :: Num a => OneFunc a+ofNum = OF (const 1)+{-# INLINE ofNum #-}+ -- | A @'BVar' s a@ is a value of type @a@ that can be "backpropagated". -- -- Functions referring to 'BVar's are tracked by the library and can be@@ -138,13 +202,12 @@  data InpRef :: Type -> Type where     IR :: { _irIx  :: !(BVar s b)-          , _irUpd :: !(Lens' b a)-          , _irAdd :: !(a -> a -> a)+          , _irAdd :: !(a -> b -> b)           }        -> InpRef a  forceInpRef :: InpRef a -> ()-forceInpRef (IR v !_ !_) = forceBVar v `seq` ()+forceInpRef (IR v !_) = forceBVar v `seq` () {-# INLINE forceInpRef #-}  -- | Debugging string for an 'InpRef'.@@ -183,14 +246,14 @@ {-# INLINE initWengert #-}  insertNode-    :: Num a-    => TapeNode a-    -> a+    :: TapeNode a+    -> a                    -- ^ val+    -> ZeroFunc a     -> W     -> IO (BVar s a)-insertNode tn !x !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) ->+insertNode tn !x zf !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) ->     let n' = n + 1-        t' = STN 0 tn:t+        t' = STN (runZF zf x) tn : t     in  forceTapeNode tn `seq` n' `seq` t' `seq` ((n', t'), n) {-# INLINE insertNode #-} @@ -203,286 +266,283 @@ {-# INLINE constVar #-}  liftOp_-    :: forall s as b. (Reifies s W, Num b, Every Num as)-    => Op as b+    :: forall s as b. Reifies s W+    => Prod AddFunc as+    -> ZeroFunc b+    -> Op as b     -> Prod (BVar s) as     -> IO (BVar s b)-liftOp_ o !vs = case traverse1 (fmap I . bvConst) vs of-                   Just xs -> return $ constVar (evalOp o xs)-                   Nothing -> insertNode tn y (reflect (Proxy @s))+liftOp_ afs z o !vs = case traverse1 (fmap I . bvConst) vs of+    Just xs -> return $ constVar (evalOp o xs)+    Nothing -> insertNode tn y z (reflect (Proxy @s))   where     (y,g) = runOpWith o (map1 (I . _bvVal) vs)-    tn = TN { _tnInputs = imap1 go vs+    tn = TN { _tnInputs = map1 go (zipP afs vs)             , _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 :: forall a. (AddFunc :&: BVar s) a -> InpRef a+    go (af :&: (!v)) = forceBVar v `seq` IR v (runAF af)     {-# INLINE go #-} {-# INLINE liftOp_ #-} --- | Lift an 'Op' with an arbitrary number of inputs to a function on the--- appropriate number of 'BVar's.------ Should preferably be used only by libraries to provide primitive 'BVar'--- functions for their types for users.------ See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more--- information, and "Numeric.Backprop.Op#prod" for a mini-tutorial on using--- 'Prod' and 'Tuple'.+-- | 'Numeric.Backprop.liftOp', but with explicit 'add' and 'zero'. liftOp-    :: forall as b s. (Reifies s W, Num b, Every Num as)-    => Op as b+    :: forall as b s. Reifies s W+    => Prod AddFunc as+    -> ZeroFunc b+    -> Op as b     -> Prod (BVar s) as     -> BVar s b-liftOp o !vs = unsafePerformIO $ liftOp_ o vs+liftOp afs z o !vs = unsafePerformIO $ liftOp_ afs z o vs {-# INLINE liftOp #-}  liftOp1_-    :: forall a b s. (Reifies s W, Num a, Num b)-    => Op '[a] b+    :: forall a b s. Reifies s W+    => AddFunc a+    -> ZeroFunc b+    -> Op '[a] b     -> 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 (bvConst->Just x) = return . constVar . evalOp o $ (x ::< Ø)+liftOp1_ af z o v = forceBVar v `seq` insertNode tn y z (reflect (Proxy @s))   where     (y,g) = runOpWith o (_bvVal v ::< Ø)-    tn = TN { _tnInputs = IR v id (+) :< Ø+    tn = TN { _tnInputs = IR v (runAF af) :< Ø             , _tnGrad   = g             } {-# INLINE liftOp1_ #-} --- | Lift an 'Op' with a single input to be a function on a single 'BVar'.------ Should preferably be used only by libraries to provide primitive 'BVar'--- functions for their types for users.------ See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more--- information.+-- | 'Numeric.Backprop.liftOp1', but with explicit 'add' and 'zero'. liftOp1-    :: forall a b s. (Reifies s W, Num a, Num b)-    => Op '[a] b+    :: forall a b s. Reifies s W+    => AddFunc a+    -> ZeroFunc b+    -> Op '[a] b     -> BVar s a     -> BVar s b-liftOp1 o !v = unsafePerformIO $ liftOp1_ o v+liftOp1 af z o !v = unsafePerformIO $ liftOp1_ af z o v {-# INLINE liftOp1 #-}  liftOp2_-    :: forall a b c s. (Reifies s W, Num a, Num b, Num c)-    => Op '[a,b] c+    :: forall a b c s. Reifies s W+    => AddFunc a+    -> AddFunc b+    -> ZeroFunc c+    -> Op '[a,b] c     -> BVar s a     -> 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 (bvConst->Just x) (bvConst->Just y)+    = return . constVar . evalOp o $ x ::< y ::< Ø+liftOp2_ afa afb z o v u = forceBVar v+                     `seq` forceBVar u+                     `seq` insertNode tn y z (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 (runAF afa) :< IR u (runAF afb) :< Ø             , _tnGrad   = g             } {-# INLINE liftOp2_ #-} --- | Lift an 'Op' with two inputs to be a function on a two 'BVar's.------ Should preferably be used only by libraries to provide primitive 'BVar'--- functions for their types for users.------ See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more--- information.+-- | 'Numeric.Backprop.liftOp2', but with explicit 'add' and 'zero'. liftOp2-    :: forall a b c s. (Reifies s W, Num a, Num b, Num c)-    => Op '[a,b] c+    :: forall a b c s. Reifies s W+    => AddFunc a+    -> AddFunc b+    -> ZeroFunc c+    -> Op '[a,b] c     -> BVar s a     -> BVar s b     -> BVar s c-liftOp2 o !v !u = unsafePerformIO $ liftOp2_ o v u+liftOp2 afa afb z o !v !u = unsafePerformIO $ liftOp2_ afa afb z o v u {-# INLINE liftOp2 #-}  liftOp3_-    :: forall a b c d s. (Reifies s W, Num a, Num b, Num c, Num d)-    => Op '[a,b,c] d+    :: forall a b c d s. Reifies s W+    => AddFunc a+    -> AddFunc b+    -> AddFunc c+    -> ZeroFunc d+    -> Op '[a,b,c] d     -> BVar s a     -> BVar s b     -> BVar s c     -> IO (BVar s d)-liftOp3_ o (bvConst->Just x) (bvConst->Just y) (bvConst->Just z)+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_ afa afb afc z o v u w = forceBVar v+                           `seq` forceBVar u+                           `seq` forceBVar w+                           `seq` insertNode tn y z (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 (runAF afa)+                       :< IR u (runAF afb)+                       :< IR w (runAF afc)+                       :< Ø             , _tnGrad   = g             } {-# INLINE liftOp3_ #-} --- | Lift an 'Op' with three inputs to be a function on a three 'BVar's.------ Should preferably be used only by libraries to provide primitive 'BVar'--- functions for their types for users.------ See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more--- information.+-- | 'Numeric.Backprop.liftOp3', but with explicit 'add' and 'zero'. liftOp3-    :: forall a b c d s. (Reifies s W, Num a, Num b, Num c, Num d)-    => Op '[a,b,c] d+    :: forall a b c d s. Reifies s W+    => AddFunc a+    -> AddFunc b+    -> AddFunc c+    -> ZeroFunc d+    -> Op '[a,b,c] d     -> BVar s a     -> BVar s b     -> BVar s c     -> BVar s d-liftOp3 o !v !u !w = unsafePerformIO $ liftOp3_ o v u w+liftOp3 afa afb afc z o !v !u !w = unsafePerformIO $ liftOp3_ afa afb afc z o v u w {-# INLINE liftOp3 #-} +-- TODO: can we get the zero and scale func from the bvar? viewVar_-    :: forall a b s. (Reifies s W, Num a)-    => Lens' b a+    :: forall a b s. Reifies s W+    => AddFunc a+    -> ZeroFunc a+    -> Lens' b a     -> BVar s b     -> IO (BVar s a)-viewVar_ l v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s))+viewVar_ af z l v = forceBVar v `seq` insertNode tn y z (reflect (Proxy @s))   where     y = _bvVal v ^. l-    tn = TN { _tnInputs = IR v l (+) :< Ø+    tn = TN { _tnInputs = IR v (over l . runAF af) :< Ø             , _tnGrad   = only_             } {-# INLINE viewVar_ #-} --- | Using a 'Lens'', extract a value /inside/ a 'BVar'.  Meant to evoke--- parallels to 'view' from lens.------ See documentation for '^^.' for more information.+-- | 'Numeric.Backprop.viewVar', but with explicit 'add' and 'zero'. viewVar-    :: forall a b s. (Reifies s W, Num a)-    => Lens' b a+    :: forall a b s. Reifies s W+    => AddFunc a+    -> ZeroFunc a+    -> Lens' b a     -> BVar s b     -> BVar s a-viewVar l !v = unsafePerformIO $ viewVar_ l v+viewVar af z l !v = unsafePerformIO $ viewVar_ af z l v {-# INLINE viewVar #-} +-- TODO: can zero and scale func be gotten from the input bvars? setVar_-    :: forall a b s. (Reifies s W, Num a, Num b)-    => Lens' b a+    :: forall a b s. Reifies s W+    => AddFunc a+    -> AddFunc b+    -> ZeroFunc a+    -> ZeroFunc b+    -> Lens' b a     -> 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_ afa afb za zb l w v = forceBVar v+                        `seq` forceBVar w+                        `seq` insertNode tn y zb (reflect (Proxy @s))   where     y = _bvVal v & l .~ _bvVal w-    tn = TN { _tnInputs = IR w id (+) :< IR v id (+) :< Ø-            , _tnGrad   = \d -> let (dw,dv) = l (,0) d+    tn = TN { _tnInputs = IR w (runAF afa) :< IR v (runAF afb) :< Ø+            , _tnGrad   = \d -> let (dw,dv) = l (\x -> (x, runZF za x)) d                                 in  dw ::< dv ::< Ø             } {-# INLINE setVar_ #-} --- | Using a 'Lens'', set a value /inside/ a 'BVar'.  Meant to evoke--- parallels to "set" from lens.------ See documentation for '.~~' for more information.+-- | 'Numeric.Backprop.setVar', but with explicit 'add' and 'zero'. setVar-    :: forall a b s. (Reifies s W, Num a, Num b)-    => Lens' b a+    :: forall a b s. Reifies s W+    => AddFunc a+    -> AddFunc b+    -> ZeroFunc a+    -> ZeroFunc b+    -> Lens' b a     -> BVar s a     -> BVar s b     -> BVar s b-setVar l !w !v = unsafePerformIO $ setVar_ l w v+setVar afa afb za zb l !w !v = unsafePerformIO $ setVar_ afa afb za zb l w v {-# INLINE setVar #-} --- | Extract all of the 'BVar's out of a 'Traversable' container of--- 'BVar's.------ Note that this associates gradients in order of occurrence in the--- original data structure; the second item in the gradient is assumed to--- correspond with the second item in the input, etc.; this can cause--- unexpected behavior in 'Foldable' instances that don't have a fixed--- number of items.+-- | 'Numeric.Backprop.sequenceVar', but with explicit 'add' and 'zero'. sequenceVar-    :: forall t a s. (Reifies s W, Traversable t, Num a)-    => BVar s (t a)+    :: forall t a s. (Reifies s W, Traversable t)+    => AddFunc a+    -> ZeroFunc a+    -> BVar s (t a)     -> t (BVar s a)-sequenceVar !v = unsafePerformIO $ traverseVar' id traverse v+sequenceVar af z !v = unsafePerformIO $ traverseVar' af z id traverse v {-# INLINE sequenceVar #-} +-- TODO: can scale funcs and zeros be had from bvars and Functor instance? collectVar_-    :: forall t a s. (Reifies s W, Foldable t, Functor t, Num (t a), Num a)-    => t (BVar s a)+    :: forall t a s. (Reifies s W, Foldable t, Functor t)+    => AddFunc a+    -> ZeroFunc a+    -> ZeroFunc (t a)+    -> t (BVar s a)     -> IO (BVar s (t a))-collectVar_ !vs = withV (toList vs) $ \(vVec :: Vec n (BVar s a)) -> do+collectVar_ af z z' !vs = withV (toList vs) $ \(vVec :: Vec n (BVar s a)) -> do     let tn :: TapeNode (t a)-        tn = TN { _tnInputs = vecToProd (vmap ((\v -> IR v id (+)) . getI) vVec)-                , _tnGrad   = vecToProd-                            . listToVecDef 0 (vecLen vVec)-                            . map I . toList-                }+        tn = TN+          { _tnInputs = vecToProd (vmap ((`IR` runAF af) . getI) vVec)+          , _tnGrad   = vecToProd+                      . zipVecList (\(I v) -> I . fromMaybe (runZF z (_bvVal v))) vVec+                      . toList+          }     traverse_ (evaluate . forceBVar) vs-    insertNode tn (_bvVal <$> vs) (reflect (Proxy @s))+    insertNode tn (_bvVal <$> vs) z' (reflect (Proxy @s)) {-# INLINE collectVar_ #-} --- | Collect all of the 'BVar's in a container into a 'BVar' of that--- container's contents.------ Note that this associates gradients in order of occurrence in the--- original data structure; the second item in the total derivative and--- gradient is assumed to correspond with the second item in the input,--- etc.; this can cause unexpected behavior in 'Foldable' instances that--- don't have a fixed number of items.------ 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!+-- | 'Numeric.Backprop.collectVar', but with explicit 'add' and 'zero'. collectVar-    :: forall t a s. (Reifies s W, Foldable t, Functor t, Num (t a), Num a)-    => t (BVar s a)+    :: forall t a s. (Reifies s W, Foldable t, Functor t)+    => AddFunc a+    -> ZeroFunc a+    -> ZeroFunc (t a)+    -> t (BVar s a)     -> BVar s (t a)-collectVar !vs = unsafePerformIO $ collectVar_ vs+collectVar af z z' !vs = unsafePerformIO $ collectVar_ af z z' vs {-# INLINE collectVar #-}  traverseVar'-    :: forall b a f s. (Num a, Reifies s W, Traversable f)-    => (b -> f a)+    :: forall b a f s. (Reifies s W, Traversable f)+    => AddFunc a+    -> ZeroFunc a+    -> (b -> f a)     -> Traversal' b a     -> BVar s b     -> IO (f (BVar s a))-traverseVar' f t v = forceBVar v-               `seq` itraverse go (f (_bvVal v))+traverseVar' af z 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))+    go i y = insertNode tn y z (reflect (Proxy @s))       where-        tn = TN { _tnInputs = IR v (ixt t i) (+) :< Ø+        tn = TN { _tnInputs = IR v (over (ixt t i) . runAF af) :< Ø                 , _tnGrad   = only_                 }     {-# INLINE go #-} {-# INLINE traverseVar' #-} --- | Using a 'Traversal'', extract a single value /inside/ a 'BVar', if it--- exists.  If more than one traversal target exists, returns te first.--- Meant to evoke parallels to 'preview' from lens.  Really only intended--- to be used wth 'Prism''s, or up-to-one target traversals.------ See documentation for '^^?' for more information.+-- | 'Numeric.Backprop.previewVar', but with explicit 'add' and 'zero'. previewVar-    :: forall b a s. (Num a, Reifies s W)-    => Traversal' b a+    :: forall b a s. Reifies s W+    => AddFunc a+    -> ZeroFunc a+    -> Traversal' b a     -> BVar s b     -> Maybe (BVar s a)-previewVar t !v = unsafePerformIO $ traverseVar' (listToMaybe . toListOf t) t v+previewVar af z t !v = unsafePerformIO $ traverseVar' af z (listToMaybe . toListOf t) t v {-# INLINE previewVar #-} --- | Using a 'Traversal'', extract all targeted values /inside/ a 'BVar'.--- Meant to evoke parallels to 'toListOf' from lens.------ See documentation for '^^..' for more information.+-- | 'Numeric.Backprop.toListOfVar', but with explicit 'add' and 'zero'. toListOfVar-    :: forall b a s. (Num a, Reifies s W)-    => Traversal' b a+    :: forall b a s. Reifies s W+    => AddFunc a+    -> ZeroFunc a+    -> Traversal' b a     -> BVar s b     -> [BVar s a]-toListOfVar t !v = unsafePerformIO $ traverseVar' (toListOf t) t v+toListOfVar af z t !v = unsafePerformIO $ traverseVar' af z (toListOf t) t v {-# INLINE toListOfVar #-}  -- | Coerce a 'BVar' contents.  Useful for things like newtype wrappers.@@ -501,27 +561,27 @@ initRunner     :: (PrimMonad m, PrimState m ~ s)     => (Int, [SomeTapeNode])-    -> (Int, [Some (Wit1 Num)])+    -> (Int, [Any])     -> m (Runner s) initRunner (n, stns) (nx,xs) = do     delts <- MV.new n     for_ (zip [n-1,n-2..] stns) $ \(i, STN z (TN{..} :: TapeNode c)) ->       MV.write delts i $ unsafeCoerce z     inps <- MV.new nx-    for_ (zip [0..] xs) $ \(i, Some (Wit1 :: Wit1 Num c)) ->-      MV.write inps i $ unsafeCoerce @c 0+    for_ (zip [0..] xs) . uncurry $ \i z ->+      MV.write inps i z     return $ R delts inps {-# INLINE initRunner #-}  gradRunner-    :: forall m b s p. (PrimMonad m, PrimState m ~ s, Num b)-    => p b+    :: forall m b s. (PrimMonad m, PrimState m ~ s)+    => b                        -- ^ one     -> Runner s     -> (Int, [SomeTapeNode])     -> m ()-gradRunner _ R{..} (n,stns) = do+gradRunner o R{..} (n,stns) = do     when (n > 0) $-      MV.write _rDelta (n - 1) (unsafeCoerce @b 1)+      MV.write _rDelta (n - 1) (unsafeCoerce o)     zipWithM_ go [n-1,n-2..] stns   where     go :: Int -> SomeTapeNode -> m ()@@ -531,65 +591,43 @@       zipWithPM_ propagate _tnInputs gs     {-# INLINE go #-}     propagate :: forall x. InpRef x -> I x -> m ()-    propagate (IR v ln (+*)) (I d) = case _bvRef v of+    propagate (IR v (+*)) (I d) = case _bvRef v of       BRInp i -> flip (MV.modify _rInputs) i $-        unsafeCoerce . (ln %~ (+* d)) . unsafeCoerce+        unsafeCoerce . (d +*) . unsafeCoerce       BRIx i -> flip (MV.modify _rDelta) i $-        unsafeCoerce . (ln %~ (+* d)) . unsafeCoerce+        unsafeCoerce . (d +*) . unsafeCoerce       BRC     -> return ()     {-# INLINE propagate #-} {-# INLINE gradRunner #-} --- | 'backprop' generalized to multiple inputs of different types.  See the--- "Numeric.Backprop.Op#prod" for a mini-tutorial on heterogeneous lists.------ 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 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--- 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--- can be pattern matched on using ':<' (cons) and 'Ø' (nil).------ Tuples can be built and pattern matched on using '::<' (cons) and 'Ø'--- (nil), as well.------ The @'Every' 'Num' as@ in the constraint says that every value in the--- type-level list @as@ must have a 'Num' instance.  This means you can--- use, say, @'[Double, Float, Int]@, but not @'[Double, Bool, String]@.------ If you stick to /concerete/, monomorphic usage of this (with specific--- types, typed into source code, known at compile-time), then @'Every'--- 'Num' as@ should be fulfilled automatically.---+-- | 'Numeric.Backprop.backpropN', but with explicit 'zero' and 'one'. backpropN-    :: forall as b. (Every Num as, Num b)-    => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    :: forall as b. ()+    => Prod ZeroFunc as+    -> OneFunc b+    -> (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)     -> Tuple as     -> (b, Tuple as)-backpropN f !xs = (y, g)+backpropN zfs ofb f !xs = (y, g)   where     !(!tp@(!_,!_),!y) = unsafePerformIO $ fillWengert f xs     g :: Tuple as     g = runST $ do-        r <- initRunner tp (getSum `first` ifoldMap1 go xs)-        gradRunner (Proxy @b) r tp+        r <- initRunner tp $ bimap getSum (`appEndo` [])+                           . fst+                           $ zipWithPM_ go zfs xs+        gradRunner (runOF ofb y) r tp         delts <- toList <$> V.freeze (_rInputs r)         return . fromMaybe (error "backpropN") $           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+        go :: forall a. ZeroFunc a -> I a -> ((Sum Int, Endo [Any]),())+        go zf (I x) = ((1, Endo (unsafeCoerce (runZF zf x) :)), ())         {-# INLINE go #-} {-# INLINE backpropN #-}  -- | 'evalBP' generalized to multiple inputs of different types.  See--- documentation for 'backpropN' for more details.+-- documentation for 'Numeric.Backprop.backpropN' for more details. evalBPN     :: forall as b. ()     => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)@@ -623,25 +661,25 @@   instance (Num a, Reifies s W) => Num (BVar s a) where-    (+)         = liftOp2 (+.)+    (+)         = liftOp2 afNum afNum zfNum (+.)     {-# INLINE (+) #-}-    (-)         = liftOp2 (-.)+    (-)         = liftOp2 afNum afNum zfNum (-.)     {-# INLINE (-) #-}-    (*)         = liftOp2 (*.)+    (*)         = liftOp2 afNum afNum zfNum (*.)     {-# INLINE (*) #-}-    negate      = liftOp1 negateOp+    negate      = liftOp1 afNum zfNum negateOp     {-# INLINE negate #-}-    signum      = liftOp1 signumOp+    signum      = liftOp1 afNum zfNum signumOp     {-# INLINE signum #-}-    abs         = liftOp1 absOp+    abs         = liftOp1 afNum zfNum absOp     {-# INLINE abs #-}     fromInteger = constVar . fromInteger     {-# INLINE fromInteger #-}  instance (Fractional a, Reifies s W) => Fractional (BVar s a) where-    (/)          = liftOp2 (/.)+    (/)          = liftOp2 afNum afNum zfNum (/.)     {-# INLINE (/) #-}-    recip        = liftOp1 recipOp+    recip        = liftOp1 afNum zfNum recipOp     {-# INLINE recip #-}     fromRational = constVar . fromRational     {-# INLINE fromRational #-}@@ -649,39 +687,39 @@ instance (Floating a, Reifies s W) => Floating (BVar s a) where     pi      = constVar pi     {-# INLINE pi #-}-    exp     = liftOp1 expOp+    exp     = liftOp1 afNum zfNum expOp     {-# INLINE exp #-}-    log     = liftOp1 logOp+    log     = liftOp1 afNum zfNum logOp     {-# INLINE log #-}-    sqrt    = liftOp1 sqrtOp+    sqrt    = liftOp1 afNum zfNum sqrtOp     {-# INLINE sqrt #-}-    (**)    = liftOp2 (**.)+    (**)    = liftOp2 afNum afNum zfNum (**.)     {-# INLINE (**) #-}-    logBase = liftOp2 logBaseOp+    logBase = liftOp2 afNum afNum zfNum logBaseOp     {-# INLINE logBase #-}-    sin     = liftOp1 sinOp+    sin     = liftOp1 afNum zfNum sinOp     {-# INLINE sin #-}-    cos     = liftOp1 cosOp+    cos     = liftOp1 afNum zfNum cosOp     {-# INLINE cos #-}-    tan     =  liftOp1 tanOp+    tan     = liftOp1 afNum zfNum tanOp     {-# INLINE tan  #-}-    asin    = liftOp1 asinOp+    asin    = liftOp1 afNum zfNum asinOp     {-# INLINE asin #-}-    acos    = liftOp1 acosOp+    acos    = liftOp1 afNum zfNum acosOp     {-# INLINE acos #-}-    atan    = liftOp1 atanOp+    atan    = liftOp1 afNum zfNum atanOp     {-# INLINE atan #-}-    sinh    = liftOp1 sinhOp+    sinh    = liftOp1 afNum zfNum sinhOp     {-# INLINE sinh #-}-    cosh    = liftOp1 coshOp+    cosh    = liftOp1 afNum zfNum coshOp     {-# INLINE cosh #-}-    tanh    = liftOp1 tanhOp+    tanh    = liftOp1 afNum zfNum tanhOp     {-# INLINE tanh #-}-    asinh   = liftOp1 asinhOp+    asinh   = liftOp1 afNum zfNum asinhOp     {-# INLINE asinh #-}-    acosh   = liftOp1 acoshOp+    acosh   = liftOp1 afNum zfNum acoshOp     {-# INLINE acosh #-}-    atanh   = liftOp1 atanhOp+    atanh   = liftOp1 afNum zfNum atanhOp     {-# INLINE atanh #-}  -- | Compares the values inside the 'BVar'.@@ -727,4 +765,3 @@         go []     = error "asList"         go (y:ys) = (y, ys) {-# INLINE ixt #-}-

@@ -0,0 +1,426 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE PatternSynonyms   #-}+{-# LANGUAGE RankNTypes        #-}++-- |+-- Module      : Numeric.Backprop.Num+-- Copyright   : (c) Justin Le 2018+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provides the exact same API as "Numeric.Backprop", except requiring+-- 'Num' instances for all types involved instead of 'Backprop' instances.+--+-- This was the original API of the library (for version 0.1).+--+-- 'Num' is strictly more powerful than 'Backprop', and is a stronger+-- constraint on types than is necessary for proper backpropagating.  In+-- particular, 'fromInteger' is a problem for many types, preventing useful+-- backpropagation for lists, variable-length vectors (like "Data.Vector")+-- and variable-size matrices from linear algebra libraries like /hmatrix/+-- and /accelerate/.+--+-- However, this module might be useful in situations where you are working+-- with external types with 'Num' instances, and you want to avoid writing+-- orphan instances for external types.+--+-- If you have external types that are not 'Num' instances, consider+-- instead "Numeric.Backprop.External".+--+-- 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") if you are writing an+-- application and do not have to worry about orphan instances.+--+-- See "Numeric.Backprop" for fuller documentation on using these+-- functions.+--+-- @since 0.2.0.0++module Numeric.Backprop.Num (+    -- * Types+    BVar, W+    -- * Running+  , backprop, E.evalBP, gradBP, backpropWith+    -- ** Multiple inputs+  , backprop2, E.evalBP2, gradBP2, backpropWith2+  , backpropN, E.evalBPN, gradBPN, backpropWithN, Every+    -- * Manipulating 'BVar'+  , E.constVar, E.auto, E.coerceVar+  , (^^.), (.~~), (^^?), (^^..)+  , viewVar, setVar+  , sequenceVar, collectVar+  , previewVar, toListOfVar+    -- ** With Isomorphisms+  , isoVar, isoVar2, isoVar3, isoVarN+    -- ** With 'Op's#liftops#+    -- $liftops+  , liftOp+  , liftOp1, liftOp2, liftOp3+    -- * 'Op'+  , Op(..)+    -- ** Creation+  , op0, opConst, idOp+  , opConst'+    -- *** Giving gradients directly+  , op1, op2, op3+    -- *** From Isomorphisms+  , opCoerce, opTup, opIso, opIsoN, opLens+    -- *** No gradients+  , noGrad1, noGrad+    -- * Utility+    -- ** Inductive tuples/heterogeneous lists+  , Prod(..), pattern (:>), only, head'+  , Tuple, pattern (::<), only_+  , I(..)+    -- ** Misc+  , Reifies+  ) where++import           Data.Reflection+import           Data.Type.Index+import           Data.Type.Length+import           Lens.Micro+import           Numeric.Backprop.Explicit (BVar, W)+import           Numeric.Backprop.Op+import           Type.Class.Known+import qualified Numeric.Backprop.Explicit as E++-- | 'Numeric.Backprop.backpropN', but with 'Num' constraints instead of+-- 'Backprop' constraints.+--+-- The @'Every' 'Num' as@ in the constraint says that every value in the+-- type-level list @as@ must have a 'Num' instance.  This means you can+-- use, say, @'[Double, Float, Int]@, but not @'[Double, Bool, String]@.+--+-- If you stick to /concerete/, monomorphic usage of this (with specific+-- types, typed into source code, known at compile-time), then @'Every'+-- 'Num' as@ should be fulfilled automatically.+--+backpropN+    :: (Every Num as, Known Length as, Num b)+    => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> (b, Tuple as)+backpropN = E.backpropN E.zfNums E.ofNum+{-# INLINE backpropN #-}++-- | 'Numeric.Backprop.backpropWithN', but with 'Num' constraints instead+-- of 'Backprop' constraints.+--+-- See 'backpropN' for information on the 'Every' constraint.+backpropWithN+    :: (Every Num as, Known Length as)+    => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> (b -> b)                 -- ^ Gradient of final result with respect to output of function+    -> (b, Tuple as)+backpropWithN = E.backpropWithN E.zfNums+{-# INLINE backpropWithN #-}++-- | 'Numeric.Backprop.backprop', but with 'Num' constraints instead of+-- 'Backprop' constraints.+--+-- See module documentation for "Numeric.Backprop.Num" for information on+-- using this with tuples.+backprop+    :: (Num a, Num b)+    => (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> (b, a)+backprop = E.backprop E.zfNum E.ofNum+{-# INLINE backprop #-}++-- | 'Numeric.Backprop.backpropWith', but with 'Num' constraints instead of+-- 'Backprop' constraints.+--+-- See module documentation for "Numeric.Backprop.Num" for information on+-- using this with tuples.+backpropWith+    :: Num a+    => (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> (b -> b)                 -- ^ Gradient of final result with respect to output of function+    -> (b, a)+backpropWith = E.backpropWith E.zfNum+{-# INLINE backpropWith #-}++-- | 'Numeric.Backprop.gradBP', but with 'Num' constraints instead of+-- 'Backprop' constraints.+gradBP+    :: (Num a, Num b)+    => (forall s. Reifies s W => BVar s a -> BVar s b)+    -> a+    -> a+gradBP = E.gradBP E.zfNum E.ofNum+{-# INLINE gradBP #-}++-- | 'Numeric.Backprop.gradBPN', but with 'Num' constraints instead of+-- 'Backprop' constraints.+gradBPN+    :: (Every Num as, Known Length as, Num b)+    => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b)+    -> Tuple as+    -> Tuple as+gradBPN = E.gradBPN E.zfNums E.ofNum+{-# INLINE gradBPN #-}++-- | 'Numeric.Backprop.backprop2', but with 'Num' constraints instead of+-- 'Backprop' constraints.+backprop2+    :: (Num a, Num b, Num c)+    => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> (c, (a, b))+backprop2 = E.backprop2 E.zfNum E.zfNum E.ofNum+{-# INLINE backprop2 #-}++-- | 'Numeric.Backprop.backpropWith2', but with 'Num' constraints instead of+-- 'Backprop' constraints.+backpropWith2+    :: (Num a, Num b)+    => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> (c -> c)                 -- ^ Gradient of final result with respect to output of function+    -> (c, (a, b))+backpropWith2 = E.backpropWith2 E.zfNum E.zfNum+{-# INLINE backpropWith2 #-}++-- | 'Numeric.Backprop.gradBP2', but with 'Num' constraints instead of+-- 'Backprop' constraints.+gradBP2+    :: (Num a, Num b, Num c)+    => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)+    -> a+    -> b+    -> (a, b)+gradBP2 = E.gradBP2 E.zfNum E.zfNum E.ofNum+{-# INLINE gradBP2 #-}++-- | 'Numeric.Backprop.^^.', but with 'Num' constraints instead of+-- 'Backprop' constraints.+(^^.)+    :: forall a b s. (Reifies s W, Num a)+    => BVar s b+    -> Lens' b a+    -> BVar s a+x ^^. l = viewVar l x+infixl 8 ^^.+{-# INLINE (^^.) #-}++-- | 'Numeric.Backprop.viewVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+viewVar+    :: forall a b s. (Reifies s W, Num a)+    => Lens' b a+    -> BVar s b+    -> BVar s a+viewVar = E.viewVar E.afNum E.zfNum+{-# INLINE viewVar #-}+++-- | 'Numeric.Backprop..~~', but with 'Num' constraints instead of+-- 'Backprop' constraints.+(.~~)+    :: forall a b s. (Reifies s W, Num a, Num b)+    => Lens' b a+    -> BVar s a+    -> BVar s b+    -> BVar s b+l .~~ x = setVar l x+infixl 8 .~~+{-# INLINE (.~~) #-}++-- | 'Numeric.Backprop.setVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+setVar+    :: forall a b s. (Reifies s W, Num a, Num b)+    => Lens' b a+    -> BVar s a+    -> BVar s b+    -> BVar s b+setVar = E.setVar E.afNum E.afNum E.zfNum E.zfNum+{-# INLINE setVar #-}++-- | 'Numeric.Backprop.^^?', but with 'Num' constraints instead of+-- 'Backprop' constraints.+--+-- Note that many automatically-generated prisms by the /lens/ package use+-- tuples, which cannot work this this by default (because tuples do not+-- 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+    -> Traversal' b a+    -> Maybe (BVar s a)+v ^^? t = previewVar t v+{-# INLINE (^^?) #-}++-- | 'Numeric.Backprop.previewVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+--+-- See documentation for '^^?' for more information and important notes.+previewVar+    :: forall b a s. (Reifies s W, Num a)+    => Traversal' b a+    -> BVar s b+    -> Maybe (BVar s a)+previewVar = E.previewVar E.afNum E.zfNum+{-# INLINE previewVar #-}++-- | 'Numeric.Backprop.^^..', but with 'Num' constraints instead of+-- 'Backprop' constraints.+(^^..)+    :: forall b a s. (Num a, Reifies s W)+    => BVar s b+    -> Traversal' b a+    -> [BVar s a]+v ^^.. t = toListOfVar t v+{-# INLINE (^^..) #-}++-- | 'Numeric.Backprop.toListOfVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+toListOfVar+    :: forall b a s. (Num a, Reifies s W)+    => Traversal' b a+    -> BVar s b+    -> [BVar s a]+toListOfVar = E.toListOfVar E.afNum E.zfNum+{-# INLINE toListOfVar #-}++-- | 'Numeric.Backprop.sequenceVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+sequenceVar+    :: forall t a s. (Num a, Reifies s W, Traversable t)+    => BVar s (t a)+    -> t (BVar s a)+sequenceVar = E.sequenceVar E.afNum E.zfNum+{-# INLINE sequenceVar #-}++-- | 'Numeric.Backprop.collectVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+--+-- If you are using a list or vector, 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 t a s. (Num a, Num (t a), Reifies s W, Foldable t, Functor t)+    => t (BVar s a)+    -> BVar s (t a)+collectVar = E.collectVar E.afNum E.zfNum E.zfNum+{-# INLINE collectVar #-}++-- | 'Numeric.Backprop.liftOp', but with 'Num' constraints instead of+-- 'Backprop' constraints.+liftOp+    :: forall as b s. (Every Num as, Known Length as, Num b, Reifies s W)+    => Op as b+    -> Prod (BVar s) as+    -> BVar s b+liftOp = E.liftOp E.afNums E.zfNum+{-# INLINE liftOp #-}++-- | 'Numeric.Backprop.liftOp1', but with 'Num' constraints instead of+-- 'Backprop' constraints.+liftOp1+    :: forall a b s. (Num a, Num b, Reifies s W)+    => Op '[a] b+    -> BVar s a+    -> BVar s b+liftOp1 = E.liftOp1 E.afNum E.zfNum+{-# INLINE liftOp1 #-}++-- | 'Numeric.Backprop.liftOp2', but with 'Num' constraints instead of+-- 'Backprop' constraints.+liftOp2+    :: forall a b c s. (Num a, Num b, Num c, Reifies s W)+    => Op '[a,b] c+    -> BVar s a+    -> BVar s b+    -> BVar s c+liftOp2 = E.liftOp2 E.afNum E.afNum E.zfNum+{-# INLINE liftOp2 #-}++-- | 'Numeric.Backprop.liftOp3', but with 'Num' constraints instead of+-- 'Backprop' constraints.+liftOp3+    :: forall a b c d s. (Num a, Num b, Num c, Num d, Reifies s W)+    => Op '[a,b,c] d+    -> BVar s a+    -> BVar s b+    -> BVar s c+    -> BVar s d+liftOp3 = E.liftOp3 E.afNum E.afNum E.afNum E.zfNum+{-# INLINE liftOp3 #-}++-- | 'Numeric.Backprop.isoVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+isoVar+    :: (Num a, Num b, Reifies s W)+    => (a -> b)+    -> (b -> a)+    -> BVar s a+    -> BVar s b+isoVar f g = liftOp1 (opIso f g)+{-# INLINE isoVar #-}++-- | 'Numeric.Backprop.isoVar', but with 'Num' constraints instead of+-- 'Backprop' constraints.+isoVar2+    :: (Num a, Num b, Num c, Reifies s W)+    => (a -> b -> c)+    -> (c -> (a, b))+    -> BVar s a+    -> BVar s b+    -> BVar s c+isoVar2 f g = liftOp2 (opIso2 f g)+{-# INLINE isoVar2 #-}++-- | 'Numeric.Backprop.isoVar3', but with 'Num' constraints instead of+-- 'Backprop' constraints.+isoVar3+    :: (Num a, Num b, Num c, Num d, Reifies s W)+    => (a -> b -> c -> d)+    -> (d -> (a, b, c))+    -> BVar s a+    -> BVar s b+    -> BVar s c+    -> BVar s d+isoVar3 f g = liftOp3 (opIso3 f g)+{-# INLINE isoVar3 #-}++-- | 'Numeric.Backprop.isoVarN', but with 'Num' constraints instead of+-- 'Backprop' constraints.+isoVarN+    :: (Every Num as, Known Length as, Num b, Reifies s W)+    => (Tuple as -> b)+    -> (b -> Tuple as)+    -> Prod (BVar s) as+    -> BVar s b+isoVarN f g = liftOp (opIsoN f g)+{-# INLINE isoVarN #-}+

@@ -32,6 +32,9 @@ -- of functions, 'Op' and its utility functions alone are sufficient to -- differentiate/backprop.  However, this happens rarely in practice. --+-- To use these 'Op's with the backprop library, they can be made to work+-- with 'BVar's using 'liftOp', 'liftOp1', 'liftOp2', and 'liftOp3'.+--  module Numeric.Backprop.Op (   -- * Implementation@@ -170,6 +173,9 @@ -- -- See "Numeric.Backprop.Op#prod" for a mini-tutorial on using 'Prod' and -- 'Tuple'.+--+-- To /use/ an 'Op' with the backprop library, see 'liftOp', 'liftOp1',+-- 'liftOp2', and 'liftOp3'. newtype Op as a =     -- | Construct an 'Op' by giving a function creating the     -- result, and also a continuation on how to create the gradient, given

@@ -1,712 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes   #-}-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE ConstraintKinds       #-}-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE LambdaCase            #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE StandaloneDeriving    #-}-{-# LANGUAGE TupleSections         #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeInType            #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}-{-# LANGUAGE ViewPatterns          #-}---- |--- Module      : Numeric.Backprop.Tuple--- Copyright   : (c) Justin Le 2018--- License     : BSD3------ Maintainer  : justin@jle.im--- Stability   : experimental--- Portability : non-portable------ Canonical strict tuples (and unit) 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".------ You can "construct" a @'BVar' s ('T2' a b)@ with functions like--- 'isoVar'.------ @since 0.1.1.0------module Numeric.Backprop.Tuple (-  -- * Zero-tuples (unit)-    T0(..)-  -- * Two-tuples-  , T2(..)-  -- ** Conversions-  -- $t2iso-  , t2Tup, tupT2-  -- ** Consumption-  , uncurryT2, curryT2-  -- ** Lenses-  , t2_1, t2_2-  -- * Three-tuples-  , T3(..)-  -- ** Conversions-  -- $t3iso-  , t3Tup, tupT3-  -- ** Lenses-  , t3_1, t3_2, t3_3-  -- ** Consumption-  , uncurryT3, curryT3-  -- * N-Tuples-  , T(..)-  , indexT-  -- ** Conversions-  -- $tiso-  , tOnly, onlyT, tSplit, tAppend, tProd, prodT-  -- ** Lenses-  , tIx, tHead, tTail, tTake, tDrop-  -- ** Internal Utility-  , constT, mapT, zipT-  ) where--import           Control.DeepSeq-import           Control.Monad.Trans.State-import           Data.Bifunctor-import           Data.Data-import           Data.Kind-import           Data.Type.Combinator-import           Data.Type.Index-import           Data.Type.Length-import           Data.Type.Product-import           GHC.Generics               (Generic)-import           Lens.Micro-import           Lens.Micro.Internal hiding (Index)-import           System.Random-import           Type.Class.Known-import           Type.Family.List-import qualified Data.Binary                as Bi--#if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup-#endif---- | Unit ('()') with 'Num', 'Fractional', and 'Floating' instances.------ Be aware that the methods in its numerical instances are all non-strict:------ @--- _ + _ = 'T0'--- 'negate' _ = 'T0'--- 'fromIntegral' _ = 'T0'--- @------ @since 0.1.4.0-data T0 = T0-  deriving (Show, Read, Eq, Ord, Generic, Data)---- | Strict 2-tuple with 'Num', 'Fractional', and 'Floating' instances.------ @since 0.1.1.0-data T2 a b   = T2 !a !b-  deriving (Show, Read, Eq, Ord, Generic, Functor, Data, Typeable)---- | Strict 3-tuple with a 'Num', 'Fractional', and 'Floating' instances.------ @since 0.1.1.0-data T3 a b c = T3 !a !b !c-  deriving (Show, Read, Eq, Ord, Generic, Functor, Data, Typeable)---- | Strict inductive N-tuple with a 'Num', 'Fractional', and 'Floating'--- instances.------ It is basically "yet another HList", like the one found in--- "Data.Type.Product" and many other locations on the haskell ecosystem.--- Because it's inductively defined, it has O(n) random indexing, but is--- efficient for zipping and mapping and other sequential consumption--- patterns.------ It is provided because of its 'Num' instance, making it useful for--- /backproup/.  Will be obsolete when 'Data.Type.Product.Product' gets--- numerical instances.------ @since 0.1.5.0-data T :: [Type] -> Type where-    TNil :: T '[]-    (:&) :: !a -> !(T as) -> T (a ': as)---- | @since 0.1.5.1-deriving instance ListC (Show <$> as) => Show (T as)--- | @since 0.1.5.1-deriving instance ListC (Eq <$> as) => Eq (T as)--- | @since 0.1.5.1-deriving instance (ListC (Eq <$> as), ListC (Ord <$> as)) => Ord (T as)--- | @since 0.1.5.1-deriving instance Typeable (T as)---- | @since 0.1.5.1-deriving instance Typeable T0--- | @since 0.1.5.1-deriving instance Typeable (T2 a b)--- | @since 0.1.5.1-deriving instance Typeable (T3 a b c)--instance NFData T0-instance (NFData a, NFData b) => NFData (T2 a b)-instance (NFData a, NFData b, NFData c) => NFData (T3 a b c)-instance ListC (NFData <$> as) => NFData (T as) where-    rnf = \case-      TNil    -> ()-      x :& xs -> rnf x `seq` rnf xs---- | @since 0.1.5.2-instance Random T0 where-    randomR  _   = (T0,)-    random       = (T0,)-    randomRs _ _ = repeat T0-    randoms  _   = repeat T0-    randomIO     = pure T0---- | @since 0.1.5.2-instance (Random a, Random b) => Random (T2 a b) where-    randomR (T2 lx ly, T2 ux uy) = runState $-        T2 <$> state (randomR (lx, ux))-           <*> state (randomR (ly, uy))-    random = runState $-        T2 <$> state random <*> state random---- | @since 0.1.5.2-instance (Random a, Random b, Random c) => Random (T3 a b c) where-    randomR (T3 lx ly lz, T3 ux uy uz) = runState $-        T3 <$> state (randomR (lx, ux))-           <*> state (randomR (ly, uy))-           <*> state (randomR (lz, uz))-    random = runState $-        T3 <$> state random <*> state random <*> state random------ TODO: optimize?---- | @since 0.1.5.1-instance Bi.Binary T0--- | @since 0.1.5.1-instance (Bi.Binary a, Bi.Binary b) => Bi.Binary (T2 a b)--- | @since 0.1.5.1-instance (Bi.Binary a, Bi.Binary b, Bi.Binary c) => Bi.Binary (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'.-t2Tup :: T2 a b -> (a, b)-t2Tup (T2 x y) = (x, y)---- | Convert from Haskell tuple.------ Forms an isomorphism with 't2Tup'.-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---- | A singleton 'T'------ Forms an isomorphism with 'tOnly'------ @since 0.1.5.0-onlyT :: a -> T '[a]-onlyT = (:& TNil)---- | Extract a singleton 'T'------ Forms an isomorphism with 'onlyT'------ @since 0.1.5.0-tOnly :: T '[a] -> a-tOnly (x :& _) = x---- | 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 = t2_1--instance Field2 (T2 a b) (T2 a b') b b' where-    _2 = t2_2--instance Field1 (T3 a b c) (T3 a' b c) a a' where-    _1 = t3_1--instance Field2 (T3 a b c) (T3 a b' c) b b' where-    _2 = t3_2--instance Field3 (T3 a b c) (T3 a b c') c c' where-    _3 = t3_3--instance Field1 (T (a ': as)) (T (a ': as)) a a where-    _1 = tIx IZ--instance Field2 (T (a ': b ': as)) (T (a ': b ': as)) b b where-    _2 = tIx (IS IZ)--instance Field3 (T (a ': b ': c ': as)) (T (a ': b ': c ': as)) c c where-    _3 = tIx (IS (IS IZ))---- | 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 f (T2 x y) = (`T2` y) <$> f x---- | 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 f (T2 x y) = T2 x <$> f y---- | 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 f (T3 x y z) = (\x' -> T3 x' y z) <$> f x---- | 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 f (T3 x y z) = (\y' -> T3 x y' z) <$> f y---- | 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 f (T3 x y z) = T3 x y <$> f z---- | Index into a 'T'.------ /O(i)/------ @since 0.1.5.0-indexT :: Index as a -> T as -> a-indexT = flip (^.) . tIx---- | Lens into a given index of a 'T'.------ @since 0.1.5.0-tIx :: Index as a -> Lens' (T as) a-tIx IZ     f (x :& xs) = (:& xs) <$> f x-tIx (IS i) f (x :& xs) = (x :&)  <$> tIx i f xs---- | Lens into the head of a 'T'------ @since 0.1.5.0-tHead :: Lens (T (a ': as)) (T (b ': as)) a b-tHead f (x :& xs) = (:& xs) <$> f x---- | Lens into the tail of a 'T'------ @since 0.1.5.0-tTail :: Lens (T (a ': as)) (T (a ': bs)) (T as) (T bs)-tTail f (x :& xs) = (x :&) <$> f xs---- | Append two 'T's.------ Forms an isomorphism with 'tSplit'.------ @since 0.1.5.0-tAppend :: T as -> T bs -> T (as ++ bs)-tAppend TNil      ys = ys-tAppend (x :& xs) ys = x :& tAppend xs ys-infixr 5 `tAppend`---- | Split a 'T'.  For splits known at compile-time, you can use 'known' to--- derive the 'Length' automatically.------ Forms an isomorphism with 'tAppend'.------ @since 0.1.5.0-tSplit :: Length as -> T (as ++ bs) -> (T as, T bs)-tSplit LZ     xs        = (TNil, xs)-tSplit (LS l) (x :& xs) = first (x :&) . tSplit l $ xs---- | Lens into the initial portion of a 'T'.  For splits known at--- compile-time, you can use 'known' to derive the 'Length' automatically.------ @since 0.1.5.0-tTake :: forall as bs cs. Length as -> Lens (T (as ++ bs)) (T (cs ++ bs)) (T as) (T cs)-tTake l f (tSplit l->(xs,ys)) = flip (tAppend @cs @bs) ys <$> f xs---- | Lens into the ending portion of a 'T'.  For splits known at--- compile-time, you can use 'known' to derive the 'Length' automatically.------ @since 0.1.5.0-tDrop :: forall as bs cs. Length as -> Lens (T (as ++ bs)) (T (as ++ cs)) (T bs) (T cs)-tDrop l f (tSplit l->(xs,ys)) = tAppend xs <$> f ys---- | Convert a 'T' to a 'Tuple'.------ Forms an isomorphism with 'prodT'.------ @since 0.1.5.0-tProd :: T as -> Tuple as-tProd TNil      = Ø-tProd (x :& xs) = x ::< tProd xs---- | Convert a 'Tuple' to a 'T'.------ Forms an isomorphism with 'tProd'.------ @since 0.1.5.0-prodT :: Tuple as -> T as-prodT Ø           = TNil-prodT (I x :< xs) = x :& prodT xs---instance Num T0 where-    _ + _         = T0-    _ - _         = T0-    _ * _         = T0-    negate _      = T0-    abs    _      = T0-    signum _      = T0-    fromInteger _ = T0--instance Fractional T0 where-    _ / _          = T0-    recip _        = T0-    fromRational _ = T0--instance Floating T0 where-    pi          = T0-    _ ** _      = T0-    logBase _ _ = T0-    exp   _     = T0-    log   _     = T0-    sqrt  _     = T0-    sin   _     = T0-    cos   _     = T0-    asin  _     = T0-    acos  _     = T0-    atan  _     = T0-    sinh  _     = T0-    cosh  _     = T0-    asinh _     = T0-    acosh _     = T0-    atanh _     = T0--instance Semigroup T0 where-    _ <> _ = T0--instance Monoid T0 where-    mempty = T0-    mappend = (<>)--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)--#if MIN_VERSION_base(4,11,0)-instance (Monoid a, Monoid b) => Monoid (T2 a b) where-#else-instance (Semigroup a, Semigroup b, Monoid a, Monoid b) => Monoid (T2 a b) where-#endif-    mappend = (<>)-    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)--#if MIN_VERSION_base(4,11,0)-instance (Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) where-#else-instance (Semigroup a, Semigroup b, Semigroup c, Monoid a, Monoid b, Monoid c) => Monoid (T3 a b c) where-#endif-    mappend = (<>)-    mempty  = T3 mempty mempty mempty---- | Initialize a 'T' with a Rank-N value.  Mostly used internally, but--- provided in case useful.------ Must be used with /TypeApplications/ to provide the Rank-N constraint.------ @since 0.1.5.0-constT-    :: forall c as. ListC (c <$> as)-    => (forall a. c a => a)-    -> Length as-    -> T as-constT x = go-  where-    go :: forall bs. ListC (c <$> bs) => Length bs -> T bs-    go LZ     = TNil-    go (LS l) = x :& go l---- | Map over a 'T' with a Rank-N function.  Mostly used internally, but--- provided in case useful.------ Must be used with /TypeApplications/ to provide the Rank-N constraint.------ @since 0.1.5.0-mapT-    :: forall c as. ListC (c <$> as)-    => (forall a. c a => a -> a)-    -> T as-    -> T as-mapT f = go-  where-    go :: forall bs. ListC (c <$> bs) => T bs -> T bs-    go TNil      = TNil-    go (x :& xs) = f x :& go xs---- | Map over a 'T' with a Rank-N function.  Mostly used internally, but--- provided in case useful.------ Must be used with /TypeApplications/ to provide the Rank-N constraint.------ @since 0.1.5.0-zipT-    :: forall c as. ListC (c <$> as)-    => (forall a. c a => a -> a -> a)-    -> T as-    -> T as-    -> T as-zipT f = go-  where-    go :: forall bs. ListC (c <$> bs) => T bs -> T bs -> T bs-    go TNil      TNil      = TNil-    go (x :& xs) (y :& ys) = f x y :& go xs ys--instance (Known Length as, ListC (Num <$> as)) => Num (T as) where-    (+)           = zipT @Num (+)-    (-)           = zipT @Num (-)-    (*)           = zipT @Num (*)-    negate        = mapT @Num negate-    abs           = mapT @Num abs-    signum        = mapT @Num signum-    fromInteger x = constT @Num (fromInteger x) known--instance (Known Length as, ListC (Num <$> as), ListC (Fractional <$> as)) => Fractional (T as) where-    (/)            = zipT @Fractional (/)-    recip          = mapT @Fractional recip-    fromRational x = constT @Fractional (fromRational x) known--instance (Known Length as, ListC (Num <$> as), ListC (Fractional <$> as), ListC (Floating <$> as))-        => Floating (T as) where-    pi      = constT @Floating pi known-    (**)    = zipT @Floating (**)-    logBase = zipT @Floating logBase-    exp     = mapT @Floating exp-    log     = mapT @Floating log-    sqrt    = mapT @Floating sqrt-    sin     = mapT @Floating sin-    cos     = mapT @Floating cos-    asin    = mapT @Floating asin-    acos    = mapT @Floating acos-    atan    = mapT @Floating atan-    sinh    = mapT @Floating sinh-    cosh    = mapT @Floating cosh-    asinh   = mapT @Floating asinh-    acosh   = mapT @Floating acosh-    atanh   = mapT @Floating atanh--instance ListC (Semigroup <$> as) => Semigroup (T as) where-    (<>) = zipT @Semigroup (<>)--instance (Known Length as, ListC (Semigroup <$> as), ListC (Monoid <$> as)) => Monoid (T as) where-    mempty  = constT @Monoid mempty known-    mappend = (<>)---- | @since 0.1.5.1-instance (Known Length as, ListC (Bi.Binary <$> as)) => Bi.Binary (T as) where-    put = \case-      TNil -> pure ()-      x :& xs -> do-        Bi.put x-        Bi.put xs-    get = getT known--getT :: ListC (Bi.Binary <$> as) => Length as -> Bi.Get (T as)-getT = \case-    LZ   -> pure TNil-    LS l -> do-      x  <- Bi.get-      xs <- getT l-      pure (x :& xs)---- | @since 0.1.5.2-instance (Known Length as, ListC (Random <$> as)) => Random (T as) where-    randomR (l, u) = runState (randomRT l u)-    random         = runState (randomT known)--randomRT-    :: (ListC (Random <$> as), RandomGen g)-    => T as-    -> T as-    -> State g (T as)-randomRT = \case-    TNil -> \case-      TNil -> pure TNil-    lx :& lxs -> \case-      ux :& uxs -> (:&) <$> state (randomR (lx, ux)) <*> randomRT lxs uxs--randomT-    :: (ListC (Random <$> as), RandomGen g)-    => Length as-    -> State g (T as)-randomT = \case-    LZ   -> pure TNil-    LS l -> (:&) <$> state random <*> randomT l---- $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)--- @---- $tiso------ If using /lens/, the two conversion functions can be chained with prisms--- and traversals and other optics using:------ @--- 'iso' 'onlyT' 'tOnly' :: 'Iso'' a (T '[a])--- @

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}  -- |@@ -13,15 +14,13 @@ -- Some lifted versions of common functions found in 'Prelude' (or /base/ -- in general). ----- Intended to work with 'Functor' / 'Foldable' / 'Traversable' instances--- with "fixed" number of items, i.e.--- <https://hackage.haskell.org/package/vector-sized vector-sized> vectors.--- There might be unintended consequences when using it with instances--- where the number of items is not fixed.--- -- This module is intended to be a catch-all one, so feel free to suggest -- other functions or submit a PR if you think one would make sense. --+-- See "Prelude.Backprop.Num" for a version with 'Num' constraints instead+-- of 'Backprop' constraints, and "Prelude.Backprop.Explicit" for a version+-- allowing you to provide 'zero', 'add', and 'one' explicitly.+-- -- @since 0.1.3.0 -- @@ -47,10 +46,11 @@ import           Prelude             (Num(..), Fractional(..), Eq(..), Ord(..), Functor, Foldable, Traversable, Applicative, (.), ($)) import qualified Control.Applicative as P import qualified Data.Coerce         as C+import qualified Data.Foldable       as P import qualified Prelude             as P  -- | Lifted 'P.sum'-sum :: forall t a s. (Foldable t, Functor t, Num (t a), Num a, Reifies s W)+sum :: forall t a s. (Foldable t, Functor t, Backprop (t a), Backprop a, Num a, Reifies s W)     => BVar s (t a)     -> BVar s a sum = liftOp1 . op1 $ \xs ->@@ -59,22 +59,21 @@     ) {-# INLINE sum #-} --- | Lifted 'P.pure'.  Really intended only for 'Applicative' instances--- with fixed number of items; untintended consequences might arise when--- using it with containers with variable number of items.+-- | Lifted 'P.pure'. pure-    :: forall t a s. (Foldable t, Applicative t, Num (t a), Num a, Reifies s W)+    :: forall t a s. (Foldable t, Applicative t, Backprop (t a), Backprop a, Reifies s W)     => BVar s a     -> BVar s (t a) pure = liftOp1 . op1 $ \x ->     ( P.pure x-    , P.sum+    , P.foldl' add (zero x)+    -- , P.foldl' add zero     ) {-# INLINE pure #-}  -- | Lifted 'P.product' product-    :: forall t a s. (Foldable t, Functor t, Num (t a), Fractional a, Reifies s W)+    :: forall t a s. (Foldable t, Functor t, Backprop (t a), Backprop a, Fractional a, Reifies s W)     => BVar s (t a)     -> BVar s a product = liftOp1 . op1 $ \xs ->@@ -86,49 +85,45 @@  -- | Lifted 'P.length'. length-    :: forall t a b s. (Foldable t, Num (t a), Num b, Reifies s W)+    :: forall t a b s. (Foldable t, Backprop (t a), Backprop b, Num b, Reifies s W)     => BVar s (t a)     -> BVar s b length = liftOp1 . op1 $ \xs ->     ( P.fromIntegral (P.length xs)-    , P.const 0+    , P.const (zero xs)     ) {-# INLINE length #-}  -- | Lifted 'P.minimum'.  Undefined for situations where 'P.minimum' would -- be undefined. minimum-    :: forall t a s. (Foldable t, Functor t, Num a, Ord a, Num (t a), Reifies s W)+    :: forall t a s. (Foldable t, Functor t, Backprop a, Ord a, Backprop (t a), Reifies s W)     => BVar s (t a)     -> BVar s a minimum = liftOp1 . op1 $ \xs ->     let m = P.minimum xs     in  ( m-        , \d -> (\x -> if x == m then d else 0) P.<$> xs+        , \d -> (\x -> if x == m then d else zero x) P.<$> xs         ) {-# INLINE minimum #-}  -- | Lifted 'P.maximum'.  Undefined for situations where 'P.maximum' would -- be undefined. maximum-    :: forall t a s. (Foldable t, Functor t, Num a, Ord a, Num (t a), Reifies s W)+    :: forall t a s. (Foldable t, Functor t, Backprop a, Ord a, Backprop (t a), Reifies s W)     => BVar s (t a)     -> BVar s a maximum = liftOp1 . op1 $ \xs ->     let m = P.maximum xs     in  ( m-        , \d -> (\x -> if x == m then d else 0) P.<$> xs+        , \d -> (\x -> if x == m then d else zero x) P.<$> xs         ) {-# INLINE maximum #-}  -- | Lifted 'P.fmap'.  Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Functor's.------ Really intended only for 'Functor' instances with fixed number of items;--- untintended consequences might arise when using it with containers with--- variable number of items. fmap-    :: forall f a b s. (Traversable f, Num a, Num b, Num (f b), Reifies s W)+    :: forall f a b s. (Traversable f, Backprop a, Backprop b, Backprop (f b), Reifies s W)     => (BVar s a -> BVar s b)     -> BVar s (f a)     -> BVar s (f b)@@ -137,7 +132,7 @@  -- | Alias for 'fmap'. (<$>)-    :: forall f a b s. (Traversable f, Num a, Num b, Num (f b), Reifies s W)+    :: forall f a b s. (Traversable f, Backprop a, Backprop b, Backprop (f b), Reifies s W)     => (BVar s a -> BVar s b)     -> BVar s (f a)     -> BVar s (f b)@@ -146,12 +141,8 @@  -- | Lifted 'P.traverse'.  Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Functor's.------ Really intended only for 'Traversable' and 'Applicative' instances with--- fixed number of items; untintended consequences might arise when using--- it with containers with variable number of items. traverse-    :: forall t f a b s. (Traversable t, Applicative f, Foldable f, Num a, Num b, Num (f (t b)), Num (t b), Reifies s W)+    :: forall t f a b s. (Traversable t, Applicative f, Foldable f, Backprop a, Backprop b, Backprop (f (t b)), Backprop (t b), Reifies s W)     => (BVar s a -> f (BVar s b))     -> BVar s (t a)     -> BVar s (f (t b))@@ -163,15 +154,11 @@  -- | Lifted 'P.liftA2'.  Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Applicative's.------ Really intended only for 'Traversable' and 'Applicative' instances with--- fixed number of items; untintended consequences might arise when using--- it with containers with variable number of items. liftA2     :: forall f a b c s.        ( Traversable f        , Applicative f-       , Num a, Num b, Num c, Num (f c)+       , Backprop a, Backprop b, Backprop c, Backprop (f c)        , Reifies s W        )     => (BVar s a -> BVar s b -> BVar s c)@@ -184,15 +171,11 @@  -- | Lifted 'P.liftA3'.  Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Applicative's.------ Really intended only for 'Traversable' and 'Applicative' instances with--- fixed number of items; untintended consequences might arise when using--- it with containers with variable number of items. liftA3     :: forall f a b c d s.        ( Traversable f        , Applicative f-       , Num a, Num b, Num c, Num d, Num (f d)+       , Backprop a, Backprop b, Backprop c, Backprop d, Backprop (f d)        , Reifies s W        )     => (BVar s a -> BVar s b -> BVar s c -> BVar s d)@@ -207,8 +190,8 @@  -- | Coerce items inside a 'BVar'. coerce-    :: forall a b s. (C.Coercible a b, Num a, Num b, Reifies s W)+    :: forall a b s. C.Coercible a b     => BVar s a     -> BVar s b-coerce = liftOp1 $ opIso C.coerce C.coerce+coerce = coerceVar {-# INLINE coerce #-}

@@ -0,0 +1,225 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : Prelude.Backprop.Explicit+-- Copyright   : (c) Justin Le 2018+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provides "explicit" versions of all of the functions in+-- "Prelude.Backprop".  Instead of relying on a 'Backprop' instance, allows+-- you to manually provide 'zero', 'add', and 'one' on a per-value basis.+--+-- @since 0.2.0.0++module Prelude.Backprop.Explicit (+  -- * Foldable and Traversable+    sum+  , product+  , length+  , minimum+  , maximum+  , traverse+  -- * Functor and Applicative+  , fmap+  , pure+  , liftA2+  , liftA3+  -- * Misc+  , coerce+  ) where++import           Numeric.Backprop.Explicit+import           Prelude             (Num(..), Fractional(..), Eq(..), Ord(..), Functor, Foldable, Traversable, Applicative, (.), ($))+import qualified Control.Applicative as P+import qualified Data.Coerce         as C+import qualified Data.Foldable       as P+import qualified Prelude             as P++-- | Lifted 'P.sum'+sum :: forall t a s. (Foldable t, Functor t, Num a, Reifies s W)+    => AddFunc (t a)+    -> ZeroFunc a+    -> BVar s (t a)+    -> BVar s a+sum af zf = liftOp1 af zf . op1 $ \xs ->+    ( P.sum xs+    , (P.<$ xs)+    )+{-# INLINE sum #-}++-- | Lifted 'P.pure'.+pure+    :: forall t a s. (Foldable t, Applicative t, Reifies s W)+    => AddFunc a+    -> ZeroFunc a+    -> ZeroFunc (t a)+    -> BVar s a+    -> BVar s (t a)+pure af zfa zf = liftOp1 af zf . op1 $ \x ->+    ( P.pure x+    , P.foldl' (runAF af) (runZF zfa x)+    )+{-# INLINE pure #-}++-- | Lifted 'P.product'+product+    :: forall t a s. (Foldable t, Functor t, Fractional a, Reifies s W)+    => AddFunc (t a)+    -> ZeroFunc a+    -> BVar s (t a)+    -> BVar s a+product af zf = liftOp1 af zf . op1 $ \xs ->+    let p = P.product xs+    in ( p+       , \d -> (\x -> p * d / x) P.<$> xs+       )+{-# INLINE product #-}++-- | Lifted 'P.length'.+length+    :: forall t a b s. (Foldable t, Num b, Reifies s W)+    => AddFunc (t a)+    -> ZeroFunc (t a)+    -> ZeroFunc b+    -> BVar s (t a)+    -> BVar s b+length af zfa zf = liftOp1 af zf . op1 $ \xs ->+    ( P.fromIntegral (P.length xs)+    , P.const (runZF zfa xs)+    )+{-# INLINE length #-}++-- | Lifted 'P.minimum'.  Undefined for situations where 'P.minimum' would+-- be undefined.+minimum+    :: forall t a s. (Foldable t, Functor t, Ord a, Reifies s W)+    => AddFunc (t a)+    -> ZeroFunc a+    -> BVar s (t a)+    -> BVar s a+minimum af zf = liftOp1 af zf . op1 $ \xs ->+    let m = P.minimum xs+    in  ( m+        , \d -> (\x -> if x == m then d else runZF zf x) P.<$> xs+        )+{-# INLINE minimum #-}++-- | Lifted 'P.maximum'.  Undefined for situations where 'P.maximum' would+-- be undefined.+maximum+    :: forall t a s. (Foldable t, Functor t, Ord a, Reifies s W)+    => AddFunc (t a)+    -> ZeroFunc a+    -> BVar s (t a)+    -> BVar s a+maximum af zf = liftOp1 af zf . op1 $ \xs ->+    let m = P.maximum xs+    in  ( m+        , \d -> (\x -> if x == m then d else runZF zf x) P.<$> xs+        )+{-# INLINE maximum #-}++-- | Lifted 'P.fmap'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Functor's.+fmap+    :: forall f a b s. (Traversable f, Reifies s W)+    => AddFunc a+    -> AddFunc b+    -> ZeroFunc a+    -> ZeroFunc b+    -> ZeroFunc (f b)+    -> (BVar s a -> BVar s b)+    -> BVar s (f a)+    -> BVar s (f b)+fmap afa afb zfa zfb zfbs f = collectVar afb zfb zfbs . P.fmap f . sequenceVar afa zfa+{-# INLINE fmap #-}++-- | Lifted 'P.traverse'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Functor's.+traverse+    :: forall t f a b s. (Traversable t, Applicative f, Foldable f, Reifies s W)+    => AddFunc a+    -> AddFunc b+    -> AddFunc (t b)+    -> ZeroFunc a+    -> ZeroFunc b+    -> ZeroFunc (t b)+    -> ZeroFunc (f (t b))+    -> (BVar s a -> f (BVar s b))+    -> BVar s (t a)+    -> BVar s (f (t b))+traverse afa afb aftb zfa zfb zftb zfftb f+        = collectVar aftb zftb zfftb+        . P.fmap (collectVar afb zfb zftb)+        . P.traverse f+        . sequenceVar afa zfa+{-# INLINE traverse #-}++-- | Lifted 'P.liftA2'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Applicative's.+liftA2+    :: forall f a b c s.+       ( Traversable f+       , Applicative f+       , Reifies s W+       )+    => AddFunc a+    -> AddFunc b+    -> AddFunc c+    -> ZeroFunc a+    -> ZeroFunc b+    -> ZeroFunc c+    -> ZeroFunc (f c)+    -> (BVar s a -> BVar s b -> BVar s c)+    -> BVar s (f a)+    -> BVar s (f b)+    -> BVar s (f c)+liftA2 afa afb afc zfa zfb zfc zffc f x y+    = collectVar afc zfc zffc+    $ f P.<$> sequenceVar afa zfa x+        P.<*> sequenceVar afb zfb y+{-# INLINE liftA2 #-}++-- | Lifted 'P.liftA3'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Applicative's.+liftA3+    :: forall f a b c d s.+       ( Traversable f+       , Applicative f+       , Reifies s W+       )+    => AddFunc a+    -> AddFunc b+    -> AddFunc c+    -> AddFunc d+    -> ZeroFunc a+    -> ZeroFunc b+    -> ZeroFunc c+    -> ZeroFunc d+    -> ZeroFunc (f d)+    -> (BVar s a -> BVar s b -> BVar s c -> BVar s d)+    -> BVar s (f a)+    -> BVar s (f b)+    -> BVar s (f c)+    -> BVar s (f d)+liftA3 afa afb afc afd zfa zfb zfc zfd zffd f x y z+    = collectVar afd zfd zffd+    $ f P.<$> sequenceVar afa zfa x+        P.<*> sequenceVar afb zfb y+        P.<*> sequenceVar afc zfc z+{-# INLINE liftA3 #-}++-- | Coerce items inside a 'BVar'.+coerce+    :: forall a b s. C.Coercible a b+    => BVar s a+    -> BVar s b+coerce = coerceVar+{-# INLINE coerce #-}++

@@ -0,0 +1,187 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : Prelude.Backprop.Num+-- Copyright   : (c) Justin Le 2018+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- Provides the exact same API as "Prelude.Backprop", except requiring+-- 'Num' instances for all types involved instead of 'Backprop' instances.+--+-- @since 0.2.0.0++module Prelude.Backprop.Num (+  -- * Foldable and Traversable+    sum+  , product+  , length+  , minimum+  , maximum+  , traverse+  -- * Functor and Applicative+  , fmap+  , (<$>)+  , pure+  , liftA2+  , liftA3+  -- * Misc+  , coerce+  ) where++import           Numeric.Backprop.Num+import           Prelude              (Num(..), Fractional(..), Eq(..), Ord(..), Functor, Foldable, Traversable, Applicative, (.), ($))+import qualified Control.Applicative  as P+import qualified Data.Coerce          as C+import qualified Data.Foldable        as P+import qualified Prelude              as P++-- | Lifted 'P.sum'+sum :: forall t a s. (Foldable t, Functor t, Num (t a), Num a, Reifies s W)+    => BVar s (t a)+    -> BVar s a+sum = liftOp1 . op1 $ \xs ->+    ( P.sum xs+    , (P.<$ xs)+    )+{-# INLINE sum #-}++-- | Lifted 'P.pure'.+pure+    :: forall t a s. (Foldable t, Applicative t, Num (t a), Num a, Reifies s W)+    => BVar s a+    -> BVar s (t a)+pure = liftOp1 . op1 $ \x ->+    ( P.pure x+    , P.sum+    )+{-# INLINE pure #-}++-- | Lifted 'P.product'+product+    :: forall t a s. (Foldable t, Functor t, Num (t a), Fractional a, Reifies s W)+    => BVar s (t a)+    -> BVar s a+product = liftOp1 . op1 $ \xs ->+    let p = P.product xs+    in ( p+       , \d -> (\x -> p * d / x) P.<$> xs+       )+{-# INLINE product #-}++-- | Lifted 'P.length'.+length+    :: forall t a b s. (Foldable t, Num (t a), Num b, Reifies s W)+    => BVar s (t a)+    -> BVar s b+length = liftOp1 . op1 $ \xs ->+    ( P.fromIntegral (P.length xs)+    , P.const 0+    )+{-# INLINE length #-}++-- | Lifted 'P.minimum'.  Undefined for situations where 'P.minimum' would+-- be undefined.+minimum+    :: forall t a s. (Foldable t, Functor t, Num a, Ord a, Num (t a), Reifies s W)+    => BVar s (t a)+    -> BVar s a+minimum = liftOp1 . op1 $ \xs ->+    let m = P.minimum xs+    in  ( m+        , \d -> (\x -> if x == m then d else 0) P.<$> xs+        )+{-# INLINE minimum #-}++-- | Lifted 'P.maximum'.  Undefined for situations where 'P.maximum' would+-- be undefined.+maximum+    :: forall t a s. (Foldable t, Functor t, Num a, Ord a, Num (t a), Reifies s W)+    => BVar s (t a)+    -> BVar s a+maximum = liftOp1 . op1 $ \xs ->+    let m = P.maximum xs+    in  ( m+        , \d -> (\x -> if x == m then d else 0) P.<$> xs+        )+{-# INLINE maximum #-}++-- | Lifted 'P.fmap'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Functor's.+fmap+    :: forall f a b s. (Traversable f, Num a, Num b, Num (f b), Reifies s W)+    => (BVar s a -> BVar s b)+    -> BVar s (f a)+    -> BVar s (f b)+fmap f = collectVar . P.fmap f . sequenceVar+{-# INLINE fmap #-}++-- | Alias for 'fmap'.+(<$>)+    :: forall f a b s. (Traversable f, Num a, Num b, Num (f b), Reifies s W)+    => (BVar s a -> BVar s b)+    -> BVar s (f a)+    -> BVar s (f b)+(<$>) = fmap+{-# INLINE (<$>) #-}++-- | Lifted 'P.traverse'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Functor's.+traverse+    :: forall t f a b s. (Traversable t, Applicative f, Foldable f, Num a, Num b, Num (f (t b)), Num (t b), Reifies s W)+    => (BVar s a -> f (BVar s b))+    -> BVar s (t a)+    -> BVar s (f (t b))+traverse f = collectVar+           . P.fmap collectVar+           . P.traverse f+           . sequenceVar+{-# INLINE traverse #-}++-- | Lifted 'P.liftA2'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Applicative's.+liftA2+    :: forall f a b c s.+       ( Traversable f+       , Applicative f+       , Num a, Num b, Num c, Num (f c)+       , Reifies s W+       )+    => (BVar s a -> BVar s b -> BVar s c)+    -> BVar s (f a)+    -> BVar s (f b)+    -> BVar s (f c)+liftA2 f x y = collectVar $ f P.<$> sequenceVar x+                              P.<*> sequenceVar y+{-# INLINE liftA2 #-}++-- | Lifted 'P.liftA3'.  Lifts backpropagatable functions to be+-- backpropagatable functions on 'Traversable' 'Applicative's.+liftA3+    :: forall f a b c d s.+       ( Traversable f+       , Applicative f+       , Num a, Num b, Num c, Num d, Num (f d)+       , Reifies s W+       )+    => (BVar s a -> BVar s b -> BVar s c -> BVar s d)+    -> BVar s (f a)+    -> BVar s (f b)+    -> BVar s (f c)+    -> BVar s (f d)+liftA3 f x y z = collectVar $ f P.<$> sequenceVar x+                                P.<*> sequenceVar y+                                P.<*> sequenceVar z+{-# INLINE liftA3 #-}++-- | Coerce items inside a 'BVar'.+coerce+    :: forall a b s. C.Coercible a b+    => BVar s a+    -> BVar s b+coerce = coerceVar+{-# INLINE coerce #-}