diff --git a/Build.hs b/Build.hs --- a/Build.hs +++ b/Build.hs @@ -1,5 +1,5 @@ #!/usr/bin/env stack --- stack --install-ghc runghc --package shake +-- stack --install-ghc runghc --package shake-0.16.4 --stack-yaml stack.yaml import Development.Shake import Development.Shake.FilePath @@ -37,15 +37,17 @@ need (map (\f -> "samples-exe" dropExtension f) allSamps) "haddocks" ~> do - need (("src" ) <$> allSrc) + need $ ("src" ) <$> allSrc cmd "jle-git-haddocks" "install" ~> do - need . concat $ [ ("src" ) <$> allSrc - , ("samples" ) <$> allSamps - ] + need $ ("src" ) <$> allSrc cmd "stack install" + "install-profile" ~> do + need $ ("src" ) <$> allSrc + cmd "stack install --profile" + "gentags" ~> need ["tags", "TAGS"] @@ -53,15 +55,16 @@ let src = "samples" takeFileName f -<.> "lhs" need [src] liftIO $ createDirectoryIfMissing True "renders" - cmd "pandoc" "-V geometry:margin=1in" - "-V fontfamily:palatino,cmtt" - "-V links-as-notes" - "-s" - "--highlight-style tango" - "--reference-links" - "--reference-location block" - "-o" f - src + cmd "pandoc" + "-V geometry:margin=1in" + "-V fontfamily:palatino,cmtt" + "-V links-as-notes" + "-s" + "--highlight-style tango" + "--reference-links" + "--reference-location block" + "-o" f + src "samples-exe/*" %> \f -> do need ["install"] @@ -70,22 +73,73 @@ createDirectoryIfMissing True "samples-exe" createDirectoryIfMissing True ".build" removeFilesAfter "samples" ["/*.o"] - cmd "stack" "ghc" - "--resolver lts-10" - "--package backprop" - "--package hmatrix" - "--package lens" - "--package mnist-idx" - "--package one-liner-instances" - "--package split" - "--package singletons" - "--package mwc-random" - "--" - ("samples" src) - "-o" f - "-hidir" ".build" - "-Wall" - "-O2" + cmd "stack ghc" + "--stack-yaml stack.yaml" + "--" + ("samples" src) + "-o" f + "-hidir .build" + "-Wall" + "-O2" + + "profile" ~> do + need $ do + s <- ["manual","bp-lens","bp-hkd","hybrid"] + e <- ["prof.html","svg"] + return $ "bench-prof/bench-" ++ s <.> e + + "bench-prof/bench" %> \f -> do + let src = "bench" takeFileName f <.> ".hs" + need ["install-profile", src] + unit $ cmd "stack install" + "--profile" + "--stack-yaml stack.yaml" + [ "lens" + , "hmatrix" + , "one-liner-instances" + , "split" + , "criterion" + ] + unit $ cmd "stack ghc" + "--profile" + "--stack-yaml stack.yaml" + src + "--" + "-o" f + "-hidir .build" + "-O2" + "-prof" + "-fexternal-interpreter" + + "bench-prof/bench-*.prof" %> \f -> do + need ["bench-prof/bench"] + let b = drop 6 $ takeBaseName f + unit $ cmd "./bench-prof/bench" + ("gradient/" ++ b) + "+RTS" + "-p" + cmd "mv" "bench.prof" f + + "**/*.prof.html" %> \f -> do + let src = f -<.> "" + need [src] + cmd "profiteur" src + + "**/*.prof.folded" %> \f -> do + let src = f -<.> "" + need [src] + Stdout out <- cmd "cat" [src] + cmd (Stdin out) + (FileStdout f) + "ghc-prof-flamegraph" + + "bench-prof/*.svg" %> \f -> do + let src = f -<.> "prof.folded" + need [src] + cmd (FileStdout f) + "flamegraph.pl" + "--width 2000" + src ["tags","TAGS"] &%> \_ -> do need (("src" ) <$> allSrc) diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,50 @@ Changelog ========= +Version 0.2.4.0 +--------------- + +*May 28, 2018* + + + +**NOTE** Major breaking changes to *Explicit* modules, and some re-shuffling of +typeclass constraints on various non-explicit functions that should only affect +polymorphic usage. + +* *Huge improvements in performance!* Around 20-40% reduction in + runtimes/overheads, with savings higher for large matrix situations or + situations with expensive `add`. +* However, this restructuring required *major* reshuffling of constraints on + `Backprop`/`Num` for most functions. These are potentially **breaking + changes** for polymorphic code, but monomorphic code should remain + unchanged. However, code using the *Explicit* interfaces is most likely + broken unfortunately. Fixes just include adding or dropping `zeroFunc`s to + the appropriate functions. +* Added warnings to *Explicit* modules that the API is "semi-stable". +* `overVar` and `%~~`, for modifying fields. Essentially a wrapper over a + `viewVar` and `setVar`. +* Argument order in the `backpropWith` family of functions changed again; + **breaking change** for those using any `backpropWith` function. However, + the new order is much more usable. +* Changes to the argument order in the `backprop` family of functions in the + *Explicit* interfaces now reverted back to previous order, from v0.2.0 and + before. Should be an "un-breaking" change, but will break code written in + v0.2.3 style. +* Bechmarks now include HKD access and a "hybrid" approach. Documentation + updated to reflect results. +* Documentation updated to include a new "unital" law for `one`, namely `one + = gradBP id`. +* Fixity declarations for `^^?`, `^^?!`, and `<$>`. +* Added `fmap . const` and `<$` to *Prelude* modules. +* `Backprop` instances for `Expr` from *simple-reflect* +* Added `zeroVecNum` and `oneVecNum` to *Numeric.Backprop.Class*, which is + potentially more efficient than `zeroVec` and `oneVec` if the items are + instances of `Num` and the vectors are larger. Also added `NumVec` newtype + wrapper giving `Backprop` instances to vectors using `zeroVecNum` and + `oneVecNum` instead of `zeroVec` and `oneVec`. +* `Build.hs` build script now also builds profiling results + Version 0.2.3.0 --------------- @@ -9,7 +53,7 @@ * Argument order in `backpropWith` family of functions switched around to - allow for final gradient to be given after-the-fact. **Braking change** + allow for final gradient to be given after-the-fact. **Breaking change** for anyone using any `backpropWith` function. * As a consequence of the previous change, `backprop` family of functions in *Explicit* interfaces also all changed argument order. **Breaking change** diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -24,9 +24,9 @@ [ad]: http://hackage.haskell.org/package/ad -Useful for applications in [differential programming][dp] and deep learning for -creating and training numerical models, especially as described in this blog -post on [a purely functional typed approach to trainable models][models]. +Useful for applications in [differentiable programming][dp] and deep learning +for creating and training numerical models, especially as described in this +blog post on [a purely functional typed approach to trainable models][models]. Overall, intended for the implementation of gradient descent and other numeric optimization techniques. Comparable to the python library [autograd][]. @@ -46,7 +46,7 @@ If you want to provide *backprop* for users of your library, see this **[guide to equipping your library with backprop][library]**. -[library]: https://backprop.jle.im/06-equipping-your-library.html +[library]: https://backprop.jle.im/08-equipping-your-library.html MNIST Digit Classifier Example @@ -175,41 +175,88 @@ post][blog] and the [MNIST tutorial][mnist-lhs] (also [rendered as a pdf][mnist-pdf]) -Benchmarks ----------- +Benchmarks and Performance +-------------------------- Here are some basic benchmarks comparing the library's automatic differentiation process to "manual" differentiation by hand. When using the [MNIST tutorial][bench] as an example: -[bench]: https://github.com/mstksg/backprop/blob/master/bench/MNISTBench.hs +[bench]: https://github.com/mstksg/backprop/blob/master/bench/bench.hs -![benchmarks](https://i.imgur.com/9DXUaOI.png) +![benchmarks](https://i.imgur.com/7L5NV4P.png) -* For computing the gradient, there is about a 2.5ms overhead (or about 3.5x) - compared to computing the gradients by hand. Some more profiling and - investigation can be done, since there are two main sources of potential - slow-downs: +Here we compare: - 1. "Inefficient" gradient computations, because of automated - differentiation not being as efficient as what you might get from doing - things by hand and simplifying. This sort of cost is probably not - avoidable. - 2. Overhead incurred by the book-keeping and actual automatic - differentiating system, which involves keeping track of a dependency - graph and propagating gradients backwards in memory. This sort of - overhead is what we would be aiming to reduce. +1. "Manual" differentiation of a 784 x 300 x 100 x 10 fully-connected + feed-forward ANN. +2. Automatic differentiation using *backprop* and the lens-based accessor + interface +3. Automatic differentiation using *backprop* and the "higher-kinded + data"-based pattern matching interface +4. A hybrid approach that manually provides gradients for individual layers + but uses automatic differentiation for chaining the layers together. - It is unclear which one dominates the current slowdown. +We can see that simply *running* the network and functions (using `evalBP`) +incurs virtually zero overhead. This means that library authors could actually +export *only* backprop-lifted functions, and users would be able to use them +without losing any performance. -* However, it may be worth noting that this isn't necessarily a significant - bottleneck. *Updating* the networks using *hmatrix* actually dominates the - runtime of the training. Manual gradient descent takes 3.2ms, so the extra - overhead is about 60%-70%. +As for computing gradients, there exists some associated overhead, from three +main sources. Of these, the building of the computational graph and the +Wengert Tape wind up being negligible. For more information, see [a detailed +look at performance, overhead, and optimization techniques][performance] in the +documentation. -* Running the network (and the backprop-aware functions) incurs virtually - zero overhead (about 4%), meaning that library authors could actually - export backprop-aware functions by default and not lose any performance. +[performance]: https://backprop.jle.im/07-performance.html + +Note that the manual and hybrid modes almost overlap in the range of their +random variances. + +Comparisons +----------- + +*backprop* can be compared and contrasted to many other similar libraries with +some overlap: + +1. The *[ad][]* library (and variants like *[diffhask][]*) support automatic + differentiation, but only for *homogeneous*/*monomorphic* situations. All + values in a computation must be of the same type --- so, your computation + might be the manipulation of `Double`s through a `Double -> Double` + function. + + *backprop* allows you to mix matrices, vectors, doubles, integers, and even + key-value maps as a part of your computation, and they will all be + backpropagated properly with the help of the `Backprop` typeclass. + +2. The *[autograd][]* library is a very close equivalent to *backprop*, + implemented in Python for Python applications. The difference between + *backprop* and *autograd* is mostly the difference between Haskell and + Python --- static types with type inference, purity, etc. + +3. There is a link between *backprop* and deep learning/neural network + libraries like *[tensorflow][]*, *[caffe][]*, and *[theano][]*, which all + all support some form of heterogeneous automatic differentiation. Haskell + libraries doing similar things include *[grenade][]*. + + These are all frameworks for working with neural networks or other + gradient-based optimizations --- they include things like built-in + optimizers, methods to automate training data, built-in models to use out + of the box. *backprop* could be used as a *part* of such a framework, like + I described in my [A Purely Functional Typed Approach to Trainable + Models][models] blog series; however, the *backprop* library itself does + not provide any built in models or optimizers or automated data processing + pipelines. + +[diffhask]: https://hackage.haskell.org/package/diffhask +[tensorflow]: https://www.tensorflow.org/ +[caffe]: http://caffe.berkeleyvision.org/ +[theano]: http://www.deeplearning.net/software/theano/ +[grenade]: http://hackage.haskell.org/package/grenade + +See [documentation][comparisons] for a more detailed look. + +[comparisons]: https://backprop.jle.im/09-comparisons.html Todo ---- diff --git a/backprop.cabal b/backprop.cabal --- a/backprop.cabal +++ b/backprop.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 983ab7f63f7a2d0309dc97c50875836220f6cbd8535600ad8cbbef9fe0672195 +-- hash: a0a5c07fc3725b8c05a80eee56361aced820e46da1abe7c71526e36fdf63e6e8 name: backprop -version: 0.2.3.0 +version: 0.2.4.0 synopsis: Heterogeneous automatic differentation description: Write your functions to compute your result, and the library will automatically generate functions to compute your gradient. @@ -33,7 +33,10 @@ doc/03-manipulating-bvars.md doc/04-the-backprop-typeclass.md doc/05-applications.md - doc/06-equipping-your-library.md + doc/06-manual-gradients.md + doc/07-performance.md + doc/08-equipping-your-library.md + doc/09-comparisons.md doc/index.md README.md renders/backprop-mnist.md @@ -58,6 +61,7 @@ , microlens , primitive , reflection + , simple-reflect , transformers , type-combinators , vector @@ -84,16 +88,13 @@ build-depends: backprop , base >=4.7 && <5 - , bifunctors , criterion , deepseq , directory , hmatrix >=0.18 , lens - , mnist-idx , mwc-random , time - , transformers , vector other-modules: Paths_backprop diff --git a/bench/bench.hs b/bench/bench.hs --- a/bench/bench.hs +++ b/bench/bench.hs @@ -2,96 +2,116 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Control.DeepSeq -import Control.Exception import Control.Lens hiding ((:<), (<.>)) -import Control.Monad.IO.Class -import Control.Monad.Trans.Maybe import Criterion.Main import Criterion.Types -import Data.Bitraversable -import Data.IDX +import Data.Char import Data.Time -import Data.Traversable -import Data.Tuple 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 -import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector as V import qualified Numeric.LinearAlgebra as HM import qualified System.Random.MWC as MWC -data Layer i o = - Layer { _lWeights :: !(L o i) - , _lBiases :: !(R o) +type family HKD f a where + HKD Identity a = a + HKD f a = f a + +data Layer' i o f = + Layer { _lWeights :: !(HKD f (L o i)) + , _lBiases :: !(HKD f (R o)) } - deriving (Show, Generic) + deriving (Generic) +type Layer i o = Layer' i o Identity + +deriving instance (KnownNat i, KnownNat o) => Show (Layer i o) instance NFData (Layer i o) -makeLenses ''Layer +makeLenses ''Layer' -data Network i h1 h2 o = - Net { _nLayer1 :: !(Layer i h1) - , _nLayer2 :: !(Layer h1 h2) - , _nLayer3 :: !(Layer h2 o) +data Network' i h1 h2 o f = + Net { _nLayer1 :: !(HKD f (Layer i h1)) + , _nLayer2 :: !(HKD f (Layer h1 h2)) + , _nLayer3 :: !(HKD f (Layer h2 o )) } - deriving (Show, Generic) - -instance NFData (Network i h1 h2 o) - -makeLenses ''Network - -infixr 8 #>! -(#>!) - :: (KnownNat m, KnownNat n, Reifies s W) - => BVar s (L m n) - -> BVar s (R n) - -> BVar s (R m) -(#>!) = liftOp2 . op2 $ \m v -> - ( m #> v, \g -> (g `outer` v, tr m #> g) ) - + deriving (Generic) -infixr 8 <.>! -(<.>!) - :: (KnownNat n, Reifies s W) - => BVar s (R n) - -> BVar s (R n) - -> BVar s Double -(<.>!) = liftOp2 . op2 $ \x y -> - ( x <.> y, \g -> (konst g * y, x * konst g) - ) +type Network i h1 h2 o = Network' i h1 h2 o Identity -konst' - :: (KnownNat n, Reifies s W) - => BVar s Double - -> BVar s (R n) -konst' = liftOp1 . op1 $ \c -> (konst c, HM.sumElements . extract) +deriving instance (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o) => Show (Network i h1 h2 o) +instance NFData (Network i h1 h2 o) -sumElements :: KnownNat n => R n -> Double -sumElements = HM.sumElements . extract +makeLenses ''Network' -sumElements' - :: (KnownNat n, Reifies s W) - => BVar s (R n) - -> BVar s Double -sumElements' = liftOp1 . op1 $ \x -> (sumElements x, konst) +main :: IO () +main = do + g <- MWC.initialize + . V.fromList + . map (fromIntegral . ord) + $ "hello world" + test0 <- MWC.uniformR @(R 784, R 10) ((0,0),(1,1)) g + net0 <- MWC.uniformR @(Network 784 300 100 10) (-0.5, 0.5) g + t <- getZonedTime + let tstr = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" t + createDirectoryIfMissing True "bench-results" + defaultMainWith defaultConfig + { reportFile = Just $ "bench-results/mnist-bench_" ++ tstr ++ ".html" + , timeLimit = 10 + } [ + bgroup "gradient" + [ let runTest x y = gradNetManual x y net0 + in bench "manual" $ nf (uncurry runTest) test0 + , let runTest x y = gradBP (netErr x y) net0 + in bench "bp-lens" $ nf (uncurry runTest) test0 + , let runTest x y = gradBP (netErrHKD x y) net0 + in bench "bp-hkd" $ nf (uncurry runTest) test0 + , let runTest x y = gradBP (\n' -> netErrHybrid n' y x) net0 + in bench "hybrid" $ nf (uncurry runTest) test0 + ] + , bgroup "descent" + [ let runTest x y = trainStepManual 0.02 x y net0 + in bench "manual" $ nf (uncurry runTest) test0 + , let runTest x y = trainStep 0.02 x y net0 + in bench "bp-lens" $ nf (uncurry runTest) test0 + , let runTest x y = trainStepHKD 0.02 x y net0 + in bench "bp-hkd" $ nf (uncurry runTest) test0 + , let runTest x y = trainStepHybrid 0.02 x y net0 + in bench "hybrid" $ nf (uncurry runTest) test0 + ] + , bgroup "run" + [ let runTest = runNetManual net0 + in bench "manual" $ nf runTest (fst test0) + , let runTest x = evalBP (`runNetwork` x) net0 + in bench "bp-lens" $ nf runTest (fst test0) + , let runTest x = evalBP (`runNetworkHKD` x) net0 + in bench "bp-hkd" $ nf runTest (fst test0) + , let runTest x = evalBP (`runNetHybrid` x) net0 + in bench "hybrid" $ nf runTest (fst test0) + ] + ] -logistic :: Floating a => a -> a -logistic x = 1 / (1 + exp (-x)) -{-# INLINE logistic #-} +-- ------------------------------ +-- - "Backprop" Lens Mode - +-- ------------------------------ runLayer :: (KnownNat i, KnownNat o, Reifies s W) @@ -118,11 +138,15 @@ . runLayer (n ^^. nLayer2) . logistic . runLayer (n ^^. nLayer1) - . constVar + . auto {-# INLINE runNetwork #-} -crossEntropy :: (KnownNat n, Reifies s W) => R n -> BVar s (R n) -> BVar s Double -crossEntropy t r = negate $ log r <.>! constVar t +crossEntropy + :: (KnownNat n, Reifies s W) + => R n + -> BVar s (R n) + -> BVar s Double +crossEntropy t r = negate $ log r <.>! auto t {-# INLINE crossEntropy #-} netErr @@ -144,6 +168,55 @@ trainStep r !x !t !n = n - realToFrac r * gradBP (netErr x t) n {-# INLINE trainStep #-} +-- ------------------------------ +-- - "Backprop" HKD Mode - +-- ------------------------------ + +runLayerHKD + :: (KnownNat i, KnownNat o, Reifies s W) + => BVar s (Layer i o) + -> BVar s (R i) + -> BVar s (R o) +runLayerHKD (splitBV->Layer w b) x = w #>! x + b +{-# INLINE runLayerHKD #-} + +runNetworkHKD + :: (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o, Reifies s W) + => BVar s (Network i h1 h2 o) + -> R i + -> BVar s (R o) +runNetworkHKD (splitBV->Net l1 l2 l3) = softMax + . runLayerHKD l3 + . logistic + . runLayerHKD l2 + . logistic + . runLayerHKD l1 + . auto +{-# INLINE runNetworkHKD #-} + +netErrHKD + :: (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o, Reifies s W) + => R i + -> R o + -> BVar s (Network i h1 h2 o) + -> BVar s Double +netErrHKD x t n = crossEntropy t (runNetworkHKD n x) +{-# INLINE netErrHKD #-} + +trainStepHKD + :: forall i h1 h2 o. (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o) + => Double + -> R i + -> R o + -> Network i h1 h2 o + -> Network i h1 h2 o +trainStepHKD r !x !t !n = n - realToFrac r * gradBP (netErrHKD x t) n +{-# INLINE trainStepHKD #-} + +-- ------------------------------ +-- - "Manual" Mode - +-- ------------------------------ + runLayerManual :: (KnownNat i, KnownNat o) => Layer i o @@ -222,54 +295,142 @@ let gN = gradNetManual x t n in n - (realToFrac r * gN) -main :: IO () -main = MWC.withSystemRandom $ \g -> do - Just test <- loadMNIST "data/t10k-images-idx3-ubyte" "data/t10k-labels-idx1-ubyte" - putStrLn "Loaded data." - net0 <- MWC.uniformR @(Network 784 300 100 9) (-0.5, 0.5) g - createDirectoryIfMissing True "bench-results" - t <- getZonedTime - let test0 = head test - tstr = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" t - defaultMainWith defaultConfig - { reportFile = Just $ "bench-results/mnist-bench_" ++ tstr ++ ".html" - , timeLimit = 10 - } [ - bgroup "gradient" [ - let testManual x y = gradNetManual x y net0 - in bench "manual" $ nf (uncurry testManual) test0 - , let testBP x y = gradBP (netErr x y) net0 - in bench "bp" $ nf (uncurry testBP) test0 - ] - , bgroup "descent" [ - let testManual x y = trainStepManual 0.02 x y net0 - in bench "manual" $ nf (uncurry testManual) test0 - , let testBP x y = trainStep 0.02 x y net0 - in bench "bp" $ nf (uncurry testBP) test0 - ] - , bgroup "run" [ - let testManual = runNetManual net0 - in bench "manual" $ nf testManual (fst test0) - , let testBP x = evalBP (`runNetwork` x) net0 - in bench "bp" $ nf testBP (fst test0) - ] - ] +-- ------------------------------ +-- - "Hybrid" Mode - +-- ------------------------------ -loadMNIST - :: FilePath - -> FilePath - -> IO (Maybe [(R 784, R 9)]) -loadMNIST fpI fpL = runMaybeT $ do - i <- MaybeT $ decodeIDXFile fpI - l <- MaybeT $ decodeIDXLabelsFile fpL - d <- MaybeT . return $ labeledIntData l i - r <- MaybeT . return $ for d (bitraverse mkImage mkLabel . swap) - liftIO . evaluate $ force r - where - mkImage :: VU.Vector Int -> Maybe (R 784) - mkImage = create . VG.convert . VG.map (\i -> fromIntegral i / 255) - mkLabel :: Int -> Maybe (R 9) - mkLabel n = create $ HM.build 9 (\i -> if round i == n then 1 else 0) +layerOp :: (KnownNat i, KnownNat o) => Op '[Layer i o, R i] (R o) +layerOp = op2 $ \(Layer w b) x -> + ( w #> x + b + , \g -> (Layer (g `outer` x) g, tr w #> g) + ) +{-# INLINE layerOp #-} + +logisticOp + :: Floating a + => Op '[a] a +logisticOp = op1 $ \x -> + let lx = logistic x + in (lx, \g -> lx * (1 - lx) * g) +{-# INLINE logisticOp #-} + +softMaxOp + :: KnownNat n + => Op '[R n] (R n) +softMaxOp = op1 $ \x -> + let expx = exp x + tot = sumElements expx + invtot = 1 / tot + res = konst invtot * expx + in ( res + , \g -> res - konst (invtot ** 2) * exp (2 * x) * g + ) +{-# INLINE softMaxOp #-} + +softMaxCrossEntropyOp + :: KnownNat n + => R n + -> Op '[R n] Double +softMaxCrossEntropyOp targ = op1 $ \x -> + let expx = exp x + sm = konst (1 / sumElements expx) * expx + ce = negate $ log sm <.> targ + in ( ce + , \g -> (sm - targ) * konst g + ) +{-# INLINE softMaxCrossEntropyOp #-} + +runNetHybrid + :: (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o, Reifies s W) + => BVar s (Network i h1 h2 o) + -> R i + -> BVar s (R o) +runNetHybrid n = liftOp1 softMaxOp + . liftOp2 layerOp (n ^^. nLayer3) + . liftOp1 logisticOp + . liftOp2 layerOp (n ^^. nLayer2) + . liftOp1 logisticOp + . liftOp2 layerOp (n ^^. nLayer1) + . auto +{-# INLINE runNetHybrid #-} + +netErrHybrid + :: (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o, Reifies s W) + => BVar s (Network i h1 h2 o) + -> R o + -> R i + -> BVar s Double +netErrHybrid n t = liftOp1 (softMaxCrossEntropyOp t) + . liftOp2 layerOp (n ^^. nLayer3) + . liftOp1 logisticOp + . liftOp2 layerOp (n ^^. nLayer2) + . liftOp1 logisticOp + . liftOp2 layerOp (n ^^. nLayer1) + . auto +{-# INLINE netErrHybrid #-} + +trainStepHybrid + :: forall i h1 h2 o. (KnownNat i, KnownNat h1, KnownNat h2, KnownNat o) + => Double + -> R i + -> R o + -> Network i h1 h2 o + -> Network i h1 h2 o +trainStepHybrid r !x !t !n = + let gN = gradBP (\n' -> netErrHybrid n' t x) n + in n - (realToFrac r * gN) +{-# INLINE trainStepHybrid #-} + +-- ------------------------------ +-- - Operations - +-- ------------------------------ + +infixr 8 #>! +(#>!) + :: (KnownNat m, KnownNat n, Reifies s W) + => BVar s (L m n) + -> BVar s (R n) + -> BVar s (R m) +(#>!) = liftOp2 . op2 $ \m v -> + ( m #> v, \g -> (g `outer` v, tr m #> g) ) +{-# INLINE (#>!) #-} + +infixr 8 <.>! +(<.>!) + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s (R n) + -> BVar s Double +(<.>!) = liftOp2 . op2 $ \x y -> + ( x <.> y, \g -> (konst g * y, x * konst g) + ) +{-# INLINE (<.>!) #-} + +konst' + :: (KnownNat n, Reifies s W) + => BVar s Double + -> BVar s (R n) +konst' = liftOp1 . op1 $ \c -> (konst c, HM.sumElements . extract) +{-# INLINE konst' #-} + +sumElements :: KnownNat n => R n -> Double +sumElements = HM.sumElements . extract +{-# INLINE sumElements #-} + +sumElements' + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s Double +sumElements' = liftOp1 . op1 $ \x -> (sumElements x, konst) +{-# INLINE sumElements' #-} + +logistic :: Floating a => a -> a +logistic x = 1 / (1 + exp (-x)) +{-# INLINE logistic #-} + +-- ------------------------------ +-- - Instances - +-- ------------------------------ instance (KnownNat i, KnownNat o) => Num (Layer i o) where Layer w1 b1 + Layer w2 b2 = Layer (w1 + w2) (b1 + b2) diff --git a/doc/01-getting-started.md b/doc/01-getting-started.md --- a/doc/01-getting-started.md +++ b/doc/01-getting-started.md @@ -24,9 +24,9 @@ import qualified Numeric.LinearAlgebra.Static as H ``` -*backprop* is a Haskell library available on hackage, so can be used in your -package however way you like to require libraries. Be sure to add it to your -cabal file's (or package.yaml's) build-depends field. +*backprop* is a Haskell library **[available on hackage][haddock]**, so can be +used in your package however way you like to require libraries. Be sure to add +it to your cabal file's (or package.yaml's) build-depends field. Automatic Backpropagated Functions ---------------------------------- @@ -159,7 +159,9 @@ instance KnownNat n => AskInliterate (R n) where askInliterate = answerWith (show . H.extract) instance AskInliterate Net where - askInliterate = answerWith (unlines . (++ ["-- ..."]) . take 5 . lines . show) + askInliterate = answerWith (unlines . ((++ ["-- ..."]) . map lim) . take 5 . lines . show) + where + lim = (++ " -- ...") . take 200 ``` ```haskell eval diff --git a/doc/03-manipulating-bvars.md b/doc/03-manipulating-bvars.md --- a/doc/03-manipulating-bvars.md +++ b/doc/03-manipulating-bvars.md @@ -19,7 +19,6 @@ import Data.Functor.Identity import GHC.Generics (Generic) import GHC.TypeNats -import Inliterate.Import import Lens.Micro import Lens.Micro.TH import Numeric.Backprop @@ -136,7 +135,14 @@ makeLenses ''Net ``` -Then `^.` from the *lens* or *[microlens][]* packages lets you retrieve a field +or make them manually: + +```haskell top +nBias1' :: Functor f => (R 20 -> f (R 20)) -> Net -> f Net +nBias1' f n = (\b -> n { _nBias1 = b }) <$> f (_nBias1 n) +``` + +then `^.` from the *lens* or *[microlens][]* packages lets you retrieve a field from a `Net`: [microlens]: http://hackage.haskell.org/package/microlens @@ -278,6 +284,9 @@ Now, the `M w1 b1 w2 b2` pattern can be used to deconstruct *both* "normal" `Met`s, as well as a `BVar s Met` (with `splitBV` or `BV`). +Note that this HKD access method is potentially less performant than lens +access (by about 10-20%). + ### Potential or Many Fields Some values "may" or "may not" have values of a given field. An example would @@ -408,6 +417,9 @@ -> BVar s Net -> BVar s Net ``` + +You can also use `(%~~)` or `overVar` to apply a *function* to a specific +inside your value. Prelude Modules --------------- diff --git a/doc/04-the-backprop-typeclass.md b/doc/04-the-backprop-typeclass.md --- a/doc/04-the-backprop-typeclass.md +++ b/doc/04-the-backprop-typeclass.md @@ -39,7 +39,11 @@ `zero` is "zero" in the verb sense -- it takes a value and "zeroes out" all components. For a vector, this means returning a zero vector of the same shape. For a list, this means replacing all of the items with zero and -returning a list of the same length. `one` does the same thing but with one. +returning a list of the same length. + +`one` does the same thing but with one; the point of it is to be `one = gradBP +id` --- the gradient of the identity function for your type. + `add` is used to add together contributions in gradients, and is usually a component-wise addition. diff --git a/doc/05-applications.md b/doc/05-applications.md --- a/doc/05-applications.md +++ b/doc/05-applications.md @@ -41,8 +41,10 @@ all you need to know to use the library is in the **[haddocks on hackage][haddock]**. -However, if you are a library writer who wants to offer your users the ability -to backpropagate your library functions, let's move on to the **[library -maintainer's guide to equipping your library with backprop][equipping]**! +Check out the sidebar for more technical details on [writing manual +gradients][manual-gradients], [optimization and performance][performance], and +[equipping your library for backprop][equipping]! -[equipping]: https://backprop.jle.im/06-equipping-your-library.html +[manual-gradients]: https://backprop.jle.im/06-manual-gradients.html +[performance]: https://backprop.jle.im/07-performance.html +[equipping]: https://backprop.jle.im/08-equipping-your-library.html diff --git a/doc/06-equipping-your-library.md b/doc/06-equipping-your-library.md deleted file mode 100644 --- a/doc/06-equipping-your-library.md +++ /dev/null @@ -1,776 +0,0 @@ ---- -title: Equipping your Library ---- - -Equipping your Library for Backprop -=================================== - -```haskell top hide -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} - - -import Data.Functor.Identity -import qualified Data.List -import GHC.Generics (Generic) -import GHC.TypeNats -import Inliterate.Import -import Lens.Micro -import Lens.Micro.TH -import Numeric.Backprop -import Numeric.Backprop.Class -import Numeric.LinearAlgebra.Static (L, R, konst) -import System.Random -import qualified Data.Vector as V -import qualified Numeric.LinearAlgebra.Static as H -import qualified Numeric.LinearAlgebra as HU -``` - -So you want your users to be able to use your numerical library with -*backprop*, huh? - -This page is specifically for library authors who want to allow their users to -use their library operations and API with *backprop*. End-users of the -*backprop* library should not have to worry about the contents of this page. - -Equipping your library with backprop involves providing "backprop-aware" -versions of your library functions. *In fact*, it is possible to make a -library fully by providing *only* backprop versions of your functions, since -you can use a backprop-aware function as a normal function with `evalBP`. -Alternatively, you can re-export all of your functions in a separate module with -"backprop-aware" versions. - -Know Thy Types --------------- - -The most significant effort will be in lifting your library's functions. If -you have a function: - -```haskell -myFunc :: a -> b -``` - -Then its lifted version would have type: - -```haskell -myFunc :: Reifies s W => BVar s a -> BVar s b -``` - -That is, instead of a function directly taking an `a` and returning a `b`, it's -a function taking a `BVar` containing an `a`, and returning a `BVar` containing -a `b`. - -Functions taking multiple arguments can be translated pretty straightforwardly: - -```haskell -func1 :: a -> b -> c -func1BP :: Reifies s W => BVar s a -> BVar s b -> BVar s c -``` - -And also functions returning multiple arguments: - -```haskell -func2 :: a -> ( b, c) -func2BP :: Reifies s W => BVar s a -> (BVar s b, BVar s c) -``` - -It is recommended (for ease of use with `-XTypeApplications`) that `Reifies s -W` be the *final* constraint in all code you write. - -Note that almost all operations involving `BVar`'d items require that the -contents have a `Backprop` instance. Alternative API's to backprop that -require `Num` instances instead (or explicitly specified addition functions) -are available in *Numeric.Backprop.Num* and *Numeric.Backprop.Explicit*. - -The Easy Way ------------- - -`BVar` based functions are just normal functions, so they can be applied -normally and passed as first-class values. If possible, if you can *utilize* -functions that are already `BVar`'d/lifted, then you can just define your API -in terms of those lifted functions. This is also how *users* are expected to -be able to use your library: just use the lifted functions you provide, in -order to make their own lifted functions using normal function application and -composition. - -However, if no lifted primitive functions are available, then you do have to do -some legwork to provide information on gradient computation for your types. -Ideally, you would only need to do this for some minimal set of your -operations, and then define the rest of them in terms of the functions you have -already lifted. - -Lifting operations manually ---------------------------- - -A `BVar s a -> BVar s b` really encodes two things: - -1. A `a -> b` (the actual function) -2. A `a -> b -> a` (the "scaled gradient" function) - -The documentation for [Numeric.Backprop.Op][op] gives detail about what these -entail, with rendered math and examples. - -[op]: http://hackage.haskell.org/package/backprop/docs/Numeric-Backprop-Op.html - -The second function requires some elaboration. Let's say you are writing a -lifted version of your function \\(y = f(x)\\) (whose derivative is -\\(\frac{dy}{dx}\\)), and that your *final result* at the end of your computation -is \\(z = g(f(x))\\) (whose derivative is \\(\frac{dz}{dx}\\)). In that case, because of the -chain rule, \\(\frac{dz}{dx} = \frac{dz}{dy} \frac{dy}{dx}\\). - -The scaled gradient is the function which, *given* \\(\frac{dy}{dz}\\), *returns* -\\(\frac{dz}{dx}\\). (that is, returns \\(\frac{dz}{dy} \frac{dy}{dx}\\)). - -For example, for the mathematical operation \\(y = f(x) = x^2\\), then, considering -\\(z = g(f(x))\\), \\(\frac{dz}{dx} = \frac{dz}{dy} 2x\\). -In fact, for all functions taking and returning scalars (just normal single -numbers), \\(\frac{dz}{dx} = \frac{dz}{dy} f'(x)\\). - -With that in mind, let's write our "squared" op: - -```haskell top -square - :: (Num a, Backprop a, Reifies s W) - => BVar s a - -> BVar s a -square = liftOp1 . op1 $ \x -> - ( x^2 , \dzdy -> dzdy * 2 * x) --- ^- actual result ^- scaled gradient function -``` - -Keeping along the same pattern, for \\(y = f(x) = \sin(x)\\), then, considering \\(z -= g(f(x))\\), \\(\frac{dz}{dx} = \frac{dz}{dy} \cos(x)\\). So, we have: - -```haskell top -liftedSin - :: (Floating a, Backprop a, Reifies s W) - => BVar s a - -> BVar s a -liftedSin = liftOp1 . op1 $ \x -> - ( sin x, \dzdy -> dzdy * cos x ) -``` - -In general, for functions that take and return scalars: - -```haskell -liftedF - :: (Reifies s W, Backprop a, Num a) - => BVar s a - -> BVar s a -liftedF = liftOp1 . op1 $ \x -> - ( f x, \dzdy -> dzdy * dfdx x ) -``` - -For an example of every single numeric function in base Haskell, see [the -source of Op.hs][opsource] for the `Op` definitions for every method in `Num`, -`Fractional`, and `Floating`. - -[opsource]: https://github.com/mstksg/backprop/blob/a7651b4549048a3aca73c79c6fbe07c3e8ee500e/src/Numeric/Backprop/Op.hs#L646-L787 - -### Non-trivial example - -A simple non-trivial example is `sumElements`, which we can define to take the -*hmatrix* library's `R n` type (an n-vector of `Double`). In this case, we -have to think about \\(g(\mathrm{sum}(\mathbf{x}))\\). In this case, the types -guide our thinking: - -```haskell -sumElements :: R n -> Double -sumElementsScaledGrad :: R n -> Double -> R n -``` - -The simplest way for me to do this personally is to just take it element by -element. - -1. *Write out the functions in question, in a simple example* - - In our case: - - * \\(y = f(\langle a, b, c \rangle) = a + b + c\\) - * \\(z = g(y) = g(a + b + c)\\) - -2. *Identify the components in your gradient* - - In our case, we have to return a gradient \\(\langle \frac{\partial z}{\partial a}, - \frac{\partial z}{\partial b}, \frac{\partial z}{\partial c} \rangle\\). - -3. *Work out each component of the gradient until you start to notice a - pattern* - - Let's start with \\(\frac{\partial z}{\partial a}\\). We need to find - \\(\frac{\partial z}{\partial a}\\) in terms of \\(\frac{dz}{dy}\\): - - * Through the chain rule, \\(\frac{\partial z}{\partial a} = - \frac{dz}{dy} \frac{\partial y}{\partial a}\\). - * Because \\(y = a + b + c\\), we know that \\(\frac{\partial y}{\partial - a} = 1\\). - * Because \\(\frac{\partial y}{\partial a} = 1\\), we know that - \\(\frac{\partial z}{\partial a} = \frac{dz}{dy} \times 1 = - \frac{dz}{dy}\\). - - So, our expression of \\(\frac{\partial z}{\partial a}\\) in terms of - \\(\frac{dz}{dy}\\) is simple -- it's simply \\(\frac{\partial z}{\partial - a} = \frac{dz}{dy}\\). - - Now, let's look at \\(\frac{\partial z}{\partial b}\\). We need to find - \\(\frac{\partial z}{\partial b}\\) in terms of \\(\frac{dz}{dy}\\). - - * Through the chain rule, \\(\frac{\partial z}{\partial b} = - \frac{dz}{dy} \frac{\partial y}{\partial b}\\). - * Because \\(y = a + b + c\\), we know that \\(\frac{\partial y}{\partial - b} = 1\\). - * Because \\(\frac{\partial y}{\partial b} = 1\\), we know that - \\(\frac{\partial z}{\partial b} = \frac{dz}{dy} \times 1 = - \frac{dz}{dy}\\). - - It looks like \\(\frac{\partial z}{\partial b} = \frac{\partial z}{\partial - y}\\), as well. - - At this point, we start to notice a pattern. We can apply the same logic - to see that \\(\frac{\partial z}{\partial c} = \frac{dz}{dy}\\). - -4. *Write out the pattern* - - Extrapolating the pattern, \\(\frac{\partial z}{\partial q}\\), where - \\(q\\) is *any* component, is always going to be a constant -- - \\(\frac{dz}{dy}\\). - -So in the end: - -```haskell top hide -instance Backprop (R n) where - zero = zeroNum - add = addNum - one = oneNum - -instance (KnownNat n, KnownNat m) => Backprop (L n m) where - zero = zeroNum - add = addNum - one = oneNum - -sumElements :: KnownNat n => R n -> Double -sumElements = HU.sumElements . H.extract -``` - -```haskell top -liftedSumElements - :: (KnownNat n, Reifies s W) - => BVar s (R n) - -> BVar s Double -liftedSumElements = liftOp1 . op1 $ \xs -> - ( sumElements xs, \dzdy -> konst dzdy ) -- a constant vector -``` - -### Multiple-argument functions - -Lifting multiple-argument functions is the same thing, except using `liftOp2` -and `op2`, or `liftOpN` and `opN`. - -A `BVar s a -> BVar s b -> BVar s c` encodes two things: - -1. The actual `a -> b -> c` -2. The scaled gradient, `a -> b -> c -> (a, b)`. - -The `c` parameter of the scaled gradient is again \\(\frac{dz}{dy}\\), and the -final `(a,b)` is a tuple of \\(\frac{\partial z}{\partial x_1}\\) and -\\(\frac{\partial z}{\partial x_2}\\): how \\(\frac{dz}{dy}\\) affects both of -the inputs. - -For a simple example, let's look at \\(x + y\\). Working it out: - -* \\(y = f(x_1, x_2) = x_1 + x_2\\) -* \\(z = g(f(x_1, x_2)) = g(x_1 + x_2)\\) -* Looking first for \\(\frac{\partial z}{\partial x_1}\\) in terms of - \\(\frac{dz}{dy}\\): - * \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \frac{\partial - y}{\partial x_1}\\) (chain rule) - * From \\(y = x_1 + x_2\\), we see that \\(\frac{\partial y}{\partial - x_1} = 1\\) - * Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \times 1 - = \frac{dz}{dy}\\). -* Looking second for \\(\frac{\partial z}{\partial x_2}\\) in terms of - \\(\frac{dz}{dy}\\): - * \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy} \frac{\partial - y}{\partial x_2}\\) (chain rule) - * From \\(y = x_1 + x_2\\), we see that \\(\frac{\partial y}{\partial - x_2} = 1\\) - * Therefore, \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy} \times 1 - = \frac{dz}{dy}\\). -* Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy}\\), and also - \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy}\\). - -Putting it into code: - -```haskell top -add :: (Num a, Backprop a, Reifies s W) - => BVar s a - -> BVar s a - -> BVar s a -add = liftOp2 . op2 $ \x1 x2 -> - ( x1 + x2, \dzdy -> (dzdy, dzdy) ) -``` - -Let's try our hand at multiplication, or \\(x * y\\): - -* \\(y = f(x_1, x_2) = x_1 x_2\\) -* \\(z = g(f(x_1, x_2)) = g(x_1 x_2)\\) -* Looking first for \\(\frac{d\partial }{d\partial _1}\\) in terms of - \\(\frac{dz}{dy}\\): - * \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \frac{\partial - y}{\partial x_1}\\) (chain rule) - * From \\(y = x_1 x_2\\), we see that \\(\frac{\partial y}{\partial x_1} - = x_2\\) - * Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} x_2\\). -* Looking second for \\(\frac{\partial z}{\partial x_2}\\) in terms of - \\(\frac{dz}{dy}\\): - * \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \frac{\partial - y}{\partial x_1}\\) (chain rule) - * From \\(y = x_1 x_2\\), we see that \\(\frac{\partial y}{\partial x_2} - = x_1\\) - * Therefore, \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy} x_1\\). -* Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} x_2\\), and - \\(\frac{\partial z}{\partial x_2} = x_1 \frac{dz}{dy}\\). - -In code: - -```haskell top -mul :: (Num a, Backprop a, Reifies s W) - => BVar s a - -> BVar s a - -> BVar s a -mul = liftOp2 . op2 $ \x1 x2 -> - ( x1 * x2, \dzdy -> (dzdy * x2, x1 * dzdy) ) -``` - -For non-trivial examples involving linear algebra, see the source for the *[hmatrix-backprop][]* library. - -[hmatrix-backprop]: http://hackage.haskell.org/package/hmatrix-backprop - -Some examples, for the dot product between two vectors and for matrix-vector -multiplication: - -```haskell top --- import qualified Numeric.LinearAlgebra.Static as H - --- | dot product between two vectors -dot - :: (KnownNat n, Reifies s W) - => BVar s (R n) - -> BVar s (R n) - -> BVar s Double -dot = liftOp2 . op2 $ \u v -> - ( u `H.dot` v - , \dzdy -> (H.konst dzdy * v, u * H.konst dzdy) - ) - - --- | matrix-vector multiplication -(#>) - :: (KnownNat m, KnownNat n, Reifies s W) - => BVar s (L m n) - -> BVar s (R n) - -> BVar s (R m) -(#>) = liftOp2 . op2 $ \mat vec -> - ( mat H.#> vec - , \dzdy -> (dzdy `H.outer` vec, H.tr mat H.#> dzdy) - ) -``` - -### Returning multiple items - -You can return tuples inside `BVar`s: - -```haskell top -splitAt - :: (Backprop a, Reifies s W) - => Int - -> BVar s [a] - -> BVar s ([a], [a]) -splitAt n = liftOp1 . op1 $ \xs -> - let (ys, zs) = Data.List.splitAt n xs - in ((ys, zs), \(dys,dzs) -> dys ++ dzs) - -- assumes dys and dzs have the same lengths as ys and zs -``` - -This works as expected. However, it is recommended, for the benefit of your -users, that you return a tuple of `BVar`s instead of a `BVar` of tuples: - -```haskell top -splitAt' - :: (Backprop a, Reifies s W) - => Int - -> BVar s [a] - -> (BVar s [a], BVar s [a]) -splitAt' n xs = (yszs ^^. _1, yszs ^^. _2) - where - yszs = liftOp1 (op1 $ \xs' -> - let (ys, zs) = Data.List.splitAt n xs' - in ((ys, zs), \(dys,dzs) -> dys ++ dzs) - ) xs -``` - -using `_1` and `_2` from the *[microlens][]* or *[lens][]* packages. This -might also be cleaner if you take advantage of the `T2` or `T3` pattern -synonyms: - -[microlens]: http://hackage.haskell.org/package/microlens -[lens]: http://hackage.haskell.org/package/lens - -```haskell top -splitAt'' - :: (Backprop a, Reifies s W) - => Int - -> BVar s [a] - -> (BVar s [a], BVar s [a]) -splitAt'' n xs = (ys, zs) - where - T2 ys zs = liftOp1 (op1 $ \xs' -> - let (ys, zs) = Data.List.splitAt n xs' - in ((ys, zs), \(dys,dzs) -> dys ++ dzs) - ) xs -``` - -### Isomorphisms - -If your function witnesses an isomorphism, there are handy combinators for -making this easy to write. This is especially useful in the case of data -constructors: - -```haskell top -newtype Foo = MkFoo { getFoo :: Double } - deriving Generic - -instance Backprop Foo - -mkFoo - :: Reifies s W - => BVar s Double - -> BVar s Foo -mkFoo = isoVar MkFoo getFoo - -data Bar = MkBar { bar1 :: Double, bar2 :: Float } - deriving Generic - -instance Backprop Bar - -mkBar - :: Reifies s W - => BVar s Double - -> BVar s Float - -> BVar s Bar -mkBar = isoVar2 MkBar (\b -> (bar1 b, bar2 b)) -``` - -Note also that if you have a newtype with one constructor (or any other two -`Coercible` types), you can simply use `coerceVar`: - -```haskell top -mkFoo' - :: BVar s Double - -> BVar s Foo -mkFoo' = coerceVar -- requires no `Reifies s W` constraint -``` - -### NoGrad - -If you do decide to go to the extreme, and provide *only* a BVar-based -interface to your library (and no non-BVar based one), then you might have a -situation where you have a function where you cannot define the gradient -- -maybe no gradient exists, or you haven't put in the time to write one. In this -case, you can use `noGrad` and `noGrad1`: - -```haskell top -negateNoGrad - :: (Num a, Backprop a, Reifies s W) - => BVar s a - -> BVar s a -negateNoGrad = liftOp1 (noGrad1 negate) -``` - -This function can still be used with `evalBP` to get the correct answer. It -can even be used with `gradBP` if the result is never used in the final answer. - -However, if it *is* used in the final answer, then computing the gradient will -throw a runtime exception. - -Be sure to warn your users! Like any partial function, this is not recommended -unless in extreme circumstances. - -Monadic Operations ------------------- - -This should all work if your operations are all "pure". However, what about -the cases where your operations have to be performed in some Applicative or -Monadic context? - -For example, what if `add :: X -> X -> IO X` ? - -One option you can do is to newtype-wrap your operations, and then give those a -backprop instance: - -```haskell top hide -data X - -zeroForX :: X -> X -zeroForX = undefined -addForX :: X -> X -> IO X -addForX = undefined -oneForX :: X -> X -oneForX = undefined -``` - -```haskell top -newtype IOX = IOX (IO X) - -instance Backprop IOX where - zero (IOX x) = IOX (fmap zeroForX x) - -- or, depending on the type of `zeroForX`: - -- zero (IOX x) = IOX (zeroForX =<< x) - - add (IOX x) (IOX y) = IOX $ do - x' <- x - y' <- y - addForX x' y' - - one (IOX x) = IOX (fmap oneForX x) -``` - -And you can define your functions in terms of this: - -```haskell top -addX - :: Reifies s W - => BVar s IOX - -> BVar s IOX - -> BVar s IOX -addX = liftOp2 . op2 $ \(IOX x) (IOX y) -> - ( IOX (do x' <- x; y' <- y; addForX x' y') - , \dzdy -> (dzdy, dzdy) - ) -``` - -This should work fine as long as you never "branch" on any *results* of your -actions. You must not ever need to peek inside the *results* of the action in -order to decide *what* operations to do next. In other words, this works if -the operations you need to perform are all known and fixed before-hand, before -any actions are performed. So, this means no access to the `Eq` or `Ord` -instances of BVars (unless your monad has `Eq` or `Ord` instances defined). - -A newtype wrapper is provided to give you this behavior automatically -- it's -`ABP`, from *Numeric.Backprop* and *Numeric.Backprop.Class*. - -```haskell -type IOX = ABP IO X -``` - -However, this will not work if you need to do things like compare contents, -etc. to decide what operations to use. - -At the moment, this is not supported. Please open an issue if this becomes an -issue! - -Supporting Data Types ---------------------- - -Your library will probably have data types that you expect your users to use. -To equip your data types for backpropagation, you can take a few steps. - -### Backprop Class - -First of all, all of your library's types should have instances of the -[`Backprop` typeclass][class]. This allows values of your type to be used in -backpropagatable functions. See the [Backprop typeclass section][tcdocs] of -this documentation for more information on writing a `Backprop` instance for -your types. - -[class]: https://hackage.haskell.org/package/backprop/docs/Numeric-Backprop-Class.html -[tcdocs]: https://backprop.jle.im/04-the-backprop-typeclass.html - -In short: - -1. If your type is a type with a single constructor whose fields are all - instances of `Backprop`, you can just write `instance Backprop MyType`, and - the instance is generated automatically (as long as your type has a - `Generic` instance) - - ```haskell top - data MyType = MkMyType Double [Float] (R 10) (L 20 10) (V.Vector Double) - deriving Generic - - instance Backprop MyType - ``` - -2. If your type is an instance of `Num`, you can use `zeroNum`, `addNum`, and - `oneNum` to get free definitions of the typeclass methods. - - ```haskell - instance Backprop Double where - zero = zeroNum - add = addNum - one = oneNum - ``` - -3. If your type is made using a `Functor` instance, you can use `zeroFunctor` - and `oneFunctor`: - - ```haskell - instance Backprop a => Backprop (V.Vector a) where - zero = zeroFunctor - add = undefined -- ?? - one = oneFunctor - ``` - -4. If your type has an `IsList` instance, you can use `addIsList`: - - ```haskell - instance Backprop a => Backprop (V.Vector a) where - zero = zeroFunctor - add = addIsList - one = oneFunctor - ``` - -For more details, see the [aforementioned documentation][tcdocs] or the [actual -typeclass haddock documentation][class]. - -### Accessors - -If you have product types, users should be able to access values inside `BVar`s -of your data type. There are two main ways to provide access: the lens-based -interface and the higher-kinded-data-based interface. - -The lens-based interface gives your users "getter" and "setter" functions for -fields, and the higher-kinded-data-based interface lets your users pattern -match on your data type's original constructor to get fields and construct -values. - -#### Lens-Based Interface - -If you are defining a product type, like - -```haskell top -data MyType = MT { _mtDouble :: Double - , _mtInt :: Int - , _mtDoubles :: [Double] - } -``` - -Users who have a `BVar s MyType` can't normally access the fields inside, -because you can't directly pattern match normally, and the record accessors -are `MyType -> Int` (unlifted). As a library maintainer, you can provide them -*lenses* to the fields, either generated automatically using the *[lens][]* or -*[microlens-th][]* packages: - -[lens]: http://hackage.haskell.org/package/lens -[microlens-th]: http://hackage.haskell.org/package/microlens-th - -```haskell top -makeLenses ''MyType -``` - -or manually by hand: - -```haskell top -mtInt' :: Functor f => (Int -> f Int) -> MyType -> f MyType -mtInt' f mt = (\i -> mt { _mtInt = i }) <$> f (_mtInt mt) -``` - -Now, users can use `^.` or `view` from the *lens* or *[microlens][]* packages -to retrieve your fields: - -[microlens]: http://hackage.haskell.org/package/microlens - -```haskell -(^. mtDouble) :: MyType -> Double -``` - -And `(^^.)` and `viewVar` from *backprop* to retrieve fields from a `BVar`: - -```haskell -(^^. mtDouble) :: BVar s MyType -> BVar s Double -``` - -They can also use `set` or `.~` to modify fields, and `setVar` and `.~~` to -modify and "set" fields in a `BVar`: - -```haskell -set mtDouble :: Double -> MyType -> MyType -setVar mtDouble :: BVar s Double -> BVar s MyType -> BVar s MyType -``` - -#### Higher-Kinded Data Interface - -The alternative "Higher-Kinded Data" technique, inspired by [this -article][hkd], allows your users to directly pattern match on `BVar`s of your -types to get their contents. - -[hkd]: http://reasonablypolymorphic.com/blog/higher-kinded-data/ - -Doing this requires modifying the definition of your data types slightly. -Instead of `MyType` above, we can make a type family that can be re-used for -all of your data types: - -```haskell top -type family HKD f a where - HKD Identity a = a - HKD f a = f a -``` - -and define your data types in terms of this type family (remembering to derive -`Generic`): - -```haskell top -data MyType2' f = MT2 { mt2Double :: HKD f Double - , mt2Int :: HKD f Int - , mt2Doubles :: HKD f [Double] - } - deriving Generic -``` - -Now your original data type can be recovered with `MyType2' Identity`, and can -be pattern matched directly in the same way as the original type (the -`Identity` disappears): - -```haskell top -type MyType2 = MyType2' Identity - -deriving instance Show MyType2 -instance Backprop MyType2 - -getMT2Double :: MyType2 -> Double -getMT2Double (MT2 d _ _) = d -``` - -But now, users can *pattern match* on a `BVar s MyType2` to get `BVar`s of the -contents, with `splitBV` or the `BV` pattern synonym: - -```haskell top -getMT2DoubleBVar - :: Reifies s W - => BVar s MyType2 - -> BVar s Double -getMT2DoubleBVar (splitBV -> MT2 d _ _) = d -``` - -Under `splitBV`, your users can pattern match on the `MT2` constructor and get -the contents as `BVar`s. - -Users can also use `joinBV` (or the `BV` pattern synonym in constructor mode) -to re-construct a `BVar` of `MyType2` in terms of `BVar`s of its contents using -the `MT2` constructor: - -```haskell top -makeMyType2 - :: Reifies s W - => BVar s Double - -> BVar s Int - -> BVar s [Double] - -> BVar s MyType2 -makeMyType2 d i ds = joinBV $ MT2 d i ds -``` - diff --git a/doc/06-manual-gradients.md b/doc/06-manual-gradients.md new file mode 100644 --- /dev/null +++ b/doc/06-manual-gradients.md @@ -0,0 +1,382 @@ +--- +title: Manual Gradients +--- + +Providing Hand-Written Gradients +================================ + +```haskell top hide +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + + +import Data.Functor.Identity +import qualified Data.List +import GHC.Generics (Generic) +import GHC.TypeNats +import Inliterate.Import +import Lens.Micro +import Lens.Micro.TH +import Numeric.Backprop +import Numeric.Backprop.Class +import Numeric.LinearAlgebra.Static (L, R, konst) +import System.Random +import qualified Data.Vector as V +import qualified Numeric.LinearAlgebra.Static as H +import qualified Numeric.LinearAlgebra as HU +``` + +Providing and writing hand-written gradients for operations can be useful if +you are [peforming low-level optimizations][performance] or [equipping your +library for backprop][equipping]. + +[performance]: https://backprop.jle.im/07-performance.html +[equipping]: https://backprop.jle.im/08-equipping-your-library.html + +Ideally, as an *end user*, you should never have to do this. The whole point +of the *backprop* library is to allow you to use backpropagatable functions as +normal functions, and to let you build complicated functions by simply +composing normal Haskell functions, where the *backprop* library automatically +infers your gradients. + +However, if you are writing a library, you probably need to provide "primitive" +backpropagatable functions (like matrix-vector multiplication for a linear +algebra library) for your users, so your users can then use those primitive +functions to write their own code, without ever having to be aware of any +gradients. + +If you are writing code and recognize some bottlenecks related to library +overhead as [described in this post][performance], then you might also want to +provide manual gradients as a last resort. However, this should always be a +last resort, as *figuring out* manual gradients is a tedious and error-prone +process that can introduce subtle bugs in ways that don't always appear in +testing. It also makes your code much more fragile and difficult to refactor +and shuffle around (since you aren't using normal function composition and +application anymore) and much harder to read. Only proceed if you decide that +the huge cognitive costs are worth it. + +The Lifted Function +------------------- + +A lifted function of type + +```haskell +myFunc :: Reifies s W => BVar s a -> BVar s b +``` + +represents a backpropagatble function taking an `a` and returning a `b`. It is +represented as a function taking a `BVar` containing an `a` and returning a +`BVar` containing a `b`; the `BVar s` with the `Reifies s W` is what allows for +tracking of backpropagation. + +A `BVar s a -> BVar s b` is really, actually, under the hood: + +```haskell +type BVar s a -> BVar s b + = a -> (b, b -> a) +``` + +That is, given an input `a`, you get: + +1. A `b`, the result (the "forward pass") +2. A `b -> a`, the "scaled gradient" function. + +A full technical description is given in the documentation for [Numeric.Backprop.Op][op]. + +[op]: http://hackage.haskell.org/package/backprop/docs/Numeric-Backprop-Op.html + +The `b` result is simple enough; it's the result of your function. The "scaled +gradient" function requires some elaboration. Let's say you are writing a +lifted version of your function \\(y = f(x)\\) (whose derivative is +\\(\frac{dy}{dx}\\)), and that your *final result* at the end of your +computation is \\(z = g(f(x))\\) (whose derivative is \\(\frac{dz}{dx}\\)). In +that case, because of the chain rule, \\(\frac{dz}{dx} = \frac{dz}{dy} +\frac{dy}{dx}\\). + +The scaled gradient `b -> a` is the function which, *given* +\\(\frac{dy}{dz}\\) `:: b`, *returns* \\(\frac{dz}{dx}\\) `:: a`. (that is, +returns \\(\frac{dz}{dy} \frac{dy}{dx}\\) `:: a`). + +For example, for the mathematical operation \\(y = f(x) = x^2\\), then, +considering \\(z = g(f(x))\\), \\(\frac{dz}{dx} = \frac{dz}{dy} 2x\\). In fact, +for all functions taking and returning scalars (just normal single numbers), +\\(\frac{dz}{dx} = \frac{dz}{dy} f'(x)\\). + +Simple Example +-------------- + +With that in mind, let's a lifted "squared" operation, that takes `x` and +returns `x^2`: + +```haskell top +square + :: (Num a, Backprop a, Reifies s W) + => BVar s a + -> BVar s a +square = liftOp1 . op1 $ \x -> + ( x^2 , \dzdy -> dzdy * 2 * x) +-- ^- actual result ^- scaled gradient function +``` + +We can write one for `sin`, as well. For \\(y = f(x) = \sin(x)\\), we consider +\\(z = g(f(x))\\) to see \\(\frac{dz}{dx} = \frac{dz}{dy} \cos(x)\\). So, we +have: + +```haskell top +liftedSin + :: (Floating a, Backprop a, Reifies s W) + => BVar s a + -> BVar s a +liftedSin = liftOp1 . op1 $ \x -> + ( sin x, \dzdy -> dzdy * cos x ) +``` + +In general, for functions that take and return scalars: + +```haskell +liftedF + :: (Num a, Backprop a, Reifies s W) + => BVar s a + -> BVar s a +liftedF = liftOp1 . op1 $ \x -> + ( f x, \dzdy -> dzdy * dfdx x ) +``` + +For an example of every single numeric function in base Haskell, see [the +source of Op.hs][opsource] for the `Op` definitions for every method in `Num`, +`Fractional`, and `Floating`. + +[opsource]: https://github.com/mstksg/backprop/blob/a7651b4549048a3aca73c79c6fbe07c3e8ee500e/src/Numeric/Backprop/Op.hs#L646-L787 + +Non-trivial example +------------------- + +A simple non-trivial example is `sumElements`, which we can define to take the +*hmatrix* library's `R n` type (an n-vector of `Double`). In this case, we +have to think about \\(g(\mathrm{sum}(\mathbf{x}))\\). In this case, the types +guide our thinking: + +```haskell +sumElements :: R n -> Double +sumElementsScaledGrad :: R n -> Double -> R n +``` + +The simplest way for me to do this personally is to just take it element by +element. + +1. *Write out the functions in question, in a simple example* + + In our case: + + * \\(y = f(\langle a, b, c \rangle) = a + b + c\\) + * \\(z = g(y) = g(a + b + c)\\) + +2. *Identify the components in your gradient* + + In our case, we have to return a gradient \\(\langle \frac{\partial z}{\partial a}, + \frac{\partial z}{\partial b}, \frac{\partial z}{\partial c} \rangle\\). + +3. *Work out each component of the gradient until you start to notice a + pattern* + + Let's start with \\(\frac{\partial z}{\partial a}\\). We need to find + \\(\frac{\partial z}{\partial a}\\) in terms of \\(\frac{dz}{dy}\\): + + * Through the chain rule, \\(\frac{\partial z}{\partial a} = + \frac{dz}{dy} \frac{\partial y}{\partial a}\\). + * Because \\(y = a + b + c\\), we know that \\(\frac{\partial y}{\partial + a} = 1\\). + * Because \\(\frac{\partial y}{\partial a} = 1\\), we know that + \\(\frac{\partial z}{\partial a} = \frac{dz}{dy} \times 1 = + \frac{dz}{dy}\\). + + So, our expression of \\(\frac{\partial z}{\partial a}\\) in terms of + \\(\frac{dz}{dy}\\) is simple -- it's simply \\(\frac{\partial z}{\partial + a} = \frac{dz}{dy}\\). + + Now, let's look at \\(\frac{\partial z}{\partial b}\\). We need to find + \\(\frac{\partial z}{\partial b}\\) in terms of \\(\frac{dz}{dy}\\). + + * Through the chain rule, \\(\frac{\partial z}{\partial b} = + \frac{dz}{dy} \frac{\partial y}{\partial b}\\). + * Because \\(y = a + b + c\\), we know that \\(\frac{\partial y}{\partial + b} = 1\\). + * Because \\(\frac{\partial y}{\partial b} = 1\\), we know that + \\(\frac{\partial z}{\partial b} = \frac{dz}{dy} \times 1 = + \frac{dz}{dy}\\). + + It looks like \\(\frac{\partial z}{\partial b} = \frac{\partial z}{\partial + y}\\), as well. + + At this point, we start to notice a pattern. We can apply the same logic + to see that \\(\frac{\partial z}{\partial c} = \frac{dz}{dy}\\). + +4. *Write out the pattern* + + Extrapolating the pattern, \\(\frac{\partial z}{\partial q}\\), where + \\(q\\) is *any* component, is always going to be a constant -- + \\(\frac{dz}{dy}\\). + +So in the end: + +```haskell top hide +instance Backprop (R n) where + zero = zeroNum + add = addNum + one = oneNum + +instance (KnownNat n, KnownNat m) => Backprop (L n m) where + zero = zeroNum + add = addNum + one = oneNum + +sumElements :: KnownNat n => R n -> Double +sumElements = HU.sumElements . H.extract +``` + +```haskell top +liftedSumElements + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s Double +liftedSumElements = liftOp1 . op1 $ \xs -> + ( sumElements xs, \dzdy -> konst dzdy ) -- a constant vector +``` + +### Multiple-argument functions + +Lifting multiple-argument functions is the same thing, except using `liftOp2` +and `op2`, or `liftOpN` and `opN`. + +A `BVar s a -> BVar s b -> BVar s c` is, really, under the hood: + +```haskell +type BVar s a -> BVar s b -> BVar s c = + a -> b -> (c, c -> (a, b)) +``` + +That is, given an input `a` and `b`, you get: + +1. A `c`, the result (the "forward pass") +2. A `c -> (a, b)`, the "scaled gradient" function returning the gradient of + both inputs. + +The `c` parameter of the scaled gradient is again \\(\frac{dz}{dy}\\), and the +final `(a,b)` is a tuple of \\(\frac{\partial z}{\partial x_1}\\) and +\\(\frac{\partial z}{\partial x_2}\\): how \\(\frac{dz}{dy}\\) affects both of +the inputs. + +For a simple example, let's look at \\(x + y\\). Working it out: + +* \\(y = f(x_1, x_2) = x_1 + x_2\\) +* \\(z = g(f(x_1, x_2)) = g(x_1 + x_2)\\) +* Looking first for \\(\frac{\partial z}{\partial x_1}\\) in terms of + \\(\frac{dz}{dy}\\): + * \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \frac{\partial + y}{\partial x_1}\\) (chain rule) + * From \\(y = x_1 + x_2\\), we see that \\(\frac{\partial y}{\partial + x_1} = 1\\) + * Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \times 1 + = \frac{dz}{dy}\\). +* Looking second for \\(\frac{\partial z}{\partial x_2}\\) in terms of + \\(\frac{dz}{dy}\\): + * \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy} \frac{\partial + y}{\partial x_2}\\) (chain rule) + * From \\(y = x_1 + x_2\\), we see that \\(\frac{\partial y}{\partial + x_2} = 1\\) + * Therefore, \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy} \times 1 + = \frac{dz}{dy}\\). +* Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy}\\), and also + \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy}\\). + +Putting it into code: + +```haskell top +add :: (Num a, Backprop a, Reifies s W) + => BVar s a + -> BVar s a + -> BVar s a +add = liftOp2 . op2 $ \x1 x2 -> + ( x1 + x2, \dzdy -> (dzdy, dzdy) ) +``` + +Let's try our hand at multiplication, or \\(x * y\\): + +* \\(y = f(x_1, x_2) = x_1 x_2\\) +* \\(z = g(f(x_1, x_2)) = g(x_1 x_2)\\) +* Looking first for \\(\frac{d\partial }{d\partial _1}\\) in terms of + \\(\frac{dz}{dy}\\): + * \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \frac{\partial + y}{\partial x_1}\\) (chain rule) + * From \\(y = x_1 x_2\\), we see that \\(\frac{\partial y}{\partial x_1} + = x_2\\) + * Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} x_2\\). +* Looking second for \\(\frac{\partial z}{\partial x_2}\\) in terms of + \\(\frac{dz}{dy}\\): + * \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} \frac{\partial + y}{\partial x_1}\\) (chain rule) + * From \\(y = x_1 x_2\\), we see that \\(\frac{\partial y}{\partial x_2} + = x_1\\) + * Therefore, \\(\frac{\partial z}{\partial x_2} = \frac{dz}{dy} x_1\\). +* Therefore, \\(\frac{\partial z}{\partial x_1} = \frac{dz}{dy} x_2\\), and + \\(\frac{\partial z}{\partial x_2} = x_1 \frac{dz}{dy}\\). + +In code: + +```haskell top +mul :: (Num a, Backprop a, Reifies s W) + => BVar s a + -> BVar s a + -> BVar s a +mul = liftOp2 . op2 $ \x1 x2 -> + ( x1 * x2, \dzdy -> (dzdy * x2, x1 * dzdy) ) +``` + +For non-trivial examples involving linear algebra, see the source for the *[hmatrix-backprop][]* library. + +[hmatrix-backprop]: http://hackage.haskell.org/package/hmatrix-backprop + +Some examples, for the dot product between two vectors and for matrix-vector +multiplication: + +```haskell top +-- import qualified Numeric.LinearAlgebra.Static as H + +-- | dot product between two vectors +dot + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s (R n) + -> BVar s Double +dot = liftOp2 . op2 $ \u v -> + ( u `H.dot` v + , \dzdy -> (H.konst dzdy * v, u * H.konst dzdy) + ) + + +-- | matrix-vector multiplication +(#>) + :: (KnownNat m, KnownNat n, Reifies s W) + => BVar s (L m n) + -> BVar s (R n) + -> BVar s (R m) +(#>) = liftOp2 . op2 $ \mat vec -> + ( mat H.#> vec + , \dzdy -> (dzdy `H.outer` vec, H.tr mat H.#> dzdy) + ) +``` + +Possibilities +------------- + +That's it for this introductory tutorial on lifting single operations. More +information on the ways to apply these techniques to fully equip your library +for backpropagation (including arguments with multiple results, taking +advantage of isomorphisms, providing non-gradient functions) can be [found +here][equipping]! diff --git a/doc/07-performance.md b/doc/07-performance.md new file mode 100644 --- /dev/null +++ b/doc/07-performance.md @@ -0,0 +1,435 @@ +--- +title: Performance & Optimizations +--- + +Performance and Optimizations +============================= + +```haskell top hide +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + + +import GHC.Generics (Generic) +import GHC.TypeNats +import Inliterate.Import +import Lens.Micro +import Lens.Micro.TH +import Numeric.Backprop +import Numeric.Backprop.Class +import Numeric.LinearAlgebra.Static (L, R) +import qualified Numeric.LinearAlgebra as HU +import qualified Numeric.LinearAlgebra.Static as H +``` + +We can use the [MNIST tutorial][bench] as an example to compare automatic +differentiation with "manual" differentiation: + +[bench]: https://github.com/mstksg/backprop/blob/master/bench/bench.hs + +![benchmarks](https://i.imgur.com/7L5NV4P.png) + +In the above, we compare: + +1. "Manual" differentiation of a 784 x 300 x 100 x 10 fully-connected + feed-forward ANN. +2. Automatic differentiation using *backprop* and the lens-based accessor + interface +3. Automatic differentiation using *backprop* and the "higher-kinded + data"-based pattern matching interface +4. A hybrid approach that manually provides gradients for individual layers + but uses automatic differentiation for chaining the layers together. See + the section "Dealing with Overhead from Redundant Updates" for details. + +Sources of Overhead +------------------- + +One immediate result is that simply *running* the network and functions (using +`evalBP`) incurs virtually zero overhead. This means that library authors +could actually export *only* backprop-lifted functions, and users would be able +to use them without losing any performance. + +As for computing gradients, there exists some associated overhead. There are +three main sources: + +1. The construction and traversal of the [Wengert tape][] used to implement + automatic differentiation. However, this overhead is typically negligible + for backpropagating any numerical computations of non-trivial complexity. + +2. Redundant updates of entire data types during gradient accumulation. This + will be, **by far**, the *dominating* source of any overhead compared to manual + differentiation for any numerical computation of non-trivial complexity. + +3. Inefficiencies associated with "naive" differentiation, compared to manual + symbolic differentiation. However, this inefficiency is typically + negligible except in edge cases. + +[Wengert tape]: https://dl.acm.org/citation.cfm?doid=355586.364791 + +In addition, usage of the "Higher-Kinded Data"-based pattern matching interface +(over the lens-based accessor interface) incurs some penalties from the +inefficient nature of GHC Generics in general. + +Optimization Techniques +----------------------- + +### Dealing with Overhead from Redundant Updates + +By far the dominating source of overhead when using *backprop* is the redundant +update of data type fields when accumulating gradients. + +#### Example + +That is, if we had a data type like: + +```haskell top +data MyType = MT { _mtX :: Double + , _mtY :: Double + , _mtZ :: Double + } + deriving (Show, Generic) + +makeLenses ''MyType + +instance Backprop MyType +``` + +```haskell top hide +instance AskInliterate MyType +``` + + +and we *use* all three fields somehow: + +```haskell top +myFunc :: Reifies s W => BVar s MyType -> BVar s Double +myFunc mt = (mt ^^. mtX) * (mt ^^. mtY) + (mt ^^. mtZ) +``` + +and we compute its gradient: + +```haskell eval +gradBP myFunc (MT 5 7 2) +``` + +The library will first compute the derivative of the first field, and embed it +into `MyType`: + +```haskell +MT { _mtX = 7.0, _mtY = 0.0, _mtZ = 0.0 } +``` + +Then it'll compute the derivative of the second field and embed it: + +```haskell +MT { _mtX = 0.0, _mtY = 5.0, _mtZ = 0.0 } +``` + +And finally compute the derivative of the third field and embed it: + +```haskell +MT { _mtX = 0.0, _mtY = 0.0, _mtZ = 1.0 } +``` + +And it'll compute the final derivative by `add`-ing all three of those +together. + +This is not too bad with `Double`s, but when you have huge matrices, there will +be *six redundant addition of zeroes* for a data type with three fields...and +those additions of zero matrices can incur a huge cost. + +In general, for a data type with \\(n\\) fields where you use \\(m\\) of those +fields, you will have something on the order of \\(\mathcal{O}(n m)\\) +redundant additions by zero. + +#### Mitigating + +One way to mitigate these redundant updates is to prefer data types with less +fields if possible, or re-factor your data types into multiple "levels" of +nesting, to reduce the amount of redundant additions by zero. That is, instead +of having a giant ten-field data type, have two five-field data types, and one +type having a value of each type. This also works well with recursive "linked +list" data types, as well, as long as you write functions on your linked lists +inductively. + +You can also be careful in how many times you use `^^.` (`viewVar`), because +each usage site incurs another addition-by-zero in the gradient accumulation. +If possible, refactor all of your `^^.` into a single binding, and share it +within your expression, instead of using it again several times for the same +field in the same expression. + +You can also use clever lenses too "simulate" having a data type with less +fields than you actually have. For example, you can have a lens on the first +two fields: + +```haskell top +mtXY :: Lens' MyType (Double, Double) +mtXY f (MT x y z) = (\(x', y') -> MT x' y' z) <$> f (x, y) +``` + +This treats accessing both fields as effectively a single access to a single +tuple field, and so cuts out an extra addition by zero. + +As a last resort, you can *completely eliminate* redundant additions by zero by +providing *manual gradients* to functions using your data type. + +```haskell top +myFunc' :: Reifies s W => BVar s MyType -> BVar s Double +myFunc' = liftOp1 . op1 $ \(MT x y z) -> + ( (x * y) + z + , \d -> MT (d * y) (x * d) d + ) +``` + +```haskell eval +gradBP myFunc' (MT 5 7 2) +``` + +See the [writing manual gradients][manual-gradients] page for more information +on exactly how to specify your operations with manual gradients. + +[manual-gradients]: https://backprop.jle.im/06-manual-gradients.html + +Once you do this, you can use `myFunc'` as a part of any larger computation; +backpropagation will still work the same, and you avoid any redundant additions +of zero: + +```haskell eval +gradBP (negate . sqrt . myFunc) (MT 5 7 2) +``` + +```haskell eval +gradBP (negate . sqrt . myFunc') (MT 5 7 2) +``` + +When you *use* `myFunc'` in a function, it will be efficiently backpropagated +by the *backprop* library. + +This is useful for situations like optimizing artificial neural networks that +are a composition of multiple "layers": you can manually specify the derivative +of each layer, but let the *backprop* library take care of finding the +derivative of *their composition*. This is exactly the "hybrid" mode mentioned +in the benchmarks above. As can be seen by benchmark results, this brings the +manual and automatic backprop results to almost within range of random variance +of each other. + +However, I don't recommend doing this, unless as a last resort for +optimization. This is because: + +1. The whole point of the *backprop* library is to allow you to never have to + specify manual gradients +2. It is *very very easy* to make a mistake in your gradient computation and + introduce subtle bugs +3. It is difficult to *modify* your function if you want to tweak what it + returns. Compare changing the multiplication to division in the original + `myFunc` vs. the manual `myFunc'` +4. It makes it harder to read and understand (and subsequently refactor) your + code. + +However, this option is available as a low-level performance hack. + +### Dealing with Overhead from Naive Differentiation + +[Automatic differentiation][ad] is a mechanical process that is nothing more +than glorified book-keeping and accumulation. It essentially "hitches a ride" +on your normal computation in order to automatically accumulate its gradient. +It isn't aware of the analytical nature of computations, and cannot do any +symbolic or analytical simplifications like re-associating additions or +canceling out factors that humans might perform if manually differentiating. + +[ad]: https://en.wikipedia.org/wiki/Automatic_differentiation + +In most cases, this is "good enough" and will not be any significant source of +inefficiency in the larger picture. At least, it won't be worth the cognitive +overhead in squeezing out a one or two percent increase in performance. +However, there are some edge cases where this might become a concern worth +looking at. + +A common example is the composition of the [softmax][] activation function and +the [cross-entropy][] error function often used in deep learning. Together, +their derivatives are somewhat complex, computationally. However, the +derivative of their *composition*, `crossEntropy x . softMax` actually has an +extremely "simple" form, because of how some factors cancel out. To get around +this, libraries like *tensorflow* offer an [optimized version of the +composition with manually computed gradients][smce]. + +[softmax]: https://en.wikipedia.org/wiki/Softmax_function +[cross-entropy]: https://en.wikipedia.org/wiki/Cross_entropy +[smce]: https://www.tensorflow.org/api_docs/python/tf/losses/softmax_cross_entropy + +```haskell top hide +instance Backprop (R n) where + zero = zeroNum + add = addNum + one = oneNum + +instance (KnownNat n, KnownNat m) => Backprop (L n m) where + zero = zeroNum + add = addNum + one = oneNum + +instance KnownNat n => AskInliterate (R n) where + askInliterate = answerWith (show . H.extract) + +konst + :: (KnownNat n, Reifies s W) + => BVar s Double + -> BVar s (R n) +konst = liftOp1 . op1 $ \x -> + ( H.konst x + , HU.sumElements . H.extract + ) + +sumElements + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s Double +sumElements = liftOp1 . op1 $ \x -> + ( HU.sumElements . H.extract $ x + , H.konst + ) + +dot + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s (R n) + -> BVar s Double +dot = liftOp2 . op2 $ \x y -> + ( x `H.dot` y + , \d -> let d' = H.konst d + in (d' * y, x * d') + ) +``` + +```haskell top +-- import Numeric.LinearAlgebra.Static.Backprop + +softMax + :: (KnownNat n, Reifies s W) + => BVar s (R n) + -> BVar s (R n) +softMax x = konst (1 / totx) * expx + where + expx = exp x + totx = sumElements expx + +crossEntropy + :: (KnownNat n, Reifies s W) + => R n + -> BVar s (R n) + -> BVar s Double +crossEntropy x y = -(log y `dot` auto x) +``` + +(Note the usage of `auto :: a -> BVar s a` to lift a normal value into a `BVar`) + +Now, you can use `crossEntropy x . softMax` as a `BVar s (R n) -> BVar s Double` +function, and the result and gradient would be correct. It would backpropagate +the gradient of `crossEntropy` into `softMax`. However, you can take advantage +of the fact that some factors in the result "cancel out", and you can +drastically simplify the computation. + +Their normal composition would naively be: + +```haskell top +softMaxCrossEntropy + :: (KnownNat n, Reifies s W) + => R n + -> BVar s (R n) + -> BVar s Double +softMaxCrossEntropy x y = -(log softMaxY `dot` auto x) + where + expy = exp y + toty = sumElements expy + softMaxY = konst (1 / toty) * expy +``` + +Which you can probably guess has a decently complex gradient, just from all of +the chained operations we have going on. + +However, if you work things out on pencil and paper, you'll find a nice form +for the gradient of the cross entropy composed with softmax, \\(f(x,y)\\): + +\\[ +\nabla_y f(\mathbf{x}, \mathbf{y}) = \mathrm{softmax}(\mathbf{y}) - \mathbf{x} +\\] + +Basically, the gradient is just the result of `softMax` vector-subtracted +from the target. + +After computing the gradient by hand, we can write `softMaxCrossEntropy` +with our manual gradient: + +```haskell top +-- using the non-lifted interfaces +-- import qualified Numeric.LinearAlgebra as HU +-- import qualified Numeric.LinearAlgebra.Statuc as H + +softMaxCrossEntropy' + :: (KnownNat n, Reifies s W) + => R n + -> BVar s (R n) + -> BVar s Double +softMaxCrossEntropy' x = liftOp1 . op1 $ \y -> + let expy = exp y + toty = HU.sumElements (H.extract expy) + softMaxY = H.konst (1 / toty) * expy + smce = -(log softMaxY `H.dot` x) + in ( smce + , \d -> H.konst d * (softMaxY - x) + ) +``` + +Our gradient is now just `softMaxY - x`, which I can assure you is much, much +simpler than the automatic differentiation-derived gradient. This is because a +lot of factors show up on the top and bottom of functions and cancel out, and +a lot of positive and negative additions also end up canceling out. + +Again, refer to the [writing manual gradients][manual-gradients] page for more +information on exactly how to specify your operations with manual gradients. + +Once you do this, `softMaxCrossEntropy'` is now a function you can use normally +and compose with other backpropagatable functions. You won't be able to +functionally tell apart `crossEntropy x . softMax` from `softMaxCrossEntropy'`, +and the two will behave identically, propagating gradients with other `BVar` +functions: + +```haskell eval +gradBP ((**2) . crossEntropy (H.vec3 1 0 0) . softMax) (H.vec3 0.9 0.2 0.3) +``` + +```haskell eval +gradBP ((**2) . softMaxCrossEntropy (H.vec3 1 0 0)) (H.vec3 0.9 0.2 0.3) +``` + +```haskell eval +gradBP ((**2) . softMaxCrossEntropy' (H.vec3 1 0 0)) (H.vec3 0.9 0.2 0.3) +``` + +`softMaxCrossEntropy'` will be more efficient in computing gradients. + +Again, I don't recommend doing this in most cases, and this should always be a +last resort. To me, this is even less warranted than the situation above +(mentioning redundant additions) because any losses due to naive AD should be +negligible. Only doing this *after profiling and benchmarking*, when you are +*sure* that a particular function composition is causing your bottleneck. +Don't do this for any ol' composition you write, because: + +1. Again, the *whole point* of this library is to allow you to *avoid* + computing gradients by hand. +2. Computing gradients by hand is very tricky and there are many places where + you could introduce a bug in a subtle way that might not be apparent even + through initial testings. +3. This is very fragile, and any future changes to your function will require + you to completely re-compute and re-write your giant lifted function. +4. It is again much harder to read and understand your code. + +But, if you profile and benchmark and conclude that a bad composition is +bottleneck, know that this path is available. + diff --git a/doc/08-equipping-your-library.md b/doc/08-equipping-your-library.md new file mode 100644 --- /dev/null +++ b/doc/08-equipping-your-library.md @@ -0,0 +1,513 @@ +--- +title: Equipping your Library +--- + +Equipping your Library for Backprop +=================================== + +```haskell top hide +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + + +import Data.Functor.Identity +import GHC.Generics (Generic) +import Lens.Micro +import Lens.Micro.TH +import Numeric.Backprop +import Numeric.Backprop.Class +import System.Random +import qualified Data.List +import qualified Data.Vector as V +``` + +So you want your users to be able to use your numerical library with +*backprop*, huh? + +This page is specifically for library authors who want to allow their users to +use their library operations and API with *backprop*. End-users of the +*backprop* library should not have to worry about the contents of this page. + +Equipping your library with backprop involves providing "backprop-aware" +versions of your library functions. *In fact*, it is possible to make a +library fully by providing *only* backprop versions of your functions, since +you can use a backprop-aware function as a normal function with `evalBP`. +Alternatively, you can re-export all of your functions in a separate module with +"backprop-aware" versions. + +Know Thy Types +-------------- + +The most significant effort will be in lifting your library's functions. If +you have a function: + +```haskell +myFunc :: a -> b +``` + +Then its lifted version would have type: + +```haskell +myFunc :: Reifies s W => BVar s a -> BVar s b +``` + +That is, instead of a function directly taking an `a` and returning a `b`, it's +a function taking a `BVar` containing an `a`, and returning a `BVar` containing +a `b`. + +Functions taking multiple arguments can be translated pretty straightforwardly: + +```haskell +func1 :: a -> b -> c +func1BP :: Reifies s W => BVar s a -> BVar s b -> BVar s c +``` + +And also functions returning multiple arguments: + +```haskell +func2 :: a -> ( b, c) +func2BP :: Reifies s W => BVar s a -> (BVar s b, BVar s c) +``` + +It is recommended (for ease of use with `-XTypeApplications`) that `Reifies s +W` be the *final* constraint in all code you write. + +Note that almost all operations involving `BVar`'d items require that the +contents have a `Backprop` instance. Alternative API's to backprop that +require `Num` instances instead (or explicitly specified addition functions) +are available in *Numeric.Backprop.Num* and *Numeric.Backprop.Explicit*. + +The Easy Way +------------ + +`BVar` based functions are just normal functions, so they can be applied +normally and passed as first-class values. If possible, if you can *utilize* +functions that are already `BVar`'d/lifted, then you can just define your API +in terms of those lifted functions. This is also how *users* are expected to +be able to use your library: just use the lifted functions you provide, in +order to make their own lifted functions using normal function application and +composition. + +Lifting operations manually +--------------------------- + +However, if no lifted primitive functions are available, then you do have to do +some legwork to provide information on gradient computation for your types. +Ideally, you would only need to do this for some minimal set of your +operations, and then define the rest of them in terms of the functions you have +already lifted. + +A full tutorial on lifting your library functions [can be found +here][manual-gradients]. It describes the usage of the `liftOp` and `op` +family of functions to fully lift your single-argument single-result and +multiple-argument single-result functions to be backpropagatable. + +[manual-gradients]: https://backprop.jle.im/06-manual-gradients.html + +### Returning multiple items + +As an extension of the [manual gradient tutorial][manual-gradients], we can +consider functions that return multiple items. + +You can always return tuples inside `BVar`s: + +```haskell top +splitAt + :: (Backprop a, Reifies s W) + => Int + -> BVar s [a] + -> BVar s ([a], [a]) +splitAt n = liftOp1 . op1 $ \xs -> + let (ys, zs) = Data.List.splitAt n xs + in ((ys, zs), \(dys,dzs) -> dys ++ dzs) + -- assumes dys and dzs have the same lengths as ys and zs +``` + +This works as expected. However, it is recommended, for the benefit of your +users, that you return a tuple of `BVar`s instead of a `BVar` of tuples: + +```haskell top +splitAt' + :: (Backprop a, Reifies s W) + => Int + -> BVar s [a] + -> (BVar s [a], BVar s [a]) +splitAt' n xs = (yszs ^^. _1, yszs ^^. _2) + where + yszs = liftOp1 (op1 $ \xs' -> + let (ys, zs) = Data.List.splitAt n xs' + in ((ys, zs), \(dys,dzs) -> dys ++ dzs) + ) xs +``` + +using `_1` and `_2` from the *[microlens][]* or *[lens][]* packages. This +might also be cleaner if you take advantage of the `T2` or `T3` pattern +synonyms: + +[microlens]: http://hackage.haskell.org/package/microlens +[lens]: http://hackage.haskell.org/package/lens + +```haskell top +splitAt'' + :: (Backprop a, Reifies s W) + => Int + -> BVar s [a] + -> (BVar s [a], BVar s [a]) +splitAt'' n xs = (ys, zs) + where + T2 ys zs = liftOp1 (op1 $ \xs' -> + let (ys, zs) = Data.List.splitAt n xs' + in ((ys, zs), \(dys,dzs) -> dys ++ dzs) + ) xs +``` + +### Isomorphisms + +If your function witnesses an isomorphism, there are handy combinators for +making this easy to write. This is especially useful in the case of data +constructors: + +```haskell top +newtype Foo = MkFoo { getFoo :: Double } + deriving Generic + +instance Backprop Foo + +mkFoo + :: Reifies s W + => BVar s Double + -> BVar s Foo +mkFoo = isoVar MkFoo getFoo + +data Bar = MkBar { bar1 :: Double, bar2 :: Float } + deriving Generic + +instance Backprop Bar + +mkBar + :: Reifies s W + => BVar s Double + -> BVar s Float + -> BVar s Bar +mkBar = isoVar2 MkBar (\b -> (bar1 b, bar2 b)) +``` + +Note also that if you have a newtype with one constructor (or any other two +`Coercible` types), you can simply use `coerceVar`: + +```haskell top +mkFoo' + :: BVar s Double + -> BVar s Foo +mkFoo' = coerceVar -- requires no `Reifies s W` constraint +``` + +### NoGrad + +If you do decide to go to the extreme, and provide *only* a BVar-based +interface to your library (and no non-BVar based one), then you might have a +situation where you have a function where you cannot define the gradient -- +maybe no gradient exists, or you haven't put in the time to write one. In this +case, you can use `noGrad` and `noGrad1`: + +```haskell top +negateNoGrad + :: (Num a, Backprop a, Reifies s W) + => BVar s a + -> BVar s a +negateNoGrad = liftOp1 (noGrad1 negate) +``` + +This function can still be used with `evalBP` to get the correct answer. It +can even be used with `gradBP` if the result is never used in the final answer. + +However, if it *is* used in the final answer, then computing the gradient will +throw a runtime exception. + +Be sure to warn your users! Like any partial function, this is not recommended +unless in extreme circumstances. + +Monadic Operations +------------------ + +This should all work if your operations are all "pure". However, what about +the cases where your operations have to be performed in some Applicative or +Monadic context? + +For example, what if `add :: X -> X -> IO X` ? + +One option you can do is to newtype-wrap your operations, and then give those a +backprop instance: + +```haskell top hide +data X + +zeroForX :: X -> X +zeroForX = undefined +addForX :: X -> X -> IO X +addForX = undefined +oneForX :: X -> X +oneForX = undefined +``` + +```haskell top +newtype IOX = IOX (IO X) + +instance Backprop IOX where + zero (IOX x) = IOX (fmap zeroForX x) + -- or, depending on the type of `zeroForX`: + -- zero (IOX x) = IOX (zeroForX =<< x) + + add (IOX x) (IOX y) = IOX $ do + x' <- x + y' <- y + addForX x' y' + + one (IOX x) = IOX (fmap oneForX x) +``` + +And you can define your functions in terms of this: + +```haskell top +addX + :: Reifies s W + => BVar s IOX + -> BVar s IOX + -> BVar s IOX +addX = liftOp2 . op2 $ \(IOX x) (IOX y) -> + ( IOX (do x' <- x; y' <- y; addForX x' y') + , \dzdy -> (dzdy, dzdy) + ) +``` + +This should work fine as long as you never "branch" on any *results* of your +actions. You must not ever need to peek inside the *results* of the action in +order to decide *what* operations to do next. In other words, this works if +the operations you need to perform are all known and fixed before-hand, before +any actions are performed. So, this means no access to the `Eq` or `Ord` +instances of BVars (unless your monad has `Eq` or `Ord` instances defined). + +A newtype wrapper is provided to give you this behavior automatically -- it's +`ABP`, from *Numeric.Backprop* and *Numeric.Backprop.Class*. + +```haskell +type IOX = ABP IO X +``` + +However, this will not work if you need to do things like compare contents, +etc. to decide what operations to use. + +At the moment, this is not supported. Please open an issue if this becomes an +issue! + +Supporting Data Types +--------------------- + +Your library will probably have data types that you expect your users to use. +To equip your data types for backpropagation, you can take a few steps. + +### Backprop Class + +First of all, all of your library's types should have instances of the +[`Backprop` typeclass][class]. This allows values of your type to be used in +backpropagatable functions. See the [Backprop typeclass section][tcdocs] of +this documentation for more information on writing a `Backprop` instance for +your types. + +[class]: https://hackage.haskell.org/package/backprop/docs/Numeric-Backprop-Class.html +[tcdocs]: https://backprop.jle.im/04-the-backprop-typeclass.html + +In short: + +1. If your type is a type with a single constructor whose fields are all + instances of `Backprop`, you can just write `instance Backprop MyType`, and + the instance is generated automatically (as long as your type has a + `Generic` instance) + + ```haskell top + data MyType = MkMyType Double [Float] (R 10) (L 20 10) (V.Vector Double) + deriving Generic + + instance Backprop MyType + ``` + +2. If your type is an instance of `Num`, you can use `zeroNum`, `addNum`, and + `oneNum` to get free definitions of the typeclass methods. + + ```haskell + instance Backprop Double where + zero = zeroNum + add = addNum + one = oneNum + ``` + +3. If your type is made using a `Functor` instance, you can use `zeroFunctor` + and `oneFunctor`: + + ```haskell + instance Backprop a => Backprop (V.Vector a) where + zero = zeroFunctor + add = undefined -- ?? + one = oneFunctor + ``` + +4. If your type has an `IsList` instance, you can use `addIsList`: + + ```haskell + instance Backprop a => Backprop (V.Vector a) where + zero = zeroFunctor + add = addIsList + one = oneFunctor + ``` + +For more details, see the [aforementioned documentation][tcdocs] or the [actual +typeclass haddock documentation][class]. + +### Accessors + +If you have product types, users should be able to access values inside `BVar`s +of your data type. There are two main ways to provide access: the lens-based +interface and the higher-kinded-data-based interface. + +The lens-based interface gives your users "getter" and "setter" functions for +fields, and the higher-kinded-data-based interface lets your users pattern +match on your data type's original constructor to get fields and construct +values. + +#### Lens-Based Interface + +If you are defining a product type, like + +```haskell top +data MyType = MT { _mtDouble :: Double + , _mtInt :: Int + , _mtDoubles :: [Double] + } +``` + +Users who have a `BVar s MyType` can't normally access the fields inside, +because you can't directly pattern match normally, and the record accessors +are `MyType -> Int` (unlifted). As a library maintainer, you can provide them +*lenses* to the fields, either generated automatically using the *[lens][]* or +*[microlens-th][]* packages: + +[lens]: http://hackage.haskell.org/package/lens +[microlens-th]: http://hackage.haskell.org/package/microlens-th + +```haskell top +makeLenses ''MyType +``` + +or manually by hand: + +```haskell top +mtInt' :: Functor f => (Int -> f Int) -> MyType -> f MyType +mtInt' f mt = (\i -> mt { _mtInt = i }) <$> f (_mtInt mt) +``` + +Now, users can use `^.` or `view` from the *lens* or *[microlens][]* packages +to retrieve your fields: + +[microlens]: http://hackage.haskell.org/package/microlens + +```haskell +(^. mtDouble) :: MyType -> Double +``` + +And `(^^.)` and `viewVar` from *backprop* to retrieve fields from a `BVar`: + +```haskell +(^^. mtDouble) :: BVar s MyType -> BVar s Double +``` + +They can also use `set` or `.~` to modify fields, and `setVar` and `.~~` to +modify and "set" fields in a `BVar`: + +```haskell +set mtDouble :: Double -> MyType -> MyType +setVar mtDouble :: BVar s Double -> BVar s MyType -> BVar s MyType +``` + +Likewise, `over` and `%~` can be used to apply a function to the contents of a +field, and `overVar` and `%~~` can be used to apply backpropagatable functions +to over fields of a value in a `BVar`. + +#### Higher-Kinded Data Interface + +The alternative "Higher-Kinded Data" technique, inspired by [this +article][hkd], allows your users to directly pattern match on `BVar`s of your +types to get their contents. + +[hkd]: http://reasonablypolymorphic.com/blog/higher-kinded-data/ + +Doing this requires modifying the definition of your data types slightly. +Instead of `MyType` above, we can make a type family that can be re-used for +all of your data types: + +```haskell top +type family HKD f a where + HKD Identity a = a + HKD f a = f a +``` + +and define your data types in terms of this type family (remembering to derive +`Generic`): + +```haskell top +data MyType2' f = MT2 { mt2Double :: HKD f Double + , mt2Int :: HKD f Int + , mt2Doubles :: HKD f [Double] + } + deriving Generic +``` + +Now your original data type can be recovered with `MyType2' Identity`, and can +be pattern matched directly in the same way as the original type (the +`Identity` disappears): + +```haskell top +type MyType2 = MyType2' Identity + +deriving instance Show MyType2 +instance Backprop MyType2 + +getMT2Double :: MyType2 -> Double +getMT2Double (MT2 d _ _) = d +``` + +But now, users can *pattern match* on a `BVar s MyType2` to get `BVar`s of the +contents, with `splitBV` or the `BV` pattern synonym: + +```haskell top +getMT2DoubleBVar + :: Reifies s W + => BVar s MyType2 + -> BVar s Double +getMT2DoubleBVar (splitBV -> MT2 d _ _) = d +``` + +Under `splitBV`, your users can pattern match on the `MT2` constructor and get +the contents as `BVar`s. + +Note that HKD access through pattern matching is potentially less performant +than access using lens (by about 10-20%). + +Users can also use `joinBV` (or the `BV` pattern synonym in constructor mode) +to re-construct a `BVar` of `MyType2` in terms of `BVar`s of its contents using +the `MT2` constructor: + +```haskell top +makeMyType2 + :: Reifies s W + => BVar s Double + -> BVar s Int + -> BVar s [Double] + -> BVar s MyType2 +makeMyType2 d i ds = joinBV $ MT2 d i ds +``` diff --git a/doc/09-comparisons.md b/doc/09-comparisons.md new file mode 100644 --- /dev/null +++ b/doc/09-comparisons.md @@ -0,0 +1,47 @@ +--- +title: Comparisons +--- + +Comparisons +=========== + +*backprop* can be compared and contrasted to many other similar libraries with +some overlap: + +1. The *[ad][]* library (and variants like *[diffhask][]*) support automatic + differentiation, but only for *homogeneous*/*monomorphic* situations. All + values in a computation must be of the same type --- so, your computation + might be the manipulation of `Double`s through a `Double -> Double` + function. + + *backprop* allows you to mix matrices, vectors, doubles, integers, and even + key-value maps as a part of your computation, and they will all be + backpropagated properly with the help of the `Backprop` typeclass. + +2. The *[autograd][]* library is a very close equivalent to *backprop*, + implemented in Python for Python applications. The difference between + *backprop* and *autograd* is mostly the difference between Haskell and + Python --- static types with type inference, purity, etc. + +3. There is a link between *backprop* and deep learning/neural network + libraries like *[tensorflow][]*, *[caffe][]*, and *[theano][]*, which all + all support some form of heterogeneous automatic differentiation. Haskell + libraries doing similar things include *[grenade][]*. + + These are all frameworks for working with neural networks or other + gradient-based optimizations --- they include things like built-in + optimizers, methods to automate training data, built-in models to use out + of the box. *backprop* could be used as a *part* of such a framework, like + I described in my [A Purely Functional Typed Approach to Trainable + Models][models] blog series; however, the *backprop* library itself does + not provide any built in models or optimizers or automated data processing + pipelines. + +[ad]: https://hackage.haskell.org/package/ad +[diffhask]: https://hackage.haskell.org/package/diffhask +[autograd]: https://github.com/HIPS/autograd +[tensorflow]: https://www.tensorflow.org/ +[caffe]: http://caffe.berkeleyvision.org/ +[theano]: http://www.deeplearning.net/software/theano/ +[grenade]: http://hackage.haskell.org/package/grenade +[models]: https://blog.jle.im/entry/purely-functional-typed-models-1.html diff --git a/doc/index.md b/doc/index.md --- a/doc/index.md +++ b/doc/index.md @@ -30,9 +30,9 @@ ([1,6,2] :: [Double]) ``` -Useful for applications in [differential programming][dp] and deep learning for -creating and training numerical models, especially as described in this blog -post on [a purely functional typed approach to trainable models][models]. +Useful for applications in [differentiable programming][dp] and deep learning +for creating and training numerical models, especially as described in this +blog post on [a purely functional typed approach to trainable models][models]. Overall, intended for the implementation of gradient descent and other numeric optimization techniques. Comparable to the python library [autograd][]. diff --git a/renders/backprop-mnist.pdf b/renders/backprop-mnist.pdf Binary files a/renders/backprop-mnist.pdf and b/renders/backprop-mnist.pdf differ diff --git a/renders/extensible-neural.md b/renders/extensible-neural.md --- a/renders/extensible-neural.md +++ b/renders/extensible-neural.md @@ -192,7 +192,8 @@ -> BVar s (R o) runNetwork n = \case SNil -> softMax . runLayer (n ^^. _NO) - SCons SNat hs -> runNetwork (withSingI hs (n ^^. _NIN)) hs + SCons SNat hs -> withSingI hs $ + runNetwork (n ^^. _NIN) hs . logistic . runLayer (n ^^. _NIL) {-# INLINE runNetwork #-} diff --git a/renders/extensible-neural.pdf b/renders/extensible-neural.pdf Binary files a/renders/extensible-neural.pdf and b/renders/extensible-neural.pdf differ diff --git a/samples/extensible-neural.lhs b/samples/extensible-neural.lhs --- a/samples/extensible-neural.lhs +++ b/samples/extensible-neural.lhs @@ -181,7 +181,8 @@ > -> BVar s (R o) > runNetwork n = \case > SNil -> softMax . runLayer (n ^^. _NO) -> SCons SNat hs -> runNetwork (withSingI hs (n ^^. _NIN)) hs +> SCons SNat hs -> withSingI hs $ +> runNetwork (n ^^. _NIN) hs > . logistic > . runLayer (n ^^. _NIL) > {-# INLINE runNetwork #-} diff --git a/src/Data/Type/Util.hs b/src/Data/Type/Util.hs --- a/src/Data/Type/Util.hs +++ b/src/Data/Type/Util.hs @@ -20,10 +20,12 @@ , fillProd , zipVecList , splitProd + , traverse1_ , p1, p2, s1, s2 ) where import Data.Bifunctor +import Data.Foldable import Data.Type.Conjunction hiding ((:*:)) import Data.Type.Length import Data.Type.Nat @@ -31,6 +33,7 @@ import Data.Type.Vector import GHC.Generics import Lens.Micro +import Type.Class.Higher import Type.Class.Witness import Type.Family.List import Type.Family.Nat @@ -162,6 +165,13 @@ x :* xs -> \case [] -> f x Nothing :* go xs [] y:ys -> f x (Just y) :* go xs ys + +traverse1_ + :: (Foldable1 t, Applicative g) + => (forall a. f a -> g ()) + -> t f as + -> g () +traverse1_ f = sequenceA_ . foldMap1 ((:[]) . f) splitProd :: Length as diff --git a/src/Numeric/Backprop.hs b/src/Numeric/Backprop.hs --- a/src/Numeric/Backprop.hs +++ b/src/Numeric/Backprop.hs @@ -21,6 +21,9 @@ -- automatically provies the gradient of that function as well, for usage -- with gradient descent and other training methods. -- +-- See the for an introduction and +-- walkthrough. +-- -- In more detail: instead of working directly with values to produce your -- result, you work with 'BVar's containing those values. Working with -- these 'BVar's is made smooth with the usage of lenses and other @@ -45,12 +48,12 @@ -- -- to automatically get the /gradient/, as well, for a given input. -- --- See the for more information --- and links to demonstrations and tutorials, or dive striaght in by --- reading the docs for 'BVar'. +-- Refer to the for more information and +-- links to demonstrations and tutorials, or dive striaght in by reading +-- the docs for 'BVar'. -- -- If you are writing a library, see --- for a guide for +-- for a guide for -- equipping your library with backpropatable operations. -- -- In the original version 0.1, this module required 'Num' instances for @@ -76,8 +79,8 @@ -- * Manipulating 'BVar' , E.evalBP0 , E.constVar, E.auto, E.coerceVar - , (^^.), (.~~), (^^?), (^^..), (^^?!) - , viewVar, setVar + , (^^.), (.~~), (%~~), (^^?), (^^..), (^^?!) + , viewVar, setVar, overVar , sequenceVar, collectVar , previewVar, toListOfVar , pattern T2, pattern T3 @@ -113,7 +116,6 @@ , Reifies ) where -import Data.Bifunctor import Data.Maybe import Data.Reflection import Data.Type.Index @@ -198,21 +200,21 @@ => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b) -> Tuple as -> (b, Tuple as) -backpropN f = second ($ E.oneFunc) . E.backpropN E.zeroFuncs f +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. --- --- Note that argument order changed in v0.2.3. -- +-- Note that argument order changed in v0.2.4. +-- -- @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 -> b) -> Tuple as) -- ^ Takes function giving gradient of final result given the output of function + -> (b, b -> Tuple as) backpropWithN = E.backpropWithN E.zeroFuncs {-# INLINE backpropWithN #-} @@ -228,7 +230,7 @@ => (forall s. Reifies s W => BVar s a -> BVar s b) -> a -> (b, a) -backprop f = second ($ E.oneFunc) . E.backprop E.zeroFunc f +backprop = E.backprop E.zeroFunc E.oneFunc {-# INLINE backprop #-} -- | A version of 'backprop' that allows you to specify the gradent of your @@ -245,14 +247,14 @@ -- 'backprop' is essentially 'backpropWith' with @'const' 1@ for scalars -- and 'Num' instances. -- --- Note that argument order changed in v0.2.3 +-- Note that argument order changed in v0.2.4 -- -- @since 0.2.0.0 backpropWith :: Backprop a => (forall s. Reifies s W => BVar s a -> BVar s b) -> a - -> (b, (b -> b) -> a) -- ^ Takes function giving gradient of final result given the output of function + -> (b, b -> a) backpropWith = E.backpropWith E.zeroFunc {-# INLINE backpropWith #-} @@ -301,14 +303,14 @@ -> a -> b -> (c, (a, b)) -backprop2 f x = second ($ E.oneFunc) . E.backprop2 E.zeroFunc E.zeroFunc f x +backprop2 = E.backprop2 E.zeroFunc E.zeroFunc E.oneFunc {-# INLINE backprop2 #-} -- | '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. -- --- Note that argument order changed in v0.2.3 +-- Note that argument order changed in v0.2.4 -- -- @since 0.2.0.0 backpropWith2 @@ -316,7 +318,7 @@ => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c) -> a -> b - -> (c, (c -> c) -> (a, b)) -- ^ Takes function giving gradient of final result given the output of function + -> (c, c -> (a, b)) backpropWith2 = E.backpropWith2 E.zeroFunc E.zeroFunc {-# INLINE backpropWith2 #-} @@ -357,11 +359,17 @@ -- 'splitBV', which lets you break out 'BVar's of values into 'BVar's of -- their individual fields automatically without requiring lenses. -- +-- __NOTE__: Usage of '^^.' on many fields from the same item is usually +-- the main source of overhead in /backprop/ code, if you are looking to +-- optimize your code. See for more information, and details on mitigating +-- this overhead. +-- -- __WARNING__: Do not use with any lenses that operate "numerically" on -- the contents (like 'multiplying'). -- (^^.) - :: forall b a s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop b, Backprop a, Reifies s W) => BVar s b -> Lens' b a -> BVar s a @@ -372,13 +380,9 @@ -- | Using a 'Lens'', extract a value /inside/ a 'BVar'. Meant to evoke -- parallels to 'view' from lens. -- --- If you have control of your data type definitions, consider using --- 'splitBV', which lets you break out 'BVar's of values into 'BVar's of --- their individual fields automatically without requiring lenses. --- --- See documentation for '^^.' for more information. +-- See documentation for '^^.' for more information, caveats, and warnings. viewVar - :: forall a b s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop a, Backprop b, Reifies s W) => Lens' b a -> BVar s b -> BVar s a @@ -390,7 +394,6 @@ -- lens. -- -- With normal values, you can set something in a value with a lens: --- a lens: -- -- @ -- x '&' myLens '.~' 'y' @@ -429,10 +432,60 @@ -> BVar s a -> BVar s b -> BVar s b -setVar = E.setVar E.addFunc E.addFunc E.zeroFunc E.zeroFunc +setVar = E.setVar E.addFunc E.addFunc E.zeroFunc {-# INLINE setVar #-} +-- | An infix version of 'overVar', meant to evoke parallels to '%~~' from +-- lens. +-- +-- With normal values, you can set modify in a value with a lens: +-- +-- @ +-- x '&' myLens '%~' 'negate' +-- @ +-- +-- would "modify" a part of @x :: b@, specified by @myLens :: 'Lens'' a b@, +-- using the function @negate :: a -> a@. +-- +-- @ +-- xVar '&' myLens '%~~' 'negate' +-- @ +-- +-- would "modify" a part of @xVar :: 'BVar' s b@ (a 'BVar' holding a @b@), +-- specified by @myLens :: 'Lens'' a b@, using the function @negate :: BVar +-- s a -> BVar s @. The result is a new (updated) value of type @'BVar' +-- s b@. +-- +-- Is essentially a convenient wrapper over a 'viewVar' followed by +-- a 'setVar'. +-- +-- @since 0.2.4.0 +-- +(%~~) + :: (Backprop a, Backprop b, Reifies s W) + => Lens' b a + -> (BVar s a -> BVar s a) + -> BVar s b + -> BVar s b +l %~~ f = overVar l f +infixr 4 %~~ +{-# INLINE (%~~) #-} +-- | Using a 'Lens'', modify a value /inzide/ a 'BVar'. Meant to evoke +-- parallels to "over" from lens. See documentation for '%~~' for more +-- information. +-- +-- @since 0.2.4.0 +overVar + :: (Backprop a, Backprop b, Reifies s W) + => Lens' b a + -> (BVar s a -> BVar s a) + -> BVar s b + -> BVar s b +overVar = E.overVar E.addFunc E.addFunc E.zeroFunc E.zeroFunc +{-# INLINE overVar #-} + + -- | An infix version of 'previewVar', meant to evoke parallels to '^?' -- from lens. -- @@ -462,15 +515,20 @@ -- -- This can be used to "pattern match" on 'BVar's, by using prisms on -- constructors. +-- +-- __NOTE__: Has the same potential of performance overhead issues as +-- '^^.'; see documentation of '^^.' for more details. (^^?) - :: forall b a s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop b, Backprop a, Reifies s W) => BVar s b -> Traversal' b a -> Maybe (BVar s a) v ^^? t = previewVar t v +infixl 8 ^^? {-# INLINE (^^?) #-} --- | An *UNSAFE* version of 'previewVar' assuming that it is there. +-- | An *UNSAFE* version of '^^?' and 'previewVar' assuming that the value +-- is there. -- -- Is undefined if the 'Traversal' hits no targets. -- @@ -478,13 +536,14 @@ -- -- @since 0.2.1.0 (^^?!) - :: forall b a s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop b, Backprop a, Reifies s W) => BVar s b -> Traversal' b a -> BVar s a v ^^?! t = fromMaybe (error e) (previewVar t v) where e = "Numeric.Backprop.^^?!: Empty traversal" +infixl 8 ^^?! {-# INLINE (^^?!) #-} -- | Using a 'Traversal'', extract a single value /inside/ a 'BVar', if it @@ -492,9 +551,9 @@ -- 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. +-- See documentation for '^^?' for more information, warnings, and caveats. previewVar - :: forall b a s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop b, Backprop a, Reifies s W) => Traversal' b a -> BVar s b -> Maybe (BVar s a) @@ -522,8 +581,11 @@ -- holding a @b@), specified by @myTraversal :: Traversal' b a@. The result -- has type @['BVar' s a]@ (A list of 'BVar's holding @a@s). -- +-- __NOTE__: Has all of the performance overhead issues of 'sequenceVar'; +-- see documentation for 'sequenceVar' for more information. +-- (^^..) - :: forall b a s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop b, Backprop a, Reifies s W) => BVar s b -> Traversal' b a -> [BVar s a] @@ -533,9 +595,10 @@ -- | Using a 'Traversal'', extract all targeted values /inside/ a 'BVar'. -- Meant to evoke parallels to 'toListOf' from lens. -- --- See documentation for '^^..' for more information. +-- See documentation for '^^..' for more information, warnings, and +-- caveats. toListOfVar - :: forall b a s. (Backprop a, Reifies s W) + :: forall b a s. (Backprop b, Backprop a, Reifies s W) => Traversal' b a -> BVar s b -> [BVar s a] @@ -550,6 +613,14 @@ -- 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__: A potential source of performance overhead. If there are +-- \(n\) total elements, and you use \(m\) of them, then there is an +-- overhead cost on the order of \(\mathcal{O}(m n)\), with a constant +-- factor dependent on the cost of 'add'. Should be negligible for types +-- with cheap 'add' (like 'Double'), but may be costly for things like +-- large matrices. See for for details. sequenceVar :: (Traversable t, Backprop a, Reifies s W) => BVar s (t a) @@ -566,7 +637,11 @@ -- etc.; this can cause unexpected behavior in 'Foldable' instances that -- don't have a fixed number of items. -- --- Prior to v0.2.3, required a 'Backprop' constraint on @t a@. +-- Note that this does __not__ suffer from the same performance overhead +-- issues as 'sequenceVar'. 'collectVar' is \(\mathcal{O}(n)\), with +-- a very small constant factor that consistent for all types. This +-- reveals a general property of reverse-mode automatic differentiation; +-- "many to one" is cheap, but "one to many" is expensive. collectVar :: (Foldable t, Functor t, Backprop a, Reifies s W) => t (BVar s a) @@ -584,11 +659,11 @@ -- information, and "Numeric.Backprop.Op#prod" for a mini-tutorial on using -- 'Prod' and 'Tuple'. liftOp - :: (Every Backprop as, Known Length as, Backprop b, Reifies s W) + :: (Every Backprop as, Known Length as, Reifies s W) => Op as b -> Prod (BVar s) as -> BVar s b -liftOp = E.liftOp E.addFuncs E.zeroFunc +liftOp = E.liftOp E.addFuncs {-# INLINE liftOp #-} -- | Lift an 'Op' with a single input to be a function on a single 'BVar'. @@ -599,11 +674,11 @@ -- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more -- information. liftOp1 - :: (Backprop a, Backprop b, Reifies s W) + :: (Backprop a, Reifies s W) => Op '[a] b -> BVar s a -> BVar s b -liftOp1 = E.liftOp1 E.addFunc E.zeroFunc +liftOp1 = E.liftOp1 E.addFunc {-# INLINE liftOp1 #-} -- | Lift an 'Op' with two inputs to be a function on a two 'BVar's. @@ -614,12 +689,12 @@ -- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more -- information. liftOp2 - :: (Backprop a, Backprop b, Backprop c, Reifies s W) + :: (Backprop a, Backprop b, 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 +liftOp2 = E.liftOp2 E.addFunc E.addFunc {-# INLINE liftOp2 #-} -- | Lift an 'Op' with three inputs to be a function on a three 'BVar's. @@ -630,13 +705,13 @@ -- See "Numeric.Backprop#liftops" and documentation for 'liftOp' for more -- information. liftOp3 - :: (Backprop a, Backprop b, Backprop c, Backprop d, Reifies s W) + :: (Backprop a, Backprop b, Backprop c, 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 +liftOp3 = E.liftOp3 E.addFunc E.addFunc E.addFunc {-# INLINE liftOp3 #-} -- | Convert the value inside a 'BVar' using a given isomorphism. Useful @@ -652,12 +727,12 @@ -- -- @since 0.1.4.0 isoVar - :: (Backprop a, Backprop b, Reifies s W) + :: (Backprop a, Reifies s W) => (a -> b) -> (b -> a) -> BVar s a -> BVar s b -isoVar = E.isoVar E.addFunc E.zeroFunc +isoVar = E.isoVar E.addFunc {-# INLINE isoVar #-} -- | Convert the values inside two 'BVar's using a given isomorphism. @@ -669,13 +744,13 @@ -- -- @since 0.1.4.0 isoVar2 - :: (Backprop a, Backprop b, Backprop c, Reifies s W) + :: (Backprop a, Backprop b, Reifies s W) => (a -> b -> c) -> (c -> (a, b)) -> BVar s a -> BVar s b -> BVar s c -isoVar2 = E.isoVar2 E.addFunc E.addFunc E.zeroFunc +isoVar2 = E.isoVar2 E.addFunc E.addFunc {-# INLINE isoVar2 #-} -- | Convert the values inside three 'BVar's using a given isomorphism. @@ -683,14 +758,14 @@ -- -- @since 0.1.4.0 isoVar3 - :: (Backprop a, Backprop b, Backprop c, Backprop d, Reifies s W) + :: (Backprop a, Backprop b, Backprop c, Reifies s W) => (a -> b -> c -> d) -> (d -> (a, b, c)) -> BVar s a -> BVar s b -> BVar s c -> BVar s d -isoVar3 = E.isoVar3 E.addFunc E.addFunc E.addFunc E.zeroFunc +isoVar3 = E.isoVar3 E.addFunc E.addFunc E.addFunc {-# INLINE isoVar3 #-} -- | Convert the values inside a tuple of 'BVar's using a given @@ -703,12 +778,12 @@ -- -- @since 0.1.4.0 isoVarN - :: (Every Backprop as, Known Length as, Backprop b, Reifies s W) + :: (Every Backprop as, Known Length as, Reifies s W) => (Tuple as -> b) -> (b -> Tuple as) -> Prod (BVar s) as -> BVar s b -isoVarN = E.isoVarN E.addFuncs E.zeroFunc +isoVarN = E.isoVarN E.addFuncs {-# INLINE isoVarN #-} -- | Useful pattern for constructing and deconstructing 'BVar's of @@ -810,6 +885,9 @@ -- constructor now holds a @'BVar' s Double@ and a @BVar s [Double]@, -- instead of just a normal 'Double' and @[Double]@. -- +-- Note that access using 'splitBV' and pattern matching is slightly slower +-- than access using lenses (by about 10-20%). +-- -- With this trick, 'joinBV' can also be used, with the type: -- -- @ @@ -843,14 +921,33 @@ -- fields are all instances of 'Backprop', where the type itself has an -- instance of 'Backprop'. The type also must derive 'Generic'. -- --- Note that 'BV' is a pattern synonym version where the deconstructor is +-- Note that access using 'splitBV' and pattern matching is slightly slower +-- than access using lenses (by about 10-20%). +-- +-- See also 'BV', pattern synonym version where the deconstructor is -- exactly a view into 'splitBV'. -- +-- __NOTE__: Like '^^.' and 'viewVar', 'splitBV' usage could potentially be +-- the main source of performance overhead in your program. If your data +-- type has \(n\) fields, and you use 'splitBV' to later use \(m\) of those +-- fields, there is an overhead cost on the order of \(\mathcal{O}(m n)\), +-- with a constant factor dependent on the cost of 'add' for your original +-- data type. Should be negligible for types with cheap 'add' (like +-- 'Double'), but may be costly for things like large matrices. See +-- for +-- for details. +-- +-- However, there is some potential opportunities to re-write some core +-- library functionality that would allow 'splitBV' to avoid all of the +-- significant performance overhead issues of '^^.'. Contact me if you are +-- interested in helping out! +-- -- @since 0.2.2.0 splitBV :: ( Generic (z f) , Generic (z (BVar s)) , E.BVGroup s as (Rep (z f)) (Rep (z (BVar s))) + , Backprop (z f) , Backprop (Rep (z f) ()) , Every Backprop as , Known Length as @@ -873,15 +970,20 @@ -- fields are all instances of 'Backprop', where the type itself has an -- instance of 'Backprop'. -- --- Note that 'BV' is a pattern synonym version where the constructor is +-- See also 'BV', a pattern synonym version where the constructor is -- exactly 'joinBV'. -- +-- Note that 'joinBV' does not suffer the major performance overhead issues +-- of 'splitBV'. This is a general property of reverse-mode automatic +-- differentiation: "many to one" is cheap, but "one to many" is expensive. +-- -- @since 0.2.2.0 joinBV :: ( Generic (z f) , Generic (z (BVar s)) , E.BVGroup s as (Rep (z f)) (Rep (z (BVar s))) , Backprop (z f) + , Backprop (Rep (z f) ()) , Every Backprop as , Known Length as , Reifies s W diff --git a/src/Numeric/Backprop/Class.hs b/src/Numeric/Backprop/Class.hs --- a/src/Numeric/Backprop/Class.hs +++ b/src/Numeric/Backprop/Class.hs @@ -13,6 +13,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -37,17 +38,18 @@ Backprop(..) -- * Derived methods , zeroNum, addNum, oneNum - , zeroVec, addVec, oneVec + , zeroVec, addVec, oneVec, zeroVecNum, oneVecNum , zeroFunctor, addIsList, addAsList, oneFunctor , genericZero, genericAdd, genericOne -- * Newtype - , ABP(..), NumBP(..) + , ABP(..), NumBP(..), NumVec(..) -- * Generics , GZero, GAdd, GOne ) where import Control.Applicative import Control.DeepSeq +import Control.Monad import Data.Coerce import Data.Complex import Data.Data @@ -62,6 +64,7 @@ import Data.Type.Product hiding (toList) import Data.Void import Data.Word +import Debug.SimpleReflect.Expr import GHC.Exts import GHC.Generics import Numeric.Natural @@ -129,6 +132,10 @@ -- -- * @'one' '.' 'one' = 'one'@ -- +-- [/unital/] +-- +-- * @'one' = 'gradBP' 'id'@ +-- -- 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 @@ -174,7 +181,7 @@ -- 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 + -- 'addIsList' for a definition for instances of 'IsList'. 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'. @@ -183,8 +190,15 @@ -- just be @'const' 1@. For vectors and matrices, this should set all -- components to one, the multiplicative identity. -- - -- Should be idempotent: + -- As the library uses it, the most important law is: -- + -- * @'one' = 'gradBP' 'id'@ + -- + -- That is, @'one' x@ is the gradient of the identity function with + -- respect to its input. + -- + -- Ideally should be idempotent: + -- -- * @'one' '.' 'one' = 'one'@ -- -- Should be as /lazy/ as possible. This behavior is observed for @@ -267,6 +281,30 @@ oneVec = VG.map one {-# INLINE oneVec #-} +-- | 'zero' for instances of 'VG.Vector' when the contained type is an +-- instance of 'Num'. Is potentially more performant than 'zeroVec' when +-- the vectors are larger. +-- +-- See 'NumVec' for a 'Backprop' instance for 'VG.Vector' instances that +-- uses this for 'zero'. +-- +-- @since 0.2.4.0 +zeroVecNum :: (VG.Vector v a, Num a) => v a -> v a +zeroVecNum = flip VG.replicate 0 . VG.length +{-# INLINE zeroVecNum #-} + +-- | 'one' for instances of 'VG.Vector' when the contained type is an +-- instance of 'Num'. Is potentially more performant than 'oneVec' when +-- the vectors are larger. +-- +-- See 'NumVec' for a 'Backprop' instance for 'VG.Vector' instances that +-- uses this for 'one'. +-- +-- @since 0.2.4.0 +oneVecNum :: (VG.Vector v a, Num a) => v a -> v a +oneVecNum = flip VG.replicate 1 . VG.length +{-# INLINE oneVecNum #-} + -- | 'zero' for 'Functor' instances. zeroFunctor :: (Functor f, Backprop a) => f a -> f a zeroFunctor = fmap zero @@ -313,17 +351,55 @@ instance Applicative NumBP where pure = NumBP + {-# INLINE pure #-} f <*> x = NumBP $ (runNumBP f) (runNumBP x) + {-# INLINE (<*>) #-} instance Monad NumBP where return = NumBP + {-# INLINE return #-} x >>= f = f (runNumBP x) + {-# INLINE (>>=) #-} instance Num a => Backprop (NumBP a) where zero = coerce (zeroNum :: a -> a) + {-# INLINE zero #-} add = coerce (addNum :: a -> a -> a) + {-# INLINE add #-} one = coerce (oneNum :: a -> a) + {-# INLINE one #-} +-- | Newtype wrapper around a @v a@ for @'VG.Vector' v a@, that gives +-- a more efficient 'Backprop' instance for /long/ vectors when @a@ is an +-- instance of 'Num'. The normal 'Backprop' instance for vectors will map +-- 'zero' or 'one' over all items; this instance will completely ignore the +-- contents of the original vector and instead produce a new vector of the +-- same length, with all @0@ or @1@ using the 'Num' instance of @a@ +-- (essentially using 'zeroVecNum' and 'oneVecNum' instead of 'zeroVec' and +-- 'oneVec'). +-- +-- 'add' is essentially the same as normal, but using '+' instead of the +-- type's 'add'. +-- +-- @since 0.2.4.0 +newtype NumVec v a = NumVec { runNumVec :: v a } + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic, Functor, Applicative, Monad, Alternative, MonadPlus, Foldable, Traversable) + +instance NFData (v a) => NFData (NumVec v a) + +instance (VG.Vector v a, Num a) => Backprop (NumVec v a) where + zero = coerce $ zeroVecNum @v @a + add (NumVec x) (NumVec y) = NumVec $ case compare lX lY of + LT -> let (y1,y2) = VG.splitAt (lY - lX) y + in VG.zipWith (+) x y1 VG.++ y2 + EQ -> VG.zipWith (+) x y + GT -> let (x1,x2) = VG.splitAt (lX - lY) x + in VG.zipWith (+) x1 y VG.++ x2 + where + lX = VG.length x + lY = VG.length y + one = coerce $ oneVecNum @v @a + -- | A newtype wrapper over an @f a@ for @'Applicative' f@ that gives -- a free 'Backprop' instance (as well as 'Num' etc. instances). -- @@ -332,24 +408,10 @@ -- -- @since 0.2.1.0 newtype ABP f a = ABP { runABP :: f a } - deriving (Show, Read, Eq, Ord, Typeable, Data, Generic, Functor, Foldable, Traversable) + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic, Functor, Applicative, Monad, Alternative, MonadPlus, Foldable, Traversable) instance NFData (f a) => NFData (ABP f a) -instance Applicative f => Applicative (ABP f) where - pure = ABP . pure - {-# INLINE pure #-} - f <*> x = ABP $ ($) <$> runABP f <*> runABP x - {-# INLINE (<*>) #-} - -instance Monad m => Monad (ABP m) where - return = ABP . return - {-# INLINE return #-} - x >>= f = ABP $ do - x' <- runABP x - runABP $ f x' - {-# INLINE (>>=) #-} - instance (Applicative f, Backprop a) => Backprop (ABP f a) where zero = fmap zero {-# INLINE zero #-} @@ -1025,11 +1087,11 @@ -- -- @since 0.2.2.0 instance Backprop a => Backprop (r -> a) where - zero = fmap zero + zero = zeroFunctor {-# INLINE zero #-} add = liftA2 add {-# INLINE add #-} - one = fmap one + one = oneFunctor {-# INLINE one #-} -- | @since 0.2.2.0 @@ -1039,4 +1101,13 @@ add (Arr.Kleisli f) (Arr.Kleisli g) = Arr.Kleisli $ \x -> add <$> f x <*> g x one (Arr.Kleisli f) = Arr.Kleisli ((fmap . fmap) one f) + {-# INLINE one #-} + +-- | @since 0.2.4.0 +instance Backprop Expr where + zero = zeroNum + {-# INLINE zero #-} + add = addNum + {-# INLINE add #-} + one = oneNum {-# INLINE one #-} diff --git a/src/Numeric/Backprop/Explicit.hs b/src/Numeric/Backprop/Explicit.hs --- a/src/Numeric/Backprop/Explicit.hs +++ b/src/Numeric/Backprop/Explicit.hs @@ -27,7 +27,7 @@ -- "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' +-- 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. @@ -35,6 +35,11 @@ -- See "Numeric.Backprop" for fuller documentation on using these -- functions. -- +-- WARNING: API of this module can be considered only "semi-stable"; while +-- the API of "Numeric.Backprop" and "Numeric.Backprop.Num" are kept +-- consistent, some argument order changes might happen in this module to +-- reflect changes in underlying implementation. +-- -- @since 0.2.0.0 module Numeric.Backprop.Explicit ( @@ -52,7 +57,7 @@ , backpropN, evalBPN, gradBPN, backpropWithN, Every -- * Manipulating 'BVar' , constVar, auto, coerceVar - , viewVar, setVar + , viewVar, setVar, overVar , sequenceVar, collectVar , previewVar, toListOfVar -- ** With Isomorphisms @@ -164,41 +169,41 @@ auto = constVar {-# INLINE auto #-} --- | 'Numeric.Backprop.backpropWithN', but with explicit 'zero'. --- --- Note that argument order changed in v0.2.3. --- --- @since 0.2.0.0 -backpropWithN - :: Prod ZeroFunc as +-- | 'Numeric.Backprop.backpropN', but with explicit 'zero' and 'one'. +backpropN + :: forall as b. () + => Prod ZeroFunc as + -> OneFunc b -> (forall s. Reifies s W => Prod (BVar s) as -> BVar s b) -> Tuple as - -> (b, (b -> b) -> Tuple as) -- ^ Takes function giving gradient of final result given the output of function -backpropWithN zfs f = second (. OF) . backpropN zfs f -{-# INLINE backpropWithN #-} + -> (b, Tuple as) +backpropN zfs ob f xs = case backpropWithN zfs f xs of + (y, g) -> (y, g (runOF ob y)) +{-# INLINE backpropN #-} -- | 'Numeric.Backprop.backprop', but with explicit 'zero' and 'one'. --- --- Note that argument order changed in v0.2.3. backprop :: ZeroFunc a + -> OneFunc b -> (forall s. Reifies s W => BVar s a -> BVar s b) -> a - -> (b, OneFunc b -> a) -backprop zfa f = second ((getI . head') .) - . backpropN (zfa :< Ø) (f . head') - . only_ + -> (b, a) +backprop zfa ofb f = second (getI . head') + . backpropN (zfa :< Ø) ofb (f . head') + . only_ {-# INLINE backprop #-} -- | 'Numeric.Backprop.backpropWith', but with explicit 'zero'. -- --- Note that argument order changed in v0.2.3. +-- Note that argument order changed in v0.2.4. backpropWith :: ZeroFunc a -> (forall s. Reifies s W => BVar s a -> BVar s b) -> a - -> (b, (b -> b) -> a) -- ^ Takes function giving gradient of final result given the output of function -backpropWith zfa f = second (. OF) . backprop zfa f + -> (b, b -> a) +backpropWith zfa f = second ((getI . head') .) + . backpropWithN (zfa :< Ø) (f . head') + . only_ {-# INLINE backpropWith #-} -- | 'evalBP' but with no arguments. Useful when everything is just given @@ -226,7 +231,7 @@ -> (forall s. Reifies s W => BVar s a -> BVar s b) -> a -> a -gradBP zfa ofb f = ($ ofb) . snd . backprop zfa f +gradBP zfa ofb f = snd . backprop zfa ofb f {-# INLINE gradBP #-} -- | 'Numeric.Backprop.gradBP', Nbut with explicit 'zero' and 'one'. @@ -236,28 +241,27 @@ -> (forall s. Reifies s W => Prod (BVar s) as -> BVar s b) -> Tuple as -> Tuple as -gradBPN zfas ofb f = ($ ofb) . snd . backpropN zfas f +gradBPN zfas ofb f = snd . backpropN zfas ofb f {-# INLINE gradBPN #-} -- | 'Numeric.Backprop.backprop2', but with explicit 'zero' and 'one'. --- --- Note that argument order changed in v0.2.3. backprop2 :: ZeroFunc a -> ZeroFunc b + -> OneFunc c -> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c) -> a -> b - -> (c, OneFunc c -> (a, b)) -backprop2 zfa zfb f x y = second ((\(dx ::< dy ::< Ø) -> (dx, dy)) .) $ - backpropN (zfa :< zfb :< Ø) + -> (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'. -- --- Note that argument order changed in v0.2.3. +-- Note that argument order changed in v0.2.4. -- -- @since 0.2.0.0 backpropWith2 @@ -266,8 +270,11 @@ -> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c) -> a -> b - -> (c, (c -> c) -> (a, b)) -- ^ Takes function giving gradient of final result given the output of function -backpropWith2 zfa zfb f x = second (. OF) . backprop2 zfa zfb f x + -> (c, c -> (a, b)) +backpropWith2 zfa zfb f x y = second ((\(dx ::< dy ::< Ø) -> (dx, dy)) .) $ + backpropWithN (zfa :< zfb :< Ø) + (\(x' :< y' :< Ø) -> f x' y') + (x ::< y ::< Ø) {-# INLINE backpropWith2 #-} -- | 'evalBP' for a two-argument function. See @@ -290,19 +297,34 @@ -> a -> b -> (a, b) -gradBP2 zfa zfb ofc f x = ($ ofc) . snd . backprop2 zfa zfb f x +gradBP2 zfa zfb ofc f x = snd . backprop2 zfa zfb ofc f x {-# INLINE gradBP2 #-} +-- | 'Numeric.Backprop.overVar' with explicit 'add' and 'zero'. +-- +-- @since 0.2.4.0 +overVar + :: Reifies s W + => AddFunc a + -> AddFunc b + -> ZeroFunc a + -> ZeroFunc b + -> Lens' b a + -> (BVar s a -> BVar s a) + -> BVar s b + -> BVar s b +overVar afa afb zfa zfb l f x = setVar afa afb zfa l (f (viewVar afa zfb l x)) x +{-# INLINE overVar #-} + -- | '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) +isoVar af f g = liftOp1 af (opIso f g) {-# INLINE isoVar #-} -- | 'Numeric.Backprop.isoVar2' with explicit 'add' and 'zero'. @@ -310,13 +332,12 @@ :: 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) +isoVar2 afa afb f g = liftOp2 afa afb (opIso2 f g) {-# INLINE isoVar2 #-} -- | 'Numeric.Backprop.isoVar3' with explicit 'add' and 'zero'. @@ -325,26 +346,24 @@ => 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) +isoVar3 afa afb afc f g = liftOp3 afa afb afc (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) +isoVarN afs f g = liftOp afs (opIsoN f g) {-# INLINE isoVarN #-} -- | Helper class for generically "splitting" and "joining" 'BVar's into @@ -400,15 +419,15 @@ where (afas, afbs) = splitProd known afs (zfas, zfbs) = splitProd known zfs - x = gsplitBV afas zfas . viewVar afa zfa p1 $ xy - y = gsplitBV afbs zfbs . viewVar afb zfb p2 $ xy + zfab = ZF $ \(xx :*: yy) -> runZF zfa xx :*: runZF zfb yy + x = gsplitBV afas zfas . viewVar afa zfab p1 $ xy + y = gsplitBV afbs zfbs . viewVar afb zfab p2 $ xy {-# INLINE gsplitBV #-} - gjoinBV (afa :< afb :< afs) (zfa :< zfb :< zfs) (x :*: y) - = isoVar2 afa afb zfab (:*:) unP + gjoinBV (afa :< afb :< afs) (_ :< _ :< zfs) (x :*: y) + = isoVar2 afa afb (:*:) unP (gjoinBV afas zfas x) (gjoinBV afbs zfbs y) where - zfab = ZF $ \(xx :*: yy) -> runZF zfa xx :*: runZF zfb yy (afas, afbs) = splitProd known afs (zfas, zfbs) = splitProd known zfs unP (xx :*: yy) = (xx, yy) @@ -422,26 +441,26 @@ , Known Length as ) => BVGroup s (i1 () ': i2 () ': cs) (i1 :+: i2) (o1 :+: o2) where gsplitBV (afa :< afb :< afs) (zfa :< zfb :< zfs) xy = - case previewVar afa zfa s1 xy of + case previewVar afa zf s1 xy of Just x -> L1 $ gsplitBV afas zfas x - Nothing -> case previewVar afb zfb s2 xy of + Nothing -> case previewVar afb zf s2 xy of Just y -> R1 $ gsplitBV afbs zfbs y Nothing -> error "Numeric.Backprop.gsplitBV: Internal error occurred" where + zf = ZF $ \case + L1 xx -> L1 $ runZF zfa xx + R1 yy -> R1 $ runZF zfb yy (afas, afbs) = splitProd known afs (zfas, zfbs) = splitProd known zfs {-# INLINE gsplitBV #-} gjoinBV (afa :< afb :< afs) (zfa :< zfb :< zfs) = \case - L1 x -> liftOp1 afa zf (op1 (\xx -> (L1 xx, \case L1 d -> d; R1 _ -> runZF zfa xx))) + L1 x -> liftOp1 afa (op1 (\xx -> (L1 xx, \case L1 d -> d; R1 _ -> runZF zfa xx))) (gjoinBV afas zfas x) - R1 y -> liftOp1 afb zf (op1 (\yy -> (R1 yy, \case L1 _ -> runZF zfb yy; R1 d -> d))) + R1 y -> liftOp1 afb (op1 (\yy -> (R1 yy, \case L1 _ -> runZF zfb yy; R1 d -> d))) (gjoinBV afbs zfbs y) where (afas, afbs) = splitProd known afs (zfas, zfbs) = splitProd known zfs - zf = ZF $ \case - L1 xx -> L1 $ runZF zfa xx - R1 yy -> R1 $ runZF zfb yy {-# INLINE gjoinBV #-} -- | 'Numeric.Backprop.splitBV' with explicit 'add' and 'zero'. @@ -456,7 +475,7 @@ ) => AddFunc (Rep (z f) ()) -> Prod AddFunc as - -> ZeroFunc (Rep (z f) ()) + -> ZeroFunc (z f) -> Prod ZeroFunc as -> BVar s (z f) -- ^ 'BVar' of value -> z (BVar s) -- ^ 'BVar's of fields @@ -478,7 +497,7 @@ ) => AddFunc (z f) -> Prod AddFunc as - -> ZeroFunc (z f) + -> ZeroFunc (Rep (z f) ()) -> Prod ZeroFunc as -> z (BVar s) -- ^ 'BVar's of fields -> BVar s (z f) -- ^ 'BVar' of combined value diff --git a/src/Numeric/Backprop/Internal.hs b/src/Numeric/Backprop/Internal.hs --- a/src/Numeric/Backprop/Internal.hs +++ b/src/Numeric/Backprop/Internal.hs @@ -4,6 +4,7 @@ {-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -30,7 +31,7 @@ module Numeric.Backprop.Internal ( BVar , W - , backpropN, evalBPN + , backpropWithN, evalBPN , constVar , liftOp, liftOp1, liftOp2, liftOp3 , viewVar, setVar, sequenceVar, collectVar, previewVar, toListOfVar @@ -47,7 +48,6 @@ import Control.DeepSeq import Control.Exception import Control.Monad -import Control.Monad.Primitive import Control.Monad.ST import Control.Monad.Trans.State import Data.Bifunctor @@ -68,6 +68,7 @@ import GHC.Exts (Any) import GHC.Generics as G import Lens.Micro +import Lens.Micro.Extras import Numeric.Backprop.Class import Numeric.Backprop.Op import System.IO.Unsafe @@ -171,7 +172,7 @@ -- using 'Numeric.Backprop.liftOp' and related functions. This is how you -- can create primitive functions that users can use to manipulate your -- library's values. See --- for a detailed +-- for a detailed -- guide. -- -- For example, the /hmatrix/ library has a matrix-vector multiplication @@ -213,13 +214,14 @@ {-# INLINE forceBVar #-} data InpRef :: Type -> Type where - IR :: { _irIx :: !(BVar s b) - , _irAdd :: !(a -> b -> b) + IR :: { _irIx :: !(BVar s b) + , _irAdd :: !(a -> b -> b) + , _irEmbed :: !(a -> 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'. @@ -237,14 +239,13 @@ {-# INLINE forceTapeNode #-} data SomeTapeNode :: Type where - STN :: { _stnZero :: a - , _stnNode :: !(TapeNode a) + STN :: { _stnNode :: !(TapeNode a) } -> SomeTapeNode -- | Debugging string for a 'SomeTapeMode'. debugSTN :: SomeTapeNode -> String -debugSTN (STN _ TN{..}) = show . foldMap1 ((:[]) . debugIR) $ _tnInputs +debugSTN (STN TN{..}) = show . foldMap1 ((:[]) . debugIR) $ _tnInputs -- | An ephemeral Wengert Tape in the environment. Used internally to -- track of the computational graph of variables. @@ -260,12 +261,11 @@ insertNode :: TapeNode a -> a -- ^ val - -> ZeroFunc a -> W -> IO (BVar s a) -insertNode tn !x zf !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) -> +insertNode tn !x !w = fmap ((`BV` x) . BRIx) . atomicModifyIORef' (wRef w) $ \(!n,!t) -> let n' = n + 1 - t' = STN (runZF zf x) tn : t + t' = STN tn : t in forceTapeNode tn `seq` n' `seq` t' `seq` ((n', t'), n) {-# INLINE insertNode #-} @@ -280,20 +280,19 @@ liftOp_ :: forall s as b. Reifies s W => Prod AddFunc as - -> ZeroFunc b -> Op as b -> Prod (BVar s) as -> IO (BVar s b) -liftOp_ afs z o !vs = case traverse1 (fmap I . bvConst) vs of +liftOp_ afs o !vs = case traverse1 (fmap I . bvConst) vs of Just xs -> return $ constVar (evalOp o xs) - Nothing -> insertNode tn y z (reflect (Proxy @s)) + Nothing -> insertNode tn y (reflect (Proxy @s)) where (y,g) = runOpWith o (map1 (I . _bvVal) vs) tn = TN { _tnInputs = map1 go (zipP afs vs) , _tnGrad = g } go :: forall a. (AddFunc :&: BVar s) a -> InpRef a - go (af :&: (!v)) = forceBVar v `seq` IR v (runAF af) + go (af :&: (!v)) = forceBVar v `seq` IR v (runAF af) id {-# INLINE go #-} {-# INLINE liftOp_ #-} @@ -301,25 +300,23 @@ liftOp :: forall as b s. Reifies s W => Prod AddFunc as - -> ZeroFunc b -> Op as b -> Prod (BVar s) as -> BVar s b -liftOp afs z o !vs = unsafePerformIO $ liftOp_ afs z o vs +liftOp afs o !vs = unsafePerformIO $ liftOp_ afs o vs {-# INLINE liftOp #-} liftOp1_ :: 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_ af z o v = forceBVar v `seq` insertNode tn y z (reflect (Proxy @s)) +liftOp1_ _ o (bvConst->Just x) = return . constVar . evalOp o $ (x ::< Ø) +liftOp1_ af o v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s)) where (y,g) = runOpWith o (_bvVal v ::< Ø) - tn = TN { _tnInputs = IR v (runAF af) :< Ø + tn = TN { _tnInputs = IR v (runAF af) id :< Ø , _tnGrad = g } {-# INLINE liftOp1_ #-} @@ -328,30 +325,28 @@ liftOp1 :: forall a b s. Reifies s W => AddFunc a - -> ZeroFunc b -> Op '[a] b -> BVar s a -> BVar s b -liftOp1 af z o !v = unsafePerformIO $ liftOp1_ af z o v +liftOp1 af o !v = unsafePerformIO $ liftOp1_ af o v {-# INLINE liftOp1 #-} liftOp2_ :: 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) +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)) +liftOp2_ afa afb o v u = forceBVar v + `seq` forceBVar u + `seq` insertNode tn y (reflect (Proxy @s)) where (y,g) = runOpWith o (_bvVal v ::< _bvVal u ::< Ø) - tn = TN { _tnInputs = IR v (runAF afa) :< IR u (runAF afb) :< Ø + tn = TN { _tnInputs = IR v (runAF afa) id :< IR u (runAF afb) id :< Ø , _tnGrad = g } {-# INLINE liftOp2_ #-} @@ -361,12 +356,11 @@ :: 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 afa afb z o !v !u = unsafePerformIO $ liftOp2_ afa afb z o v u +liftOp2 afa afb o !v !u = unsafePerformIO $ liftOp2_ afa afb o v u {-# INLINE liftOp2 #-} liftOp3_ @@ -374,23 +368,22 @@ => 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_ afa afb afc z o v u w = forceBVar v - `seq` forceBVar u - `seq` forceBVar w - `seq` insertNode tn y z (reflect (Proxy @s)) +liftOp3_ afa afb afc o v u w = forceBVar v + `seq` forceBVar u + `seq` forceBVar w + `seq` insertNode tn y (reflect (Proxy @s)) where (y, g) = runOpWith o (_bvVal v ::< _bvVal u ::< _bvVal w ::< Ø) - tn = TN { _tnInputs = IR v (runAF afa) - :< IR u (runAF afb) - :< IR w (runAF afc) + tn = TN { _tnInputs = IR v (runAF afa) id + :< IR u (runAF afb) id + :< IR w (runAF afc) id :< Ø , _tnGrad = g } @@ -402,27 +395,28 @@ => 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 afa afb afc z o !v !u !w = unsafePerformIO $ liftOp3_ afa afb afc z o v u w +liftOp3 afa afb afc o !v !u !w = unsafePerformIO $ liftOp3_ afa afb afc o v u w {-# INLINE liftOp3 #-} -- TODO: can we get the zero and add func from the bvar? viewVar_ :: forall a b s. Reifies s W => AddFunc a - -> ZeroFunc a + -> ZeroFunc b -> Lens' b a -> BVar s b -> IO (BVar s a) -viewVar_ af z l v = forceBVar v `seq` insertNode tn y z (reflect (Proxy @s)) +viewVar_ af z l v = forceBVar v `seq` insertNode tn y (reflect (Proxy @s)) where - y = _bvVal v ^. l - tn = TN { _tnInputs = IR v (over l . runAF af) :< Ø + x = _bvVal v + y = x ^. l + tn = TN { _tnInputs = IR v (over l . runAF af) (\g -> set l g (runZF z x)) + :< Ø , _tnGrad = only_ } {-# INLINE viewVar_ #-} @@ -431,7 +425,7 @@ viewVar :: forall a b s. Reifies s W => AddFunc a - -> ZeroFunc a + -> ZeroFunc b -> Lens' b a -> BVar s b -> BVar s a @@ -444,17 +438,18 @@ => AddFunc a -> AddFunc b -> ZeroFunc a - -> ZeroFunc b -> Lens' b a -> BVar s a -> BVar s b -> IO (BVar s b) -setVar_ afa afb za zb l w v = forceBVar v - `seq` forceBVar w - `seq` insertNode tn y zb (reflect (Proxy @s)) +setVar_ afa afb za l w v = forceBVar v + `seq` forceBVar w + `seq` insertNode tn y (reflect (Proxy @s)) where y = _bvVal v & l .~ _bvVal w - tn = TN { _tnInputs = IR w (runAF afa) :< IR v (runAF afb) :< Ø + tn = TN { _tnInputs = IR w (runAF afa) id + :< IR v (runAF afb) id + :< Ø , _tnGrad = \d -> let (dw,dv) = l (\x -> (x, runZF za x)) d in dw ::< dv ::< Ø } @@ -466,12 +461,11 @@ => AddFunc a -> AddFunc b -> ZeroFunc a - -> ZeroFunc b -> Lens' b a -> BVar s a -> BVar s b -> BVar s b -setVar afa afb za zb l !w !v = unsafePerformIO $ setVar_ afa afb za zb l w v +setVar afa afb za l !w !v = unsafePerformIO $ setVar_ afa afb za l w v {-# INLINE setVar #-} -- | 'Numeric.Backprop.sequenceVar', but with explicit 'add' and 'zero'. @@ -481,7 +475,8 @@ -> ZeroFunc a -> BVar s (t a) -> t (BVar s a) -sequenceVar af z !v = unsafePerformIO $ traverseVar' af z id traverse v +sequenceVar af z !v = unsafePerformIO $ + traverseVar' af (ZF (fmap (runZF z))) id traverse v {-# INLINE sequenceVar #-} -- TODO: can add funcs and zeros be had from bvars and Functor instance? @@ -494,26 +489,16 @@ collectVar_ af z !vs = withV (toList vs) $ \(vVec :: Vec n (BVar s a)) -> do let tn :: TapeNode (t a) tn = TN - { _tnInputs = vecToProd (vmap ((`IR` runAF af) . getI) vVec) + { _tnInputs = vecToProd (vmap ((\v -> IR v (runAF af) id) . getI) vVec) , _tnGrad = vecToProd . zipVecList (\(I v) -> I . fromMaybe (runZF z (_bvVal v))) vVec . toList } traverse_ (evaluate . forceBVar) vs - insertNode tn (_bvVal <$> vs) (ZF $ fmap (runZF z)) (reflect (Proxy @s)) + insertNode tn (_bvVal <$> vs) (reflect (Proxy @s)) {-# INLINE collectVar_ #-} -- | 'Numeric.Backprop.collectVar', but with explicit 'add' and 'zero'. --- --- NOTE: Prior to v0.2.3, this required an extra @'ZeroFunc' (t a)@ input. --- However, after v0.2.3, the 'ZeroFunc' is now derived from the 'Functor' --- instance of @t@. This makes the API a little more convenient, and it --- enforces consistency with the @'ZeroFunc' a@, so people can't pass in --- nonsense combinations. --- --- Please submit an issue to the issue tracker if you find yourself in --- a situation where you need the flexibility to provide a separte --- @'ZeroFunc' a@ and @'ZeroFunc' (t a)@. collectVar :: forall t a s. (Reifies s W, Foldable t, Functor t) => AddFunc a @@ -526,18 +511,21 @@ traverseVar' :: forall b a f s. (Reifies s W, Traversable f) => AddFunc a - -> ZeroFunc a + -> ZeroFunc b -> (b -> f a) -> Traversal' b a -> BVar s b -> IO (f (BVar s a)) traverseVar' af z f t v = forceBVar v - `seq` itraverse go (f (_bvVal v)) + `seq` itraverse go (f x) where + x = _bvVal v go :: Int -> a -> IO (BVar s a) - go i y = insertNode tn y z (reflect (Proxy @s)) + go i y = insertNode tn y (reflect (Proxy @s)) where - tn = TN { _tnInputs = IR v (over (ixt t i) . runAF af) :< Ø + tn = TN { _tnInputs = IR v (over (ixt t i) . runAF af) + (\g -> set (ixt t i) g (runZF z x)) + :< Ø , _tnGrad = only_ } {-# INLINE go #-} @@ -547,22 +535,24 @@ previewVar :: forall b a s. Reifies s W => AddFunc a - -> ZeroFunc a + -> ZeroFunc b -> Traversal' b a -> BVar s b -> Maybe (BVar s a) -previewVar af z t !v = unsafePerformIO $ traverseVar' af z (listToMaybe . toListOf t) t v +previewVar af z t !v = unsafePerformIO $ + traverseVar' af z (preview t) t v {-# INLINE previewVar #-} -- | 'Numeric.Backprop.toListOfVar', but with explicit 'add' and 'zero'. toListOfVar :: forall b a s. Reifies s W => AddFunc a - -> ZeroFunc a + -> ZeroFunc b -> Traversal' b a -> BVar s b -> [BVar s a] -toListOfVar af z t !v = unsafePerformIO $ traverseVar' af z (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. @@ -574,19 +564,18 @@ -> BVar s b coerceVar v@(BV r x) = forceBVar v `seq` BV r (coerce x) -data Runner s = R { _rDelta :: !(MV.MVector s Any) - , _rInputs :: !(MV.MVector s Any) +data Runner s = R { _rDelta :: !(MV.MVector s (Maybe Any)) + , _rInputs :: !(MV.MVector s (Maybe Any)) } initRunner - :: (PrimMonad m, PrimState m ~ s) - => (Int, [SomeTapeNode]) - -> (Int, [Any]) - -> m (Runner s) + :: (Int, [SomeTapeNode]) + -> (Int, [Maybe Any]) + -> ST s (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 + for_ (zip [n-1,n-2..] stns) $ \(i, STN (TN{..} :: TapeNode c)) -> + MV.write delts i $ unsafeCoerce (Nothing @c) inps <- MV.new nx for_ (zip [0..] xs) . uncurry $ \i z -> MV.write inps i z @@ -594,58 +583,76 @@ {-# INLINE initRunner #-} gradRunner - :: forall m b s. (PrimMonad m, PrimState m ~ s) + :: forall b s. () => b -- ^ one -> Runner s -> (Int, [SomeTapeNode]) - -> m () + -> ST s () gradRunner o R{..} (n,stns) = do when (n > 0) $ - MV.write _rDelta (n - 1) (unsafeCoerce o) + MV.write _rDelta (n - 1) (unsafeCoerce (Just o)) zipWithM_ go [n-1,n-2..] stns where - go :: Int -> SomeTapeNode -> m () - go i (STN _ TN{..}) = do + go :: Int -> SomeTapeNode -> ST s () + go i (STN (TN{..} :: TapeNode c)) = do delt <- MV.read _rDelta i - let gs = _tnGrad (unsafeCoerce delt) - zipWithPM_ propagate _tnInputs gs + forM_ delt $ \d -> do + let gs = _tnGrad (unsafeCoerce d) + zipWithPM_ propagate _tnInputs gs {-# INLINE go #-} - propagate :: forall x. InpRef x -> I x -> m () - propagate (IR v (+*)) (I d) = case _bvRef v of + propagate :: forall x. InpRef x -> I x -> ST s () + propagate (IR v (+*) e) (I d) = case _bvRef v of BRInp i -> flip (MV.modify _rInputs) i $ - unsafeCoerce . (d +*) . unsafeCoerce + unsafeCoerce . bumpMaybe d (+*) e . unsafeCoerce BRIx i -> flip (MV.modify _rDelta) i $ - unsafeCoerce . (d +*) . unsafeCoerce + unsafeCoerce . bumpMaybe d (+*) e . unsafeCoerce BRC -> return () {-# INLINE propagate #-} {-# INLINE gradRunner #-} --- | 'Numeric.Backprop.backpropN', but with explicit 'zero' and 'one'. +bumpMaybe + :: a -- ^ val + -> (a -> b -> b) -- ^ add + -> (a -> b) -- ^ embed + -> Maybe b + -> Maybe b +bumpMaybe x (+*) e = \case + Nothing -> Just (e x) + Just y -> Just (x +* y) +{-# INLINE bumpMaybe #-} + +-- | 'Numeric.Backprop.backpropWithN', but with explicit 'zero' and 'one'. -- --- Note that argument order changed in v0.2.3. -backpropN +-- Note that argument order changed in v0.2.4. +-- +-- @since 0.2.0.0 +backpropWithN :: forall as b. () => Prod ZeroFunc as -> (forall s. Reifies s W => Prod (BVar s) as -> BVar s b) -> Tuple as - -> (b, OneFunc b -> Tuple as) -backpropN zfs f !xs = (y, g) + -> (b, b -> Tuple as) +backpropWithN zfs f !xs = (y, g) where !(!tp@(!_,!_),!y) = unsafePerformIO $ fillWengert f xs - g :: OneFunc b -> Tuple as - g ofb = runST $ do + g :: b -> Tuple as + g o = runST $ do r <- initRunner tp $ bimap getSum (`appEndo` []) . fst - $ zipWithPM_ go zfs xs - gradRunner (runOF ofb y) r tp + $ traverse1_ go xs + -- zipWithPM_ go zfs xs + gradRunner o r tp delts <- toList <$> V.freeze (_rInputs r) return . fromMaybe (internalError "backpropN") $ - fillProd (\_ d -> I (unsafeCoerce d)) xs delts + fillProd (\(zf :&: I x) d -> I $ maybe (runZF zf x) unsafeCoerce d + ) + (zipP zfs xs) + delts where - go :: forall a. ZeroFunc a -> I a -> ((Sum Int, Endo [Any]),()) - go zf (I x) = ((1, Endo (unsafeCoerce (runZF zf x) :)), ()) + go :: forall a. I a -> ((Sum Int, Endo [Maybe Any]),()) + go _ = ((1, Endo (unsafeCoerce (Nothing @a) :)), ()) {-# INLINE go #-} -{-# INLINE backpropN #-} +{-# INLINE backpropWithN #-} -- | 'evalBP' generalized to multiple inputs of different types. See -- documentation for 'Numeric.Backprop.backpropN' for more details. @@ -682,25 +689,25 @@ instance (Num a, Reifies s W) => Num (BVar s a) where - (+) = liftOp2 afNum afNum zfNum (+.) + (+) = liftOp2 afNum afNum (+.) {-# INLINE (+) #-} - (-) = liftOp2 afNum afNum zfNum (-.) + (-) = liftOp2 afNum afNum (-.) {-# INLINE (-) #-} - (*) = liftOp2 afNum afNum zfNum (*.) + (*) = liftOp2 afNum afNum (*.) {-# INLINE (*) #-} - negate = liftOp1 afNum zfNum negateOp + negate = liftOp1 afNum negateOp {-# INLINE negate #-} - signum = liftOp1 afNum zfNum signumOp + signum = liftOp1 afNum signumOp {-# INLINE signum #-} - abs = liftOp1 afNum zfNum absOp + abs = liftOp1 afNum absOp {-# INLINE abs #-} fromInteger = constVar . fromInteger {-# INLINE fromInteger #-} instance (Fractional a, Reifies s W) => Fractional (BVar s a) where - (/) = liftOp2 afNum afNum zfNum (/.) + (/) = liftOp2 afNum afNum (/.) {-# INLINE (/) #-} - recip = liftOp1 afNum zfNum recipOp + recip = liftOp1 afNum recipOp {-# INLINE recip #-} fromRational = constVar . fromRational {-# INLINE fromRational #-} @@ -708,39 +715,39 @@ instance (Floating a, Reifies s W) => Floating (BVar s a) where pi = constVar pi {-# INLINE pi #-} - exp = liftOp1 afNum zfNum expOp + exp = liftOp1 afNum expOp {-# INLINE exp #-} - log = liftOp1 afNum zfNum logOp + log = liftOp1 afNum logOp {-# INLINE log #-} - sqrt = liftOp1 afNum zfNum sqrtOp + sqrt = liftOp1 afNum sqrtOp {-# INLINE sqrt #-} - (**) = liftOp2 afNum afNum zfNum (**.) + (**) = liftOp2 afNum afNum (**.) {-# INLINE (**) #-} - logBase = liftOp2 afNum afNum zfNum logBaseOp + logBase = liftOp2 afNum afNum logBaseOp {-# INLINE logBase #-} - sin = liftOp1 afNum zfNum sinOp + sin = liftOp1 afNum sinOp {-# INLINE sin #-} - cos = liftOp1 afNum zfNum cosOp + cos = liftOp1 afNum cosOp {-# INLINE cos #-} - tan = liftOp1 afNum zfNum tanOp + tan = liftOp1 afNum tanOp {-# INLINE tan #-} - asin = liftOp1 afNum zfNum asinOp + asin = liftOp1 afNum asinOp {-# INLINE asin #-} - acos = liftOp1 afNum zfNum acosOp + acos = liftOp1 afNum acosOp {-# INLINE acos #-} - atan = liftOp1 afNum zfNum atanOp + atan = liftOp1 afNum atanOp {-# INLINE atan #-} - sinh = liftOp1 afNum zfNum sinhOp + sinh = liftOp1 afNum sinhOp {-# INLINE sinh #-} - cosh = liftOp1 afNum zfNum coshOp + cosh = liftOp1 afNum coshOp {-# INLINE cosh #-} - tanh = liftOp1 afNum zfNum tanhOp + tanh = liftOp1 afNum tanhOp {-# INLINE tanh #-} - asinh = liftOp1 afNum zfNum asinhOp + asinh = liftOp1 afNum asinhOp {-# INLINE asinh #-} - acosh = liftOp1 afNum zfNum acoshOp + acosh = liftOp1 afNum acoshOp {-# INLINE acosh #-} - atanh = liftOp1 afNum zfNum atanhOp + atanh = liftOp1 afNum atanhOp {-# INLINE atanh #-} -- | Compares the values inside the 'BVar'. @@ -789,14 +796,14 @@ -- | @since 0.2.2.0 instance (Backprop a, Reifies s W) => Backprop (BVar s a) where - zero = liftOp1 addFunc zeroFunc . op1 $ \x -> (zero x, zero) + zero = liftOp1 addFunc . op1 $ \x -> (zero x, zero) {-# INLINE zero #-} - add = liftOp2 addFunc addFunc zeroFunc . op2 $ \x y -> + add = liftOp2 addFunc addFunc . op2 $ \x y -> ( add x y , \d -> (d, d) ) {-# INLINE add #-} - one = liftOp1 addFunc zeroFunc . op1 $ \x -> (one x, zero) + one = liftOp1 addFunc . op1 $ \x -> (one x, zero) {-# INLINE one #-} -- | The canonical 'ZeroFunc' for instances of 'Backprop'. diff --git a/src/Numeric/Backprop/Num.hs b/src/Numeric/Backprop/Num.hs --- a/src/Numeric/Backprop/Num.hs +++ b/src/Numeric/Backprop/Num.hs @@ -59,8 +59,8 @@ , backpropN, E.evalBPN, gradBPN, backpropWithN, Every -- * Manipulating 'BVar' , E.constVar, E.auto, E.coerceVar - , (^^.), (.~~), (^^?), (^^..), (^^?!) - , viewVar, setVar + , (^^.), (.~~), (%~~), (^^?), (^^..), (^^?!) + , viewVar, setVar, overVar , sequenceVar, collectVar , previewVar, toListOfVar -- ** With Isomorphisms @@ -88,7 +88,6 @@ , Reifies ) where -import Data.Bifunctor import Data.Maybe import Data.Reflection import Data.Type.Index @@ -115,7 +114,7 @@ => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b) -> Tuple as -> (b, Tuple as) -backpropN f = second ($ E.ofNum) . E.backpropN E.zfNums f +backpropN = E.backpropN E.zfNums E.ofNum {-# INLINE backpropN #-} -- | 'Numeric.Backprop.backpropWithN', but with 'Num' constraints instead @@ -123,14 +122,14 @@ -- -- See 'backpropN' for information on the 'Every' constraint. -- --- Note that argument order changed in v0.2.3. +-- Note that argument order changed in v0.2.4. -- -- @since 0.2.0.0 backpropWithN :: (Every Num as, Known Length as) => (forall s. Reifies s W => Prod (BVar s) as -> BVar s b) -> Tuple as - -> (b, (b -> b) -> Tuple as) -- ^ Takes function giving gradient of final result given the output of function + -> (b, b -> Tuple as) backpropWithN = E.backpropWithN E.zfNums {-# INLINE backpropWithN #-} @@ -144,7 +143,7 @@ => (forall s. Reifies s W => BVar s a -> BVar s b) -> a -> (b, a) -backprop f = second ($ E.ofNum) . E.backprop E.zfNum f +backprop = E.backprop E.zfNum E.ofNum {-# INLINE backprop #-} -- | 'Numeric.Backprop.backpropWith', but with 'Num' constraints instead of @@ -153,14 +152,14 @@ -- See module documentation for "Numeric.Backprop.Num" for information on -- using this with tuples. -- --- Note that argument order changed in v0.2.3. +-- Note that argument order changed in v0.2.4. -- -- @since 0.2.0.0 backpropWith :: Num a => (forall s. Reifies s W => BVar s a -> BVar s b) -> a - -> (b, (b -> b) -> a) -- ^ Takes function giving gradient of final result given the output of function + -> (b, b -> a) backpropWith = E.backpropWith E.zfNum {-# INLINE backpropWith #-} @@ -192,13 +191,13 @@ -> a -> b -> (c, (a, b)) -backprop2 f x = second ($ E.ofNum) . E.backprop2 E.zfNum E.zfNum f x +backprop2 = E.backprop2 E.zfNum E.zfNum E.ofNum {-# INLINE backprop2 #-} -- | 'Numeric.Backprop.backpropWith2', but with 'Num' constraints instead of -- 'Backprop' constraints. -- --- Note that argument order changed in v0.2.3. +-- Note that argument order changed in v0.2.4. -- -- @since 0.2.0.0 backpropWith2 @@ -206,7 +205,7 @@ => (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c) -> a -> b - -> (c, (c -> c) -> (a, b)) -- ^ Takes function giving gradient of final result given the output of function + -> (c, c -> (a, b)) -- ^ Takes function giving gradient of final result given the output of function backpropWith2 = E.backpropWith2 E.zfNum E.zfNum {-# INLINE backpropWith2 #-} @@ -224,7 +223,7 @@ -- | 'Numeric.Backprop.^^.', but with 'Num' constraints instead of -- 'Backprop' constraints. (^^.) - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num a, Num b, Reifies s W) => BVar s b -> Lens' b a -> BVar s a @@ -235,7 +234,7 @@ -- | 'Numeric.Backprop.viewVar', but with 'Num' constraints instead of -- 'Backprop' constraints. viewVar - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num a, Num b, Reifies s W) => Lens' b a -> BVar s b -> BVar s a @@ -263,9 +262,37 @@ -> BVar s a -> BVar s b -> BVar s b -setVar = E.setVar E.afNum E.afNum E.zfNum E.zfNum +setVar = E.setVar E.afNum E.afNum E.zfNum {-# INLINE setVar #-} +-- | 'Numeric.Backprop.%~~', but with 'Num' constraints instead of +-- 'Backprop' constraints. +-- +-- @since 0.2.4.0 +-- +(%~~) + :: (Num a, Num b, Reifies s W) + => Lens' b a + -> (BVar s a -> BVar s a) + -> BVar s b + -> BVar s b +l %~~ f = overVar l f +infixr 4 %~~ +{-# INLINE (%~~) #-} + +-- | 'Numeric.Backprop.overVar', but with 'Num' constraints instead of +-- 'Backprop' constraints. +-- +-- @since 0.2.4.0 +overVar + :: (Num a, Num b, Reifies s W) + => Lens' b a + -> (BVar s a -> BVar s a) + -> BVar s b + -> BVar s b +overVar = E.overVar E.afNum E.afNum E.zfNum E.zfNum +{-# INLINE overVar #-} + -- | 'Numeric.Backprop.^^?', but with 'Num' constraints instead of -- 'Backprop' constraints. -- @@ -285,11 +312,12 @@ -- myPrism . 'iso' 'tupT2' 't2Tup' :: 'Prism'' c ('T2' a b) -- @ (^^?) - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num b, Num a, Reifies s W) => BVar s b -> Traversal' b a -> Maybe (BVar s a) v ^^? t = previewVar t v +infixl 8 ^^? {-# INLINE (^^?) #-} -- | 'Numeric.Backprop.^^?!', but with 'Num' constraints instead of @@ -299,13 +327,14 @@ -- -- @since 0.2.1.0 (^^?!) - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num b, Num a, Reifies s W) => BVar s b -> Traversal' b a -> BVar s a v ^^?! t = fromMaybe (error e) (previewVar t v) where e = "Numeric.Backprop.Num.^^?!: Empty traversal" +infixl 8 ^^?! {-# INLINE (^^?!) #-} -- | 'Numeric.Backprop.previewVar', but with 'Num' constraints instead of @@ -313,7 +342,7 @@ -- -- See documentation for '^^?' for more information and important notes. previewVar - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num b, Num a, Reifies s W) => Traversal' b a -> BVar s b -> Maybe (BVar s a) @@ -323,7 +352,7 @@ -- | 'Numeric.Backprop.^^..', but with 'Num' constraints instead of -- 'Backprop' constraints. (^^..) - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num b, Num a, Reifies s W) => BVar s b -> Traversal' b a -> [BVar s a] @@ -333,7 +362,7 @@ -- | 'Numeric.Backprop.toListOfVar', but with 'Num' constraints instead of -- 'Backprop' constraints. toListOfVar - :: forall b a s. (Num a, Reifies s W) + :: forall b a s. (Num b, Num a, Reifies s W) => Traversal' b a -> BVar s b -> [BVar s a] @@ -342,6 +371,8 @@ -- | 'Numeric.Backprop.sequenceVar', but with 'Num' constraints instead of -- 'Backprop' constraints. +-- +-- Since v0.2.4, requires a 'Num' constraint on @t a@. sequenceVar :: (Traversable t, Num a, Reifies s W) => BVar s (t a) @@ -363,89 +394,89 @@ -- | 'Numeric.Backprop.liftOp', but with 'Num' constraints instead of -- 'Backprop' constraints. liftOp - :: (Every Num as, Known Length as, Num b, Reifies s W) + :: (Every Num as, Known Length as, Reifies s W) => Op as b -> Prod (BVar s) as -> BVar s b -liftOp = E.liftOp E.afNums E.zfNum +liftOp = E.liftOp E.afNums {-# INLINE liftOp #-} -- | 'Numeric.Backprop.liftOp1', but with 'Num' constraints instead of -- 'Backprop' constraints. liftOp1 - :: (Num a, Num b, Reifies s W) + :: (Num a, Reifies s W) => Op '[a] b -> BVar s a -> BVar s b -liftOp1 = E.liftOp1 E.afNum E.zfNum +liftOp1 = E.liftOp1 E.afNum {-# INLINE liftOp1 #-} -- | 'Numeric.Backprop.liftOp2', but with 'Num' constraints instead of -- 'Backprop' constraints. liftOp2 - :: (Num a, Num b, Num c, Reifies s W) + :: (Num a, Num b, 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 +liftOp2 = E.liftOp2 E.afNum E.afNum {-# INLINE liftOp2 #-} -- | 'Numeric.Backprop.liftOp3', but with 'Num' constraints instead of -- 'Backprop' constraints. liftOp3 - :: (Num a, Num b, Num c, Num d, Reifies s W) + :: (Num a, Num b, Num c, 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 +liftOp3 = E.liftOp3 E.afNum E.afNum E.afNum {-# INLINE liftOp3 #-} -- | 'Numeric.Backprop.isoVar', but with 'Num' constraints instead of -- 'Backprop' constraints. isoVar - :: (Num a, Num b, Reifies s W) + :: (Num a, Reifies s W) => (a -> b) -> (b -> a) -> BVar s a -> BVar s b -isoVar = E.isoVar E.afNum E.zfNum +isoVar = E.isoVar E.afNum {-# INLINE isoVar #-} -- | 'Numeric.Backprop.isoVar', but with 'Num' constraints instead of -- 'Backprop' constraints. isoVar2 - :: (Num a, Num b, Num c, Reifies s W) + :: (Num a, Num b, Reifies s W) => (a -> b -> c) -> (c -> (a, b)) -> BVar s a -> BVar s b -> BVar s c -isoVar2 = E.isoVar2 E.afNum E.afNum E.zfNum +isoVar2 = E.isoVar2 E.afNum E.afNum {-# 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) + :: (Num a, Num b, Num c, Reifies s W) => (a -> b -> c -> d) -> (d -> (a, b, c)) -> BVar s a -> BVar s b -> BVar s c -> BVar s d -isoVar3 = E.isoVar3 E.afNum E.afNum E.afNum E.zfNum +isoVar3 = E.isoVar3 E.afNum E.afNum E.afNum {-# 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) + :: (Every Num as, Known Length as, Reifies s W) => (Tuple as -> b) -> (b -> Tuple as) -> Prod (BVar s) as -> BVar s b -isoVarN = E.isoVarN E.afNums E.zfNum +isoVarN = E.isoVarN E.afNums {-# INLINE isoVarN #-} diff --git a/src/Numeric/Backprop/Op.hs b/src/Numeric/Backprop/Op.hs --- a/src/Numeric/Backprop/Op.hs +++ b/src/Numeric/Backprop/Op.hs @@ -39,6 +39,9 @@ -- for a guide for -- equipping your library with backpropatable operations using 'Op's. -- +-- See also +-- for writing Ops manually on your own numerical functions. +-- module Numeric.Backprop.Op ( -- * Implementation @@ -140,6 +143,9 @@ -- the other. If you have an 'Op' for \(f\) and an 'Op' for \(g\), you can -- compute the gradient of \(f\) knowing that the result target is -- \(g \circ f\). +-- +-- See for +-- a detailed look on writing ops manually on your own numerical functions. -- -- Note that end users should probably never be required to construct an -- 'Op' explicitly this way. Instead, libraries should provide diff --git a/src/Prelude/Backprop.hs b/src/Prelude/Backprop.hs --- a/src/Prelude/Backprop.hs +++ b/src/Prelude/Backprop.hs @@ -35,8 +35,8 @@ , mapAccumR , foldr, foldl' -- * Functor and Applicative - , fmap - , (<$>) + , fmap, fmapConst + , (<$>), (<$), ($>) , pure , liftA2 , liftA3 @@ -56,34 +56,34 @@ import qualified Prelude.Backprop.Explicit as E -- | Lifted 'P.sum'. More efficient than going through 'toList'. -sum :: (Foldable t, Functor t, Backprop (t a), Backprop a, Num a, Reifies s W) +sum :: (Foldable t, Functor t, Backprop (t a), Num a, Reifies s W) => BVar s (t a) -> BVar s a -sum = E.sum E.addFunc E.zeroFunc +sum = E.sum E.addFunc {-# INLINE sum #-} -- | Lifted 'P.pure'. pure - :: (Foldable t, Applicative t, Backprop (t a), Backprop a, Reifies s W) + :: (Foldable t, Applicative t, Backprop a, Reifies s W) => BVar s a -> BVar s (t a) -pure = E.pure E.addFunc E.zeroFunc E.zeroFunc +pure = E.pure E.addFunc E.zeroFunc {-# INLINE pure #-} -- | Lifted 'P.product'. More efficient than going through 'toList'. product - :: (Foldable t, Functor t, Backprop (t a), Backprop a, Fractional a, Reifies s W) + :: (Foldable t, Functor t, Backprop (t a), Fractional a, Reifies s W) => BVar s (t a) -> BVar s a -product = E.product E.addFunc E.zeroFunc +product = E.product E.addFunc {-# INLINE product #-} -- | Lifted 'P.length'. More efficient than going through 'toList'. length - :: (Foldable t, Backprop (t a), Backprop b, Num b, Reifies s W) + :: (Foldable t, Backprop (t a), Num b, Reifies s W) => BVar s (t a) -> BVar s b -length = E.length E.addFunc E.zeroFunc E.zeroFunc +length = E.length E.addFunc E.zeroFunc {-# INLINE length #-} -- | Lifted 'P.minimum'. Undefined for situations where 'P.minimum' would @@ -132,8 +132,6 @@ -- | Lifted 'P.fmap'. Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Functor's. --- --- Prior to v0.2.3, required a 'Backprop' constraint on @f b@. fmap :: (Traversable f, Backprop a, Backprop b, Reifies s W) => (BVar s a -> BVar s b) @@ -142,6 +140,24 @@ fmap = E.fmap E.addFunc E.addFunc E.zeroFunc E.zeroFunc {-# INLINE fmap #-} +-- | Efficient version of 'fmap' when used to "replace" all values in +-- a 'Functor' value. +-- +-- @ +-- 'fmapConst' x = 'fmap' ('P.const' x) +-- @ +-- +-- but much more efficient. +-- +-- @since 0.2.4.0 +fmapConst + :: (Functor f, Foldable f, Backprop b, Backprop (f a), Reifies s W) + => BVar s b + -> BVar s (f a) + -> BVar s (f b) +fmapConst = E.fmapConst E.addFunc E.addFunc E.zeroFunc E.zeroFunc +{-# INLINE fmapConst #-} + -- | Alias for 'fmap'. (<$>) :: (Traversable f, Backprop a, Backprop b, Reifies s W) @@ -149,12 +165,35 @@ -> BVar s (f a) -> BVar s (f b) (<$>) = fmap +infixl 4 <$> {-# INLINE (<$>) #-} +-- | Alias for 'fmapConst'. +-- +-- @since 0.2.4.0 +(<$) + :: (Traversable f, Backprop b, Backprop (f a), Reifies s W) + => BVar s b + -> BVar s (f a) + -> BVar s (f b) +(<$) = fmapConst +infixl 4 <$ +{-# INLINE (<$) #-} + +-- | Alias for @'flip' 'fmapConst'@. +-- +-- @since 0.2.4.0 +($>) + :: (Traversable f, Backprop b, Backprop (f a), Reifies s W) + => BVar s (f a) + -> BVar s b + -> BVar s (f b) +xs $> x = x <$ xs +infixl 4 $> +{-# INLINE ($>) #-} + -- | Lifted 'P.traverse'. Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Functor's. --- --- Prior to v0.2.3, required a 'Backprop' constraint on @f (t b)@. traverse :: (Traversable t, Applicative f, Foldable f, Backprop a, Backprop b, Backprop (t b), Reifies s W) => (BVar s a -> f (BVar s b)) @@ -166,8 +205,6 @@ -- | Lifted 'P.liftA2'. Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Applicative's. --- --- Prior to v0.2.3, required a 'Backprop' constraint on @f c@. liftA2 :: ( Traversable f, Applicative f , Backprop a, Backprop b, Backprop c @@ -183,8 +220,6 @@ -- | Lifted 'P.liftA3'. Lifts backpropagatable functions to be -- backpropagatable functions on 'Traversable' 'Applicative's. --- --- Prior to v0.2.3, required a 'Backprop' constraint on @f d@. liftA3 :: ( Traversable f , Applicative f @@ -204,20 +239,20 @@ -- -- @since 0.2.1.0 fromIntegral - :: (Backprop a, P.Integral a, Backprop b, P.Integral b, Reifies s W) + :: (Backprop a, P.Integral a, P.Integral b, Reifies s W) => BVar s a -> BVar s b -fromIntegral = E.fromIntegral E.addFunc E.zeroFunc +fromIntegral = E.fromIntegral E.addFunc {-# INLINE fromIntegral #-} -- | Lifted conversion between two 'Fractional' and 'P.Real' instances. -- -- @since 0.2.1.0 realToFrac - :: (Backprop a, Fractional a, P.Real a, Backprop b, Fractional b, P.Real b, Reifies s W) + :: (Backprop a, Fractional a, P.Real a, Fractional b, P.Real b, Reifies s W) => BVar s a -> BVar s b -realToFrac = E.realToFrac E.addFunc E.zeroFunc +realToFrac = E.realToFrac E.addFunc {-# INLINE realToFrac #-} -- | Lifted version of 'P.round'. @@ -230,7 +265,7 @@ :: (P.RealFrac a, P.Integral b, Reifies s W) => BVar s a -> BVar s b -round = E.round E.afNum E.zfNum +round = E.round E.afNum {-# INLINE round #-} -- | Lifted version of 'P.fromIntegral', defined to let you return @@ -246,7 +281,7 @@ :: (P.Integral a, P.RealFrac b, Reifies s W) => BVar s a -> BVar s b -fromIntegral' = E.fromIntegral' E.afNum E.zfNum +fromIntegral' = E.fromIntegral' E.afNum {-# INLINE fromIntegral' #-} -- | Lifted version of 'P.toList'. Takes a 'BVar' of a 'Traversable' of diff --git a/src/Prelude/Backprop/Explicit.hs b/src/Prelude/Backprop/Explicit.hs --- a/src/Prelude/Backprop/Explicit.hs +++ b/src/Prelude/Backprop/Explicit.hs @@ -14,6 +14,11 @@ -- "Prelude.Backprop". Instead of relying on a 'Backprop' instance, allows -- you to manually provide 'zero', 'add', and 'one' on a per-value basis. -- +-- WARNING: API of this module can be considered only "semi-stable"; while +-- the API of "Prelude.Backprop" and Prelude.Backprop.Num" are kept +-- consistent, some argument order changes might happen in this module to +-- reflect changes in underlying implementation. +-- -- @since 0.2.0.0 module Prelude.Backprop.Explicit ( @@ -29,7 +34,7 @@ , mapAccumR , foldr, foldl' -- * Functor and Applicative - , fmap + , fmap, fmapConst , pure , liftA2 , liftA3 @@ -54,10 +59,9 @@ -- | 'Prelude.Backprop.sum', but taking explicit 'add' and 'zero'. sum :: (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 -> +sum af = liftOp1 af . op1 $ \xs -> ( P.sum xs , (P.<$ xs) ) @@ -68,12 +72,13 @@ :: (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 -> +pure af zfa = liftOp1 af . op1 $ \x -> ( P.pure x - , P.foldl' (runAF af) (runZF zfa x) + , \d -> case P.toList d of + [] -> runZF zfa x + e:es -> P.foldl' (runAF af) e es ) {-# INLINE pure #-} @@ -81,10 +86,9 @@ product :: (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 -> +product af = liftOp1 af . op1 $ \xs -> let p = P.product xs in ( p , \d -> (\x -> p * d / x) P.<$> xs @@ -96,10 +100,9 @@ :: (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 -> +length af zfa = liftOp1 af . op1 $ \xs -> ( P.fromIntegral (P.length xs) , P.const (runZF zfa xs) ) @@ -112,7 +115,7 @@ -> ZeroFunc a -> BVar s (t a) -> BVar s a -minimum af zf = liftOp1 af zf . op1 $ \xs -> +minimum af zf = liftOp1 af . op1 $ \xs -> let m = P.minimum xs in ( m , \d -> (\x -> if x == m then d else runZF zf x) P.<$> xs @@ -126,7 +129,7 @@ -> ZeroFunc a -> BVar s (t a) -> BVar s a -maximum af zf = liftOp1 af zf . op1 $ \xs -> +maximum af zf = liftOp1 af . op1 $ \xs -> let m = P.maximum xs in ( m , \d -> (\x -> if x == m then d else runZF zf x) P.<$> xs @@ -144,7 +147,7 @@ -> BVar s b -> BVar s (t a) -> BVar s b -foldr af zf f x = P.foldr f x . toList af zf +foldr af z f x = P.foldr f x . toList af z {-# INLINE foldr #-} -- | 'Prelude.Backprop.foldl'', but taking explicit 'add' and 'zero'. @@ -158,14 +161,10 @@ -> BVar s b -> BVar s (t a) -> BVar s b -foldl' af zf f x = P.foldl' f x . toList af zf +foldl' af z f x = P.foldl' f x . toList af z {-# INLINE foldl' #-} -- | 'Prelude.Backprop.fmap', but taking explicit 'add' and 'zero'. --- --- See documentation for 'Numeric.Backprop.Explicitl.collectVar' for --- information the API change in v0.2.3 that removed the @'ZeroFunc' (f b)@ --- parameter. fmap :: (Traversable f, Reifies s W) => AddFunc a @@ -178,11 +177,29 @@ fmap afa afb zfa zfb f = collectVar afb zfb . P.fmap f . sequenceVar afa zfa {-# INLINE fmap #-} --- | 'Prelude.Backprop.traverse', but taking explicit 'add' and 'zero'. +-- | 'Prelude.Backprop.fmapConst', but taking explicit 'add' and 'zero'. -- --- See documentation for 'Numeric.Backprop.Explicitl.collectVar' for --- information the API change in v0.2.3 that removed the @'ZeroFunc' (t b)@ --- and @'ZeroFunc' (f (t b))@ parameters. +-- @since 0.2.4.0 +fmapConst + :: (Functor f, Foldable f, Reifies s W) + => AddFunc (f a) + -> AddFunc b + -> ZeroFunc (f a) + -> ZeroFunc b + -> BVar s b + -> BVar s (f a) + -> BVar s (f b) +fmapConst afa afb zfa zfb = liftOp2 afb afa . op2 $ \x xs -> + ( x P.<$ xs + , \d -> ( case P.toList d of + [] -> runZF zfb x + e:es -> P.foldl' (runAF afb) e es + , runZF zfa xs + ) + ) +{-# INLINE fmapConst #-} + +-- | 'Prelude.Backprop.traverse', but taking explicit 'add' and 'zero'. traverse :: (Traversable t, Applicative f, Foldable f, Reifies s W) => AddFunc a @@ -204,10 +221,6 @@ {-# INLINE traverse #-} -- | 'Prelude.Backprop.liftA2', but taking explicit 'add' and 'zero'. --- --- See documentation for 'Numeric.Backprop.Explicitl.collectVar' for --- information the API change in v0.2.3 that removed the @'ZeroFunc' (f c)@ --- parameter. liftA2 :: ( Traversable f , Applicative f @@ -230,10 +243,6 @@ {-# INLINE liftA2 #-} -- | 'Prelude.Backprop.liftA3', but taking explicit 'add' and 'zero'. --- --- See documentation for 'Numeric.Backprop.Explicitl.collectVar' for --- information the API change in v0.2.3 that removed the @'ZeroFunc' (f d)@ --- parameter. liftA3 :: ( Traversable f , Applicative f @@ -270,10 +279,9 @@ fromIntegral :: (P.Integral a, P.Integral b, Reifies s W) => AddFunc a - -> ZeroFunc b -> BVar s a -> BVar s b -fromIntegral af zf = isoVar af zf P.fromIntegral P.fromIntegral +fromIntegral af = isoVar af P.fromIntegral P.fromIntegral {-# INLINE fromIntegral #-} -- | 'Prelude.Backprop.realToFrac', but taking explicit 'add' and 'zero'. @@ -282,10 +290,9 @@ realToFrac :: (Fractional a, P.Real a, Fractional b, P.Real b, Reifies s W) => AddFunc a - -> ZeroFunc b -> BVar s a -> BVar s b -realToFrac af zf = isoVar af zf P.realToFrac P.realToFrac +realToFrac af = isoVar af P.realToFrac P.realToFrac {-# INLINE realToFrac #-} -- | 'Prelude.Backprop.round', but taking explicit 'add' and 'zero'. @@ -294,10 +301,9 @@ round :: (P.RealFrac a, P.Integral b, Reifies s W) => AddFunc a - -> ZeroFunc b -> BVar s a -> BVar s b -round af zf = isoVar af zf P.round P.fromIntegral +round af = isoVar af P.round P.fromIntegral {-# INLINE round #-} -- | 'Prelude.Backprop.fromIntegral'', but taking explicit 'add' and @@ -307,10 +313,9 @@ fromIntegral' :: (P.Integral a, P.RealFrac b, Reifies s W) => AddFunc a - -> ZeroFunc b -> BVar s a -> BVar s b -fromIntegral' af zf = isoVar af zf P.fromIntegral P.round +fromIntegral' af = isoVar af P.fromIntegral P.round {-# INLINE fromIntegral' #-} -- | 'Prelude.Backprop.length', but taking explicit 'add' and 'zero'. @@ -322,15 +327,11 @@ -> ZeroFunc a -> BVar s (t a) -> [BVar s a] -toList af zf = toListOfVar af zf P.traverse +toList af z = toListOfVar af (ZF (P.fmap (runZF z))) P.traverse {-# INLINE toList #-} -- | 'Prelude.Backprop.mapAccumL', but taking explicit 'add' and 'zero'. -- --- See documentation for 'Numeric.Backprop.Explicitl.collectVar' for --- information the API change in v0.2.3 that removed the @'ZeroFunc' (t c)@ --- parameter. --- -- @since 0.2.2.0 mapAccumL :: (Traversable t, Reifies s W) @@ -349,10 +350,6 @@ {-# INLINE mapAccumL #-} -- | 'Prelude.Backprop.mapAccumR', but taking explicit 'add' and 'zero'. --- --- See documentation for 'Numeric.Backprop.Explicitl.collectVar' for --- information the API change in v0.2.3 that removed the @'ZeroFunc' (t c)@ --- parameter. -- -- @since 0.2.2.0 mapAccumR diff --git a/src/Prelude/Backprop/Num.hs b/src/Prelude/Backprop/Num.hs --- a/src/Prelude/Backprop/Num.hs +++ b/src/Prelude/Backprop/Num.hs @@ -28,8 +28,8 @@ , mapAccumR , foldr, foldl' -- * Functor and Applicative - , fmap - , (<$>) + , fmap, fmapConst + , (<$>), (<$), ($>) , pure , liftA2 , liftA3 @@ -53,16 +53,16 @@ sum :: (Foldable t, Functor t, Num (t a), Num a, Reifies s W) => BVar s (t a) -> BVar s a -sum = E.sum E.afNum E.zfNum +sum = E.sum E.afNum {-# INLINE sum #-} -- | 'Prelude.Backprop.pure', but with 'Num' constraints instead of -- 'Backprop' constraints. pure - :: (Foldable t, Applicative t, Num (t a), Num a, Reifies s W) + :: (Foldable t, Applicative t, Num a, Reifies s W) => BVar s a -> BVar s (t a) -pure = E.pure E.afNum E.zfNum E.zfNum +pure = E.pure E.afNum E.zfNum {-# INLINE pure #-} -- | 'Prelude.Backprop.product', but with 'Num' constraints instead of @@ -71,7 +71,7 @@ :: (Foldable t, Functor t, Num (t a), Fractional a, Reifies s W) => BVar s (t a) -> BVar s a -product = E.product E.afNum E.zfNum +product = E.product E.afNum {-# INLINE product #-} -- | 'Prelude.Backprop.length', but with 'Num' constraints instead of @@ -80,7 +80,7 @@ :: (Foldable t, Num (t a), Num b, Reifies s W) => BVar s (t a) -> BVar s b -length = E.length E.afNum E.zfNum E.zfNum +length = E.length E.afNum E.zfNum {-# INLINE length #-} -- | 'Prelude.Backprop.minimum', but with 'Num' constraints instead of @@ -129,8 +129,6 @@ -- | 'Prelude.Backprop.fmap', but with 'Num' constraints instead of -- 'Backprop' constraints. --- --- Prior to v0.2.3, required a 'Num' constraint on @f b@. fmap :: (Traversable f, Num a, Num b, Reifies s W) => (BVar s a -> BVar s b) @@ -139,6 +137,18 @@ fmap = E.fmap E.afNum E.afNum E.zfNum E.zfNum {-# INLINE fmap #-} +-- | 'Prelude.Backprop.fmapConst', but with 'Num' constraints instead of +-- 'Backprop' constraints. +-- +-- @since 0.2.4.0 +fmapConst + :: (Functor f, Foldable f, Num b, Num (f a), Reifies s W) + => BVar s b + -> BVar s (f a) + -> BVar s (f b) +fmapConst = E.fmapConst E.afNum E.afNum E.zfNum E.zfNum +{-# INLINE fmapConst #-} + -- | Alias for 'fmap'. (<$>) :: (Traversable f, Num a, Num b, Reifies s W) @@ -146,15 +156,38 @@ -> BVar s (f a) -> BVar s (f b) (<$>) = fmap +infixl 4 <$> {-# INLINE (<$>) #-} +-- | Alias for 'fmapConst'. +-- +-- @since 0.2.4.0 +(<$) + :: (Functor f, Foldable f, Num b, Num (f a), Reifies s W) + => BVar s b + -> BVar s (f a) + -> BVar s (f b) +(<$) = fmapConst +infixl 4 <$ +{-# INLINE (<$) #-} + +-- | Alias for @'flip' 'fmapConst'@. +-- +-- @since 0.2.4.0 +($>) + :: (Functor f, Foldable f, Num b, Num (f a), Reifies s W) + => BVar s (f a) + -> BVar s b + -> BVar s (f b) +xs $> x = x <$ xs +infixl 4 $> +{-# INLINE ($>) #-} + -- | 'Prelude.Backprop.traverse', but with 'Num' constraints instead of -- 'Backprop' constraints. -- -- See for -- a fixed-length vector type with a very appropriate 'Num' instance! --- --- Prior to v0.2.3, required a 'Num' constraint on @f (t b)@. traverse :: (Traversable t, Applicative f, Foldable f, Num a, Num b, Num (t b), Reifies s W) => (BVar s a -> f (BVar s b)) @@ -165,8 +198,6 @@ -- | 'Prelude.Backprop.liftA2', but with 'Num' constraints instead of -- 'Backprop' constraints. --- --- Prior to v0.2.3, required a 'Num' constraint on @f c@. liftA2 :: ( Traversable f , Applicative f @@ -182,8 +213,6 @@ -- | 'Prelude.Backprop.liftA3', but with 'Num' constraints instead of -- 'Backprop' constraints. --- --- Prior to v0.2.3, required a 'Num' constraint on @f d@. liftA3 :: ( Traversable f , Applicative f @@ -207,7 +236,7 @@ :: (P.Integral a, P.Integral b, Reifies s W) => BVar s a -> BVar s b -fromIntegral = E.fromIntegral E.afNum E.zfNum +fromIntegral = E.fromIntegral E.afNum {-# INLINE fromIntegral #-} -- | 'Prelude.Backprop.realToFrac', but with 'Num' constraints instead of @@ -218,7 +247,7 @@ :: (Fractional a, P.Real a, Fractional b, P.Real b, Reifies s W) => BVar s a -> BVar s b -realToFrac = E.realToFrac E.afNum E.zfNum +realToFrac = E.realToFrac E.afNum {-# INLINE realToFrac #-} -- | 'Prelude.Backprop.round', but with 'Num' constraints instead of @@ -229,7 +258,7 @@ :: (P.RealFrac a, P.Integral b, Reifies s W) => BVar s a -> BVar s b -round = E.round E.afNum E.zfNum +round = E.round E.afNum {-# INLINE round #-} -- | 'Prelude.Backprop.fromIntegral'', but with 'Num' constraints instead @@ -240,7 +269,7 @@ :: (P.Integral a, P.RealFrac b, Reifies s W) => BVar s a -> BVar s b -fromIntegral' = E.fromIntegral' E.afNum E.zfNum +fromIntegral' = E.fromIntegral' E.afNum {-# INLINE fromIntegral' #-} -- | 'Prelude.Backprop.toList', but with 'Num' constraints instead of