diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,3 +3,9 @@ ## [v0.1.0.0](https://github.com/Mikolaj/horde-ad/compare/v0.0.0.0...v0.1.0.0) - First version. Released on an unsuspecting world. + +## [v0.2.0.0](https://github.com/Mikolaj/horde-ad/compare/v0.1.0.0...v0.2.0.0) + +- Modernize the dep (ilist) that provides imap to make Stackage happy +- Make the cabal sublibraries public, as intended +- Tweak benchmarks diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,12 +3,15 @@ [![Hackage](https://img.shields.io/hackage/v/horde-ad.svg)](https://hackage.haskell.org/package/horde-ad) Welcome to the Automatic Differentiation library originally inspired by the paper [_"Provably correct, asymptotically efficient, higher-order reverse-mode automatic differentiation"_](https://dl.acm.org/doi/10.1145/3498710). Compared to the paper and to classic taping AD Haskell packages, the library additionally efficiently supports array operations and generation of symbolic derivative programs, though the efficiency is confined to a narrowly typed class of source programs with limited higher-orderness. A detailed account of the extension is in the paper [_"Dual-Numbers Reverse AD for Functional Array Languages"_](http://arxiv.org/abs/2507.12640) by Tom Smeding, Mikolaj Konarski, Simon Peyton Jones and Andrew Fitzgibbon. + This is an early prototype, both in terms of the engine performance, the API and the preliminary tools and examples built with it. At this development stage, it's not coded defensively but exactly the opposite: it will fail on cases not found in current tests so that new code and tests have to be added and old code optimized for the new specimens reported in the wild. The user should also be ready to add missing primitives and any obvious tools that should be predefined but aren't, such as weight normalization (https://github.com/Mikolaj/horde-ad/issues/42). It's already possible to differentiate basic neural network architectures, such as fully connected, recurrent, convolutional and residual. The library should also be suitable for defining exotic machine learning architectures and non-machine learning systems, given that no notion of a neural network nor of a computation graph are hardwired into the formalism, but instead they are compositionally and type-safely built up from general automatic differentiation building blocks. Mature Haskell libraries with similar capabilities, but varying efficiency, are https://hackage.haskell.org/package/ad and https://hackage.haskell.org/package/backprop. See also https://github.com/Mikolaj/horde-ad/blob/master/CREDITS.md. Benchmarks suggest that horde-ad has competitive performance on CPU. It is hoped that the (well-typed) separation of AD logic and tensor manipulation backend will enable similar speedups on numerical accelerators, when their support is implemented. Contributions to this and other tasks are very welcome. The newcomer-friendly tickets are listed at https://github.com/Mikolaj/horde-ad/issues?q=is%3Aissue%20state%3Aopen%20label%3A%22good%20first%20issue%22. Please don't hesitate to ask questions on github, on Matrix, via email. @@ -36,13 +39,13 @@ (2.4396285219055063, -1.953374825727421, 0.9654825811012627) ``` -We can instantiate `foo` to matrices; the operations within (`sin`, `+`, `*`, etc.) applying elementwise: +We can instantiate `foo` to matrices (represented in the `Concrete` datatype of unboxed multi-dimensional arrays); the operations within (`sin`, `+`, `*`, etc.) applying elementwise: ```hs -type Matrix2x2 f r = f (TKS '[2, 2] r) -- TKS means shapely-typed tensor kind -type ThreeMatrices r = (Matrix2x2 Concrete r, Matrix2x2 Concrete r, Matrix2x2 Concrete r) +type Matrix2x2 r = Concrete (TKS '[2, 2] r) -- TKS means shapely-typed tensor kind +type ThreeMatrices r = (Matrix2x2 r, Matrix2x2 r, Matrix2x2 r) threeSimpleMatrices :: ThreeMatrices Double threeSimpleMatrices = (srepl 1.1, srepl 2.2, srepl 3.3) -- srepl replicates its argument to fill the whole matrix -fooMatrixValue :: Matrix2x2 Concrete Double +fooMatrixValue :: Matrix2x2 Double fooMatrixValue = foo threeSimpleMatrices >>> fooMatrixValue sfromListLinear [2,2] [4.242393641025528,4.242393641025528,4.242393641025528,4.242393641025528]) @@ -65,7 +68,7 @@ We noted above that `w` appears twice in `foo`. A property of tracing-based AD systems is that such re-use may not be captured, with explosive results. In `cgrad`, such sharing is preserved, so `w` is processed only once during gradient computation and this property is guaranteed for the `cgrad` tool universally, without any action required from the user. -`horde-ad` also allows computing _symbolic_ derivative programs: using this API, a program is differentiated only once, after which it can be run on many different input values. +`horde-ad` also allows computing _symbolic_ derivative programs: with this API, a program is differentiated only once, after which it can be run on many different input values. In this case, however, sharing is _not_ automatically preserved, so shared variables have to be explicitly marked using `tlet`, as shown below in `fooLet`. This also makes the type of the function more specific: it now does not work on an arbitrary `Num` any more, but instead on an arbitrary `horde-ad` tensor that implements the standard arithmetic operations, some of which (e.g., `atan2H`) are implemented in custom numeric classes. ```hs @@ -88,15 +91,15 @@ ```hs >>> printArtifactPretty artifact -"\dret m1 -> - let m3 = sin (tproject2 (tproject1 m1)) - m4 = tproject1 (tproject1 m1) * m3 - m5 = recip (tproject2 m1 * tproject2 m1 + m4 * m4) - m7 = (negate (tproject2 m1) * m5) * dret + tproject2 m1 * dret - in tpair - (tpair (m3 * m7) - (cos (tproject2 (tproject1 m1)) * (tproject1 (tproject1 m1) * m7))) - ((m4 * m5) * dret + m4 * dret)" +\dret m1 -> + let m3 = sin (tproject2 (tproject1 m1)) + m4 = tproject1 (tproject1 m1) * m3 + m5 = recip (tproject2 m1 * tproject2 m1 + m4 * m4) + m7 = (negate (tproject2 m1) * m5) * dret + tproject2 m1 * dret + in tpair + (tpair (m3 * m7) + (cos (tproject2 (tproject1 m1)) * (tproject1 (tproject1 m1) * m7))) + ((m4 * m5) * dret + m4 * dret) ``` A concrete value of this symbolic reverse derivative at the same input as before can be obtained by interpreting its program in the context of the operations supplied by the horde-ad library. (Note that the output happens to be the same as `gradSumFooMatrix threeSimpleMatrices` above, which used `cgrad` on `kfromS . ssum0 . foo`; the reason is that `srepl 1.0` happens to be the reverse derivative of `kfromS . ssum0`.) diff --git a/bench/LongMnistBench.hs b/bench/LongMnistBench.hs --- a/bench/LongMnistBench.hs +++ b/bench/LongMnistBench.hs @@ -9,7 +9,7 @@ main :: IO () main = defaultMain [ mnistBGroup1VTA 400 - , mnistBGroup1VTO 400 +-- TODO: re-enable when it doesn't take longer than all the others taken together: , mnistBGroup1VTO 400 , mnistBGroup2VTA 400 , mnistBGroup2VTC 400 , mnistBGroup2VTO 400 diff --git a/bench/RealisticMnistBench.hs b/bench/RealisticMnistBench.hs --- a/bench/RealisticMnistBench.hs +++ b/bench/RealisticMnistBench.hs @@ -12,7 +12,7 @@ main :: IO () main = defaultMain [ mnistBGroup1VTA 4000 - , mnistBGroup1VTO 4000 +-- TODO: re-enable when it doesn't take longer than all the others taken together: , mnistBGroup1VTO 4000 , mnistBGroup2VTA 4000 , mnistBGroup2VTC 4000 , mnistBGroup2VTO 4000 diff --git a/bench/common/BenchMnistTools.hs b/bench/common/BenchMnistTools.hs --- a/bench/common/BenchMnistTools.hs +++ b/bench/common/BenchMnistTools.hs @@ -299,7 +299,7 @@ \ xs -> bgroup ("2-hidden-layer rank 2 VTA MNIST nn with samples: " ++ show chunkLength) - [ mnistTestBench2VTA "30|10 "30 10 0.02 chunkLength xs + [ mnistTestBench2VTA "30|10 " 30 10 0.02 chunkLength xs , mnistTrainBench2VTA "30|10 " 30 10 0.02 chunkLength xs , mnistTestBench2VTA "300|100 " 300 100 0.02 chunkLength xs , mnistTrainBench2VTA "300|100 " 300 100 0.02 chunkLength xs @@ -336,7 +336,7 @@ ] -- The same as above, but only runtime. -mnistTrainBench2VTO +mnistTrainBench2VTOO :: forall r. r ~ Double => String -> Double -> Int -> [MnistDataLinearR r] @@ -348,7 +348,7 @@ (TKR2 1 (TKScalar Double)))) (TKScalar r) ) -> Benchmark -mnistTrainBench2VTO prefix gamma batchSize xs (targetInit, art) = do +mnistTrainBench2VTOO prefix gamma batchSize xs (targetInit, art) = do let go :: [MnistDataLinearR r] -> Concrete (XParams2 r Float) -> Concrete (XParams2 r Float) go [] parameters = parameters @@ -367,6 +367,21 @@ , "=" ++ show (tsize knownSTK targetInit) ] bench name $ nf gradf chunk +-- The same as above, but both compilation time and only runtime. +mnistTrainBench2VTO + :: forall r. r ~ Double + => String + -> Int -> Int -> Double -> Int -> [MnistDataLinearR r] + -> Benchmark +mnistTrainBench2VTO prefix widthHidden widthHidden2 + gamma batchSize xs = + let (!targetInit, !artRaw) = + MnistFcnnRanked2.mnistTrainBench2VTOGradient + @Double (Proxy @Float) IgnoreIncomingCotangent + 1 (mkStdGen 44) widthHidden widthHidden2 + !art = simplifyArtifactGradient artRaw + in mnistTrainBench2VTOO prefix gamma batchSize xs (targetInit, art) + mnistBGroup2VTO :: Int -> Benchmark mnistBGroup2VTO chunkLength = let (!targetInit, !artRaw) = @@ -381,7 +396,7 @@ \ xs -> bgroup ("2-hidden-layer rank 2 VTO runtime MNIST nn with samples: " ++ show chunkLength) - [ mnistTrainBench2VTO "1500|500 " 0.02 chunkLength xs (targetInit, art) + [ mnistTrainBench2VTOO "1500|500 " 0.02 chunkLength xs (targetInit, art) ] -- The same as above, but without simplifying the gradient. @@ -429,7 +444,7 @@ \ xs -> bgroup ("2-hidden-layer rank 2 VTOZ runtime MNIST nn with samples: " ++ show chunkLength) - [ mnistTrainBench2VTO "1500|500 " 0.02 chunkLength xs (targetInit, art) + [ mnistTrainBench2VTOO "1500|500 " 0.02 chunkLength xs (targetInit, art) ] -- The same as above, but without any simplification, even the smart @@ -478,7 +493,7 @@ \ xs -> bgroup ("2-hidden-layer rank 2 VTOX runtime MNIST nn with samples: " ++ show chunkLength) - [ mnistTrainBench2VTO "1500|500 " 0.02 chunkLength xs (targetInit, art) + [ mnistTrainBench2VTOO "1500|500 " 0.02 chunkLength xs (targetInit, art) ] {- TODO: re-enable once -fpolymorphic-specialisation works diff --git a/bench/common/BenchProdTools.hs b/bench/common/BenchProdTools.hs --- a/bench/common/BenchProdTools.hs +++ b/bench/common/BenchProdTools.hs @@ -27,17 +27,17 @@ bgroup100, bgroup1000, bgroup1e4, bgroup1e5, bgroup1e6, bgroup1e7, bgroup5e7 :: [Double] -> Benchmark bgroup100 = envProd 100 $ \args -> bgroup "100" $ benchProd args -bgroup1000 = envProd 1000 $ \args -> bgroup "1000" $ benchProd args +bgroup1000 = envProd 1000 $ \args -> bgroup "1000" $ benchProdShort args -bgroup1e4 = envProd 1e4 $ \args -> bgroup "1e4" $ benchProd args +bgroup1e4 = envProd 1e4 $ \args -> bgroup "1e4" $ benchProdShort args -bgroup1e5 = envProd 1e5 $ \args -> bgroup "1e5" $ benchProd args +bgroup1e5 = envProd 1e5 $ \args -> bgroup "1e5" $ benchProdShortest args -bgroup1e6 = envProd 1e6 $ \args -> bgroup "1e6" $ benchProd args +bgroup1e6 = envProd 1e6 $ \args -> bgroup "1e6" $ benchProdShortest args -bgroup1e7 = envProd 1e7 $ \args -> bgroup "1e7" $ benchProd args +bgroup1e7 = envProd 1e7 $ \args -> bgroup "1e7" $ benchProdShortest args -bgroup5e7 = envProd 5e7 $ \args -> bgroup "5e7" $ benchProd args +bgroup5e7 = envProd 5e7 $ \args -> bgroup "5e7" $ benchProdShortest args -- 5e7 == 5 * 10^7 == 0.5 * 10^8 == 0.5e8 envProd :: r ~ Double @@ -64,31 +64,88 @@ , sfromList . fromList $ lt) ) (f @k) -benchProd :: r ~ Double - => ( SNat n - , [Concrete (TKScalar r)] - , ListR n (Concrete (TKScalar r)) - , ListR n (Concrete (TKS '[] r)) - , Concrete (TKS '[n] r) ) - -> [Benchmark] +benchProd + :: r ~ Double + => ( SNat n + , [Concrete (TKScalar r)] + , ListR n (Concrete (TKScalar r)) + , ListR n (Concrete (TKS '[] r)) + , Concrete (TKS '[n] r) ) + -> [Benchmark] benchProd ~(snat, list, l, lt, t) = case snat of SNat -> [ bench "cgrad s MapAccum" $ nf (crevSMapAccum snat) t , bench "grad s MapAccum" $ nf (revSMapAccum snat) t - , bench "cgrad scalar MapAccum" $ nf (crevScalarMapAccum snat) t - , bench "grad scalar MapAccum" $ nf (revScalarMapAccum snat) t - , bench "cgrad scalar list" $ nf crevScalarList list - , bench "grad scalar list" $ nf revScalarList list - , bench "cgrad scalar L" $ nf (crevScalarL snat) l - , bench "grad scalar L" $ nf (revScalarL snat) l - , bench "cgrad scalar R" $ nf (crevScalarR snat) l - , bench "grad scalar R" $ nf (revScalarR snat) l - , bench "cgrad scalar NotShared" $ nf (crevScalarNotShared snat) l + , bench "cgrad k MapAccum" $ nf (crevScalarMapAccum snat) t + , bench "grad k MapAccum" $ nf (revScalarMapAccum snat) t + , bench "cgrad k list" $ nf crevScalarList list + , bench "grad k list" $ nf revScalarList list + , bench "cgrad k L" $ nf (crevScalarL snat) l + , bench "grad k L" $ nf (revScalarL snat) l + , bench "cgrad k R" $ nf (crevScalarR snat) l + , bench "grad k R" $ nf (revScalarR snat) l + , bench "cgrad k NotShared" $ nf (crevScalarNotShared snat) l , bench "cgrad s L" $ nf (crevSL snat) lt , bench "grad s L" $ nf (revSL snat) lt , bench "cgrad s R" $ nf (crevSR snat) lt , bench "grad s R" $ nf (revSR snat) lt , bench "cgrad s NotShared" $ nf (crevSNotShared snat) lt + ] + +benchProdShort + :: r ~ Double + => ( SNat n + , [Concrete (TKScalar r)] + , ListR n (Concrete (TKScalar r)) + , ListR n (Concrete (TKS '[] r)) + , Concrete (TKS '[n] r) ) + -> [Benchmark] +benchProdShort ~(snat, list, l, lt, t) = case snat of + SNat -> +-- [ bench "cgrad s MapAccum" $ nf (crevSMapAccum snat) t +-- , bench "grad s MapAccum" $ nf (revSMapAccum snat) t + [ bench "cgrad k MapAccum" $ nf (crevScalarMapAccum snat) t + , bench "grad k MapAccum" $ nf (revScalarMapAccum snat) t +-- , bench "cgrad k list" $ nf crevScalarList list +-- , bench "grad k list" $ nf revScalarList list + , bench "cgrad k L" $ nf (crevScalarL snat) l + , bench "grad k L" $ nf (revScalarL snat) l +-- , bench "cgrad k R" $ nf (crevScalarR snat) l +-- , bench "grad k R" $ nf (revScalarR snat) l + , bench "cgrad k NotShared" $ nf (crevScalarNotShared snat) l +-- , bench "cgrad s L" $ nf (crevSL snat) lt +-- , bench "grad s L" $ nf (revSL snat) lt +-- , bench "cgrad s R" $ nf (crevSR snat) lt +-- , bench "grad s R" $ nf (revSR snat) lt +-- , bench "cgrad s NotShared" $ nf (crevSNotShared snat) lt + ] + +benchProdShortest + :: r ~ Double + => ( SNat n + , [Concrete (TKScalar r)] + , ListR n (Concrete (TKScalar r)) + , ListR n (Concrete (TKS '[] r)) + , Concrete (TKS '[n] r) ) + -> [Benchmark] +benchProdShortest ~(snat, list, l, lt, t) = case snat of + SNat -> +-- [ bench "cgrad s MapAccum" $ nf (crevSMapAccum snat) t +-- , bench "grad s MapAccum" $ nf (revSMapAccum snat) t + [ bench "cgrad k MapAccum" $ nf (crevScalarMapAccum snat) t + , bench "grad k MapAccum" $ nf (revScalarMapAccum snat) t +-- , bench "cgrad k list" $ nf crevScalarList list +-- , bench "grad k list" $ nf revScalarList list + , bench "cgrad k L" $ nf (crevScalarL snat) l +-- , bench "grad k L" $ nf (revScalarL snat) l +-- , bench "cgrad k R" $ nf (crevScalarR snat) l +-- , bench "grad k R" $ nf (revScalarR snat) l + , bench "cgrad k NotShared" $ nf (crevScalarNotShared snat) l +-- , bench "cgrad s L" $ nf (crevSL snat) lt +-- , bench "grad s L" $ nf (revSL snat) lt +-- , bench "cgrad s R" $ nf (crevSR snat) lt +-- , bench "grad s R" $ nf (revSR snat) lt +-- , bench "cgrad s NotShared" $ nf (crevSNotShared snat) lt ] -- Another variant, with foldl1' and indexing, would be a disaster. diff --git a/horde-ad.cabal b/horde-ad.cabal --- a/horde-ad.cabal +++ b/horde-ad.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Higher Order Reverse Derivatives Efficiently - Automatic Differentiation @@ -177,7 +177,7 @@ , enummapset < 0.8 , ghc-typelits-knownnat < 1 , ghc-typelits-natnormalise < 1 - , ilist < 0.5 + , indexed-traversable < 0.2 , orthotope < 0.2 , ox-arrays < 0.2 , random >= 1.3.0 && < 1.4 @@ -187,6 +187,7 @@ library exampleLibrary import: options + visibility: public exposed-modules: MnistData MnistCnnRanked2 @@ -213,6 +214,7 @@ library benchCommonLibrary import: options + visibility: public exposed-modules: BenchMnistTools BenchProdTools @@ -335,6 +337,7 @@ library testToolLibrary import: options + visibility: public exposed-modules: CrossTesting EqEpsilon @@ -353,6 +356,7 @@ library testCommonLibrary import: options + visibility: public exposed-modules: TestAdaptorSimplified TestConvSimplified diff --git a/src/HordeAd/Core/OpsConcrete.hs b/src/HordeAd/Core/OpsConcrete.hs --- a/src/HordeAd/Core/OpsConcrete.hs +++ b/src/HordeAd/Core/OpsConcrete.hs @@ -14,9 +14,9 @@ import Data.Coerce (Coercible, coerce) import Data.Foldable qualified as Foldable import Data.Function ((&)) +import Data.Functor.WithIndex (imap) import Data.Int (Int64) import Data.List (foldl', mapAccumL, mapAccumR) -import Data.List.Index (imap) import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict qualified as M import Data.Proxy (Proxy (Proxy)) diff --git a/test/simplified/TestAdaptorSimplified.hs b/test/simplified/TestAdaptorSimplified.hs --- a/test/simplified/TestAdaptorSimplified.hs +++ b/test/simplified/TestAdaptorSimplified.hs @@ -561,12 +561,12 @@ (2.4396285219055063, -1.953374825727421, 0.9654825811012627) (gradFooDouble (1.1, 2.2, 3.3)) -type Matrix2x2 :: Target -> Type -> Type -type Matrix2x2 f r = f (TKS '[2, 2] r) -type ThreeMatrices r = (Matrix2x2 Concrete r, Matrix2x2 Concrete r, Matrix2x2 Concrete r) +type Matrix2x2 :: Type -> Type +type Matrix2x2 r = Concrete (TKS '[2, 2] r) +type ThreeMatrices r = (Matrix2x2 r, Matrix2x2 r, Matrix2x2 r) threeSimpleMatrices :: ThreeMatrices Double threeSimpleMatrices = (srepl 1.1, srepl 2.2, srepl 3.3) -fooMatrixValue :: Matrix2x2 Concrete Double +fooMatrixValue :: Matrix2x2 Double fooMatrixValue = foo threeSimpleMatrices gradSumFooMatrix :: ThreeMatrices Double -> ThreeMatrices Double gradSumFooMatrix = cgrad (kfromS . ssum0 . foo) @@ -625,8 +625,12 @@ in printArtifactPretty (simplifyArtifact $ revArtifactAdapt UseIncomingCotangent fooLet (FTKProduct (FTKProduct ftk ftk) ftk))) @?= "\\dret m1 -> tconvert (ConvT2 (ConvT2 (ConvCmp (ConvXR STKScalar) (ConvCmp (ConvXX' (FTKX [2,2] FTKScalar)) ConvSX)) (ConvCmp (ConvXR STKScalar) (ConvCmp (ConvXX' (FTKX [2,2] FTKScalar)) ConvSX))) (ConvCmp (ConvXR STKScalar) ConvSX)) (STKProduct (STKProduct (STKS [2,2] STKScalar) (STKS [2,2] STKScalar)) (STKS [2,2] STKScalar)) (let m3 = sin (sfromR (tproject2 (tproject1 m1))) ; m4 = sfromR (tproject1 (tproject1 m1)) * m3 ; m5 = recip (sfromR (tproject2 m1) * sfromR (tproject2 m1) + m4 * m4) ; m7 = (negate (sfromR (tproject2 m1)) * m5) * sfromR dret + sfromR (tproject2 m1) * sfromR dret in tpair (tpair (m3 * m7) (cos (sfromR (tproject2 (tproject1 m1))) * (sfromR (tproject1 (tproject1 m1)) * m7))) ((m4 * m5) * sfromR dret + m4 * sfromR dret))" -sumFooMatrix :: (ADReady f, RealFloat (Matrix2x2 f r), GoodScalar r) - => (Matrix2x2 f r, Matrix2x2 f r, Matrix2x2 f r) -> f (TKScalar r) +type Matrix2x2f :: Target -> Type -> Type +type Matrix2x2f f r = f (TKS '[2, 2] r) + +sumFooMatrix :: (ADReady f, RealFloat (Matrix2x2f f r), GoodScalar r) + => (Matrix2x2f f r, Matrix2x2f f r, Matrix2x2f f r) + -> f (TKScalar r) sumFooMatrix = kfromS . ssum0 . foo testfooSumMatrix :: Assertion