diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,16 @@ Changelog ========= +Version 0.1.2.1 +--------------- + +*May 1, 2018* + + + +* Updated for compatibility with *backprop-0.2.0.0* +* Orphan instances added for types in *Numeric.LinearAlgebra.Static*. + Version 0.1.2.0 --------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,8 @@ [![hmatrix-backprop on Hackage](https://img.shields.io/hackage/v/hmatrix-backprop.svg?maxAge=2592000)](https://hackage.haskell.org/package/hmatrix-backprop) [![Build Status](https://travis-ci.org/mstksg/hmatrix-backprop.svg?branch=master)](https://travis-ci.org/mstksg/hmatrix-backprop) -*[hmatrix][]* operations lifted for *[backprop][]*. +*[hmatrix][]* operations lifted for *[backprop][]*, along with orphan instances +of `Backprop`. [hmatrix]: http://hackage.haskell.org/package/hmatrix [backprop]: http://hackage.haskell.org/package/backprop @@ -41,8 +42,8 @@ TODO ---- -Apart from the exact API of hmatrix, it'd be nice to have: - +1. Now that new backprop no longer requires `Num`, we can lift normal hmatrix + operations as well. 1. Statically sized convolutions. Should probably add this to hmatrix instead first, though. diff --git a/hmatrix-backprop.cabal b/hmatrix-backprop.cabal --- a/hmatrix-backprop.cabal +++ b/hmatrix-backprop.cabal @@ -2,12 +2,12 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 11c33ad908b833f31f1c4bbe92635523c13c44f590d50114a5e0a4992e1c47a1 +-- hash: 33301e0e44babbb514f51cf80addcfb5da2a0a2764c096e657abc8fa87db7879 name: hmatrix-backprop -version: 0.1.2.0 +version: 0.1.2.1 synopsis: hmatrix operations lifted for backprop -description: hmatrix operations lifted for backprop. +description: hmatrix operations lifted for backprop, along with orphan instances. . Meant to act as a drop-in replacement to the API of Numeric.LinearAlgebra.Static. Just change your imports, and your @@ -38,8 +38,7 @@ src ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints build-depends: - ANum >=0.2 - , backprop >=0.1.4 + backprop >=0.2 , base >=4.7 && <5 , finite-typelits , ghc-typelits-knownnat @@ -62,7 +61,7 @@ test ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: - backprop >=0.1.4 + backprop >=0.2 , base >=4.7 && <5 , finite-typelits , hedgehog diff --git a/src/Numeric/LinearAlgebra/Static/Backprop.hs b/src/Numeric/LinearAlgebra/Static/Backprop.hs --- a/src/Numeric/LinearAlgebra/Static/Backprop.hs +++ b/src/Numeric/LinearAlgebra/Static/Backprop.hs @@ -8,6 +8,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} @@ -22,7 +23,9 @@ -- -- A wrapper over "Numeric.LinearAlgebra.Static" (type-safe vector and -- matrix operations based on blas/lapack) that allows its operations to --- work with . +-- work with . Also +-- provides orphan instances of 'Backprop' for types in +-- "Numeric.LinearAlgebra.Static". -- -- In short, these functions are "lifted" to work with 'BVar's. -- @@ -189,30 +192,56 @@ , W ) where -import Data.ANum import Data.Bifunctor import Data.Maybe import Data.Proxy import Foreign.Storable import GHC.TypeLits import Lens.Micro hiding ((&)) -import Numeric.Backprop -import Numeric.Backprop.Tuple +import Numeric.Backprop.Class +import Numeric.Backprop.Num import Unsafe.Coerce import qualified Data.Vector as V import qualified Data.Vector.Generic as VG import qualified Data.Vector.Generic.Sized as SVG import qualified Data.Vector.Sized as SV import qualified Data.Vector.Storable.Sized as SVS +import qualified Numeric.Backprop as BBP +import qualified Numeric.Backprop.Explicit as BE import qualified Numeric.LinearAlgebra as HU import qualified Numeric.LinearAlgebra.Static as H import qualified Numeric.LinearAlgebra.Static.Vector as H -import qualified Prelude.Backprop as B +import qualified Prelude.Backprop.Num as B #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) #endif +instance Backprop (H.R n) where + zero = zeroNum + add = addNum + one = oneNum + +instance Backprop (H.C n) where + zero = zeroNum + add = addNum + one = oneNum + +instance (KnownNat n, KnownNat m) => Backprop (H.L n m) where + zero = zeroNum + add = addNum + one = oneNum + +instance (KnownNat n, KnownNat m) => Backprop (H.M n m) where + zero = zeroNum + add = addNum + one = oneNum + +instance KnownNat n => Backprop (H.Sym n) where + zero = zeroNum + add = addNum + one = oneNum + vec2 :: Reifies s W => BVar s H.ℝ @@ -263,9 +292,9 @@ :: forall p n s. (Reifies s W, KnownNat p, KnownNat n, p <= n) => BVar s (H.R n) -> (BVar s (H.R p), BVar s (H.R (n - p))) -split v = (t ^^. _1, t ^^. _2) -- should we just return the T2 ? +split v = (t ^^. _1, t ^^. _2) where - t = isoVar (tupT2 . H.split) (uncurryT2 (H.#)) v + t = BBP.isoVar H.split (uncurry (H.#)) v {-# NOINLINE t #-} {-# INLINE split #-} @@ -275,9 +304,9 @@ -> (BVar s H.ℝ, BVar s (H.R (n - 1))) headTail v = (t ^^. _1, t ^^. _2) where - t = isoVar (tupT2 . H.headTail) - (\(T2 d dx) -> (H.konst d :: H.R 1) H.# dx) - v + t = BBP.isoVar H.headTail + (\(d, dx) -> (H.konst d :: H.R 1) H.# dx) + v {-# NOINLINE t #-} {-# INLINE headTail #-} @@ -338,7 +367,7 @@ -> (BVar s (H.L p n), BVar s (H.L (m - p) n)) splitRows v = (t ^^. _1, t ^^. _2) where - t = isoVar (tupT2 . H.splitRows) (uncurryT2 (H.===)) v + t = BBP.isoVar H.splitRows (uncurry (H.===)) v {-# NOINLINE t #-} {-# INLINE splitRows #-} @@ -348,7 +377,7 @@ -> (BVar s (H.L m p), BVar s (H.L m (n - p))) splitCols v = (t ^^. _1, t ^^. _2) where - t = isoVar (tupT2 . H.splitCols) (uncurryT2 (H.|||)) v + t = BBP.isoVar H.splitCols (uncurry (H.|||)) v {-# NOINLINE t #-} {-# INLINE splitCols #-} @@ -443,17 +472,17 @@ -> (BVar s (H.L m m), BVar s (H.R n), BVar s (H.L n n)) svd_ r = (t ^^. _1, t ^^. _2, t ^^. _3) where - o :: Op '[H.L m n] (T3 (H.L m m) (H.R n) (H.L n n)) + o :: Op '[H.L m n] (H.L m m, H.R n, H.L n n) o = op1 $ \x -> - let (u, σ, v) = H.svd x - in ( T3 u σ v - , \(T3 dU dΣ dV) -> + let msv@(u, _, v) = H.svd x + in ( msv + , \(dU, dΣ, dV) -> if H.norm_0 dU == 0 && H.norm_0 dV == 0 then (u H.<> H.diagR 0 dΣ) H.<> H.tr v else error "svd_: Cannot backprop if U and V are used." ) {-# INLINE o #-} - t = liftOp1 o r + t = BBP.liftOp1 o r {-# NOINLINE t #-} {-# INLINE svd_ #-} @@ -473,19 +502,19 @@ -> (BVar s (H.R n), BVar s (H.L n n)) eigensystem u = (t ^^. _1, t ^^. _2) where - o :: Op '[H.Sym n] (T2 (H.R n) (H.L n n)) + o :: Op '[H.Sym n] (H.R n, H.L n n) o = op1 $ \x -> let (l, v, vInv, vTr) = helpEigen x lRep = H.rowsL . SV.replicate $ l fMat = (1 - H.eye) * (lRep - H.tr lRep) - in ( T2 l v - , \(T2 dL dV) -> unsafeCoerce $ + in ( (l, v) + , \(dL, dV) -> unsafeCoerce $ H.tr vInv H.<> (H.diag dL + fMat * (vTr H.<> dV)) H.<> vTr ) {-# INLINE o #-} - t = liftOp1 o u + t = BBP.liftOp1 o u {-# NOINLINE t #-} {-# INLINE eigensystem #-} @@ -661,10 +690,10 @@ meanCov v = (t ^^. _1, t ^^. _2) where m = fromInteger $ natVal (Proxy @m) - t = ($ v) . liftOp1 . op1 $ \x -> - let (μ, σ) = H.meanCov x - in ( T2 μ σ - , \(T2 dμ dσ) -> + t = ($ v) . BBP.liftOp1 . op1 $ \x -> + let ms@(μ, _) = H.meanCov x + in ( ms + , \(dμ, dσ) -> let gradMean = H.rowsL . SV.replicate $ (dμ / H.konst m) @@ -999,23 +1028,25 @@ , H.Domain field vec mat , H.Sized field (mat n n) d , HU.Transposable (mat n n) (mat n n) + , Backprop field + , Backprop (mat n n) ) => BVar s (mat n n) -> (BVar s (mat n n), (BVar s field, BVar s field)) invlndet v = (t ^^. _1, (t ^^. _2, t ^^. _3)) where - o :: Op '[mat n n] (T3 (mat n n) field field) + o :: Op '[mat n n] (mat n n, field, field) o = op1 $ \x -> let (i,(ldet, s)) = H.invlndet x iTr = H.tr i - in ( T3 i ldet s - , \(T3 dI dLDet _) -> + in ( (i, ldet, s) + , \(dI, dLDet, _) -> let gradI = - iTr `H.mul` dI `H.mul` iTr gradLDet = H.konst dLDet * H.tr i in gradI + gradLDet ) {-# INLINE o #-} - t = liftOp1 o v + t = BBP.liftOp1 o v {-# NOINLINE t #-} {-# INLINE invlndet #-} @@ -1102,16 +1133,16 @@ -- If there are missing items, they are treated as zero. extractV :: forall t s q. - ( Reifies q W - , H.Sized t s HU.Vector - , Num s + ( H.Sized t s HU.Vector , HU.Konst t Int HU.Vector , HU.Container HU.Vector t - , Num (HU.Vector t) + , Backprop t + , Backprop s + , Reifies q W ) => BVar q s -> BVar q (HU.Vector t) -extractV = liftOp1 . op1 $ \x -> +extractV = BBP.liftOp1 . op1 $ \x -> let n = H.size x in ( H.extract x , \d -> let m = HU.size d @@ -1127,16 +1158,16 @@ -- If there are missing items, they are treated as zero. extractM :: forall t s q. - ( Reifies q W - , H.Sized t s HU.Matrix - , Num s + ( H.Sized t s HU.Matrix + , Backprop s , HU.Konst t (Int, Int) HU.Matrix , HU.Container HU.Matrix t , Num (HU.Matrix t) + , Reifies q W ) => BVar q s -> BVar q (HU.Matrix t) -extractM = liftOp1 . op1 $ \x -> +extractM = BE.liftOp1 BE.addFunc (BE.ZF (HU.cmap (const 0))) . op1 $ \x -> -- TODO: can be BBP once instances are in Numeric.LinearAlgebra.Backprop let (xI,xJ) = H.size x in ( H.extract x , \d -> let (dI,dJ) = HU.size d @@ -1162,13 +1193,10 @@ {-# INLINE extractM #-} create - :: forall t s d q. (Reifies q W, H.Sized t s d, Num s, Num (d t)) + :: forall t s d q. (Reifies q W, H.Sized t s d, Backprop s, Num (d t), Backprop (d t)) => BVar q (d t) -> Maybe (BVar q s) -create = unANum - . sequenceVar - . isoVar (ANum . H.create) - (maybe 0 H.extract . unANum ) +create = BBP.sequenceVar . BBP.isoVar H.create (maybe 0 H.extract) {-# INLINE create #-} diff --git a/test/Nudge.hs b/test/Nudge.hs --- a/test/Nudge.hs +++ b/test/Nudge.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Nudge where @@ -21,7 +23,6 @@ import Lens.Micro import Lens.Micro.Platform () import Numeric.Backprop -import Numeric.Backprop.Tuple import qualified Data.Ix as Ix import qualified Data.Vector.Sized as SV import qualified Hedgehog.Gen as Gen @@ -36,7 +37,7 @@ eps :: Double eps = 1e-11 -class (Num c, Show c, Show (TIx c)) => Testing c where +class (Backprop c, Show c, Show (TIx c)) => Testing c where type TIx c :: Type allIx :: c -> [TIx c] ixLens :: TIx c -> Lens' c Double @@ -95,7 +96,7 @@ scalarize = liftOp1 . op1 $ \xs -> (HU.sumElements xs, (`HU.konst` HU.size xs)) genTest = HU.fromLists <$> (replicateM 3 . replicateM 2) genTest -instance (KnownNat n, Testing a) => Testing (SV.Vector n a) where +instance (KnownNat n, Testing a, Num a) => Testing (SV.Vector n a) where type TIx (SV.Vector n a) = (Finite n, TIx a) allIx = fst . SV.imapM (\i x -> ((fromIntegral i,) <$> allIx x , x)) ixLens (i,j) = SV.ix i . ixLens j @@ -105,22 +106,22 @@ o = op1 $ \xs -> (SV.sum xs, SV.replicate) genTest = SV.replicateM genTest -instance (Testing a, Testing b) => Testing (T2 a b) where - type TIx (T2 a b) = Either (TIx a) (TIx b) - allIx (T2 x y) = (Left <$> allIx x) - ++ (Right <$> allIx y) +instance (Testing a, Testing b) => Testing (a, b) where + type TIx (a, b) = Either (TIx a) (TIx b) + allIx (x, y) = (Left <$> allIx x) + ++ (Right <$> allIx y) ixLens (Left i) = _1 . ixLens i ixLens (Right j) = _2 . ixLens j scalarize t = B.norm_2V (B.vec2 (scalarize (t ^^. _1)) (scalarize (t ^^. _2)) ) - genTest = T2 <$> genTest <*> genTest + genTest = (,) <$> genTest <*> genTest -instance (Testing a, Testing b, Testing c, Num a, Num b, Num c) => Testing (T3 a b c) where - type TIx (T3 a b c) = Either (TIx a) (Either (TIx b) (TIx c)) - allIx (T3 x y z) = (Left <$> allIx x) - ++ (Right . Left <$> allIx y) - ++ (Right . Right <$> allIx z) +instance (Testing a, Testing b, Testing c) => Testing (a, b, c) where + type TIx (a, b, c) = Either (TIx a) (Either (TIx b) (TIx c)) + allIx (x, y, z) = (Left <$> allIx x) + ++ (Right . Left <$> allIx y) + ++ (Right . Right <$> allIx z) ixLens (Left i ) = _1 . ixLens i ixLens (Right (Left j)) = _2 . ixLens j ixLens (Right (Right k)) = _3 . ixLens k @@ -128,7 +129,7 @@ (scalarize (t ^^. _2)) (scalarize (t ^^. _3)) ) - genTest = T3 <$> genTest <*> genTest <*> genTest + genTest = (,,) <$> genTest <*> genTest <*> genTest validGrad :: Monad m @@ -166,12 +167,21 @@ (inpC, inpD, i) <- forAll $ do inpC <- genTest inpD <- genTest - i <- Gen.element (allIx (T2 inpC inpD)) + i <- Gen.element (allIx (inpC, inpD)) return (inpC, inpD, i) - let (r, gr) = second tupT2 $ backprop2 (\x -> scalarize . f x) inpC inpD + let (r, gr) = backprop2 (\x -> scalarize . f x) inpC inpD when (r**2 < eps) discard - (old, new) <- validGrad (ixLens i) (T2 inpC inpD) gr + (old, new) <- validGrad (ixLens i) (inpC, inpD) gr (evalBP (\t -> scalarize $ f (t ^^. _1) (t ^^. _2))) footnoteShow (r, gr, old, new, (old - new)**2, ((old - new)/old)**2) assert $ ((old - new)/old)**2 < eps +instance (HU.Container HU.Vector a, Num a) => Backprop (HU.Matrix a) where + zero = HU.cmap (const 0) + add = HU.add + one = HU.cmap (const 1) + +instance (KnownNat n, Num a) => Backprop (SV.Vector n a) where + zero = (0 <$) + add = (+) + one = (1 <$) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,7 +11,6 @@ import Lens.Micro import Nudge import Numeric.Backprop -import Numeric.Backprop.Tuple import Numeric.LinearAlgebra.Static (L, R) import System.Exit import System.IO @@ -21,11 +20,11 @@ prop_vec2 = nudgeProp2 B.vec2 prop_vec3 :: Property -prop_vec3 = nudgeProp @(T3 Double Double Double) +prop_vec3 = nudgeProp @(Double, Double, Double) (\t -> B.vec3 (t ^^. _1) (t ^^. _2) (t ^^. _3)) prop_vec4 :: Property -prop_vec4 = nudgeProp2 @(T2 Double Double) @(T2 Double Double) +prop_vec4 = nudgeProp2 @(Double, Double) @(Double, Double) (\x y -> B.vec4 (x ^^. _1) (x ^^. _2) (y ^^. _1) (y ^^. _2)) prop_snoc :: Property