6d0b8c3...master · grenade

.gitignore+1

since splitsnapshots

unifiedsplit

@@ -3,3 +3,4 @@ cabal.project.local

3cabal.sandbox.config

4dist/

5dist-newstyle/

6+.stack-work/

.travis.yml+7−6

@@ -6,25 +6,26 @@ env:

6 - GHCVER=8.2.2

7 - GHCVER=8.4.4

8 - GHCVER=8.6.5

9− - GHCVER=8.8.2

9+ - GHCVER=8.8.3

10+ - GHCVER=8.10.1

10

11

11# Note: the distinction between `before_install` and `install` is not important.

12# Note: the distinction between `before_install` and `install` is not important.

12before_install:

13before_install:

13 - travis_retry sudo add-apt-repository -y ppa:hvr/ghc

14 - travis_retry sudo add-apt-repository -y ppa:hvr/ghc

14 - travis_retry sudo apt-get update

15 - travis_retry sudo apt-get update

15− - travis_retry sudo apt-get install cabal-install-3.0 ghc-$GHCVER libblas-dev liblapack-dev

16+ - travis_retry sudo apt-get install cabal-install-3.2 ghc-$GHCVER libblas-dev liblapack-dev

16 - export PATH=/opt/cabal/bin:/opt/ghc/$GHCVER/bin:$PATH

17 - export PATH=/opt/cabal/bin:/opt/ghc/$GHCVER/bin:$PATH

17

18

18install:

19install:

19 - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

20 - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

20− - travis_retry cabal-3.0 update

21+ - travis_retry cabal-3.2 update

21

22

22notifications:

23notifications:

23 email: false

24 email: false

24

25

25# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.

26# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.

26script:

27script:

27− - cabal-3.0 configure --enable-tests

28+ - cabal-3.2 configure --enable-tests

28− - cabal-3.0 build all

29+ - cabal-3.2 build all

29− - cabal-3.0 test --test-show-details=direct -j1

30+ - cabal-3.2 test --test-show-details=direct -j1

30

31

examples/grenade-examples.cabal+6−5

@@ -26,7 +26,7 @@ executable feedforward

26 , bytestring

27 , cereal

28 , either

29− , optparse-applicative >= 0.13 && < 0.16

29+ , optparse-applicative >= 0.13 && < 0.18

30 , text == 1.2.*

31 , mtl >= 2.2.1 && < 2.3

32 , hmatrix

@@ -42,7 +42,7 @@ executable mnist

42 , grenade

43 , attoparsec

44 , either

45− , optparse-applicative >= 0.13 && < 0.16

45+ , optparse-applicative >= 0.13 && < 0.18

46 , text == 1.2.*

47 , mtl >= 2.2.1 && < 2.3

48 , hmatrix >= 0.18 && < 0.21

@@ -61,7 +61,7 @@ executable gan-mnist

61 , bytestring

62 , cereal

63 , either

64− , optparse-applicative >= 0.13 && < 0.16

64+ , optparse-applicative >= 0.13 && < 0.18

65 , text == 1.2.*

66 , mtl >= 2.2.1 && < 2.3

67 , hmatrix >= 0.18 && < 0.21

@@ -78,7 +78,7 @@ executable recurrent

78 , grenade

79 , attoparsec

80 , either

81− , optparse-applicative >= 0.13 && < 0.16

81+ , optparse-applicative >= 0.13 && < 0.18

82 , text == 1.2.*

83 , mtl >= 2.2.1 && < 2.3

84 , hmatrix >= 0.18 && < 0.21

@@ -96,13 +96,14 @@ executable shakespeare

96 , bytestring

97 , cereal

98 , either

99− , optparse-applicative >= 0.13 && < 0.16

99+ , optparse-applicative >= 0.13 && < 0.18

100 , text == 1.2.*

101 , mtl >= 2.2.1 && < 2.3

102 , hmatrix >= 0.18 && < 0.21

103 , transformers

104 , semigroups

105 , singletons

106+ , singletons-base

106 , vector

107 , vector

107 , MonadRandom

108 , MonadRandom

108 , containers

109 , containers

examples/main/feedforward.hs+3−1

@@ -1,4 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

@@ -10,8 +11,9 @@ import Data.List ( foldl' )

10

11

11import qualified Data.ByteString as B

12import qualified Data.ByteString as B

12import Data.Serialize

13import Data.Serialize

14+#if ! MIN_VERSION_base(4,13,0)

13import Data.Semigroup ( (<>) )

15import Data.Semigroup ( (<>) )

14−

16+#endif

15import GHC.TypeLits

17import GHC.TypeLits

16

18

17import qualified Numeric.LinearAlgebra.Static as SA

19import qualified Numeric.LinearAlgebra.Static as SA

examples/main/gan-mnist.hs+3

@@ -1,4 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GADTs #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

@@ -43,7 +44,9 @@ import Control.Monad.Trans.Except

43import qualified Data.Attoparsec.Text as A

44import qualified Data.Attoparsec.Text as A

44import qualified Data.ByteString as B

45import qualified Data.ByteString as B

45import Data.List ( foldl' )

46import Data.List ( foldl' )

47+#if ! MIN_VERSION_base(4,13,0)

46import Data.Semigroup ( (<>) )

48import Data.Semigroup ( (<>) )

49+#endif

47import Data.Serialize

50import Data.Serialize

48import qualified Data.Text as T

51import qualified Data.Text as T

49import qualified Data.Text.IO as T

52import qualified Data.Text.IO as T

examples/main/mnist.hs+4

@@ -1,4 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

@@ -13,7 +14,10 @@ import Control.Monad.Trans.Except

13

14

14import qualified Data.Attoparsec.Text as A

15import qualified Data.Attoparsec.Text as A

15import Data.List ( foldl' )

16import Data.List ( foldl' )

17+#if ! MIN_VERSION_base(4,13,0)

16import Data.Semigroup ( (<>) )

18import Data.Semigroup ( (<>) )

19+#endif

20+

17import qualified Data.Text as T

21import qualified Data.Text as T

18import qualified Data.Text.IO as T

22import qualified Data.Text.IO as T

19import qualified Data.Vector.Storable as V

23import qualified Data.Vector.Storable as V

examples/main/recurrent.hs+4

@@ -9,8 +9,12 @@

9import Control.Monad ( foldM )

10import Control.Monad.Random ( MonadRandom, getRandomR )

11

12+#if MIN_VERSION_base(4,13,0)

13+import Data.List ( unfoldr )

14+#else

12import Data.List ( cycle, unfoldr )

15import Data.List ( cycle, unfoldr )

13import Data.Semigroup ( (<>) )

16import Data.Semigroup ( (<>) )

17+#endif

14

18

15import qualified Numeric.LinearAlgebra.Static as SA

19import qualified Numeric.LinearAlgebra.Static as SA

16

20

examples/main/shakespeare.hs+16−16

@@ -1,5 +1,5 @@

1{-# LANGUAGE BangPatterns #-}

2−{-# LANGUAGE RecordWildCards #-}

2+{-# LANGUAGE CPP #-}

3{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE TypeOperators #-}

@@ -13,18 +13,16 @@ import Control.Monad.Trans.Except

13import Data.Char ( isUpper, toUpper, toLower )

14import Data.List ( foldl' )

15import Data.Maybe ( fromMaybe )

16−import Data.Semigroup ( (<>) )

16+

17

18import qualified Data.Vector as V

19import Data.Vector ( Vector )

20

21import qualified Data.Map as M

22−import Data.Proxy ( Proxy (..) )

23

22

24import qualified Data.ByteString as B

23import qualified Data.ByteString as B

25import Data.Serialize

24import Data.Serialize

26

25

27−import Data.Singletons.Prelude

28import GHC.TypeLits

26import GHC.TypeLits

29

27

30import Numeric.LinearAlgebra.Static ( konst )

28import Numeric.LinearAlgebra.Static ( konst )

@@ -36,6 +34,8 @@ import Grenade.Recurrent

36import Grenade.Utils.OneHot

34import Grenade.Utils.OneHot

37

35

38import System.IO.Unsafe ( unsafeInterleaveIO )

36import System.IO.Unsafe ( unsafeInterleaveIO )

37+import Data.Proxy

38+import Prelude.Singletons

39

40-- The defininition for our natural language recurrent network.

41-- This network is able to learn and generate simple words in

@@ -77,34 +77,34 @@ loadShakespeare path = do

77 return (V.fromList hot, m, cs)

78

79trainSlice :: LearningParameters -> Shakespeare -> Shakespearian -> Vector Int -> Int -> Int -> (Shakespeare, Shakespearian)

80−trainSlice !rate !net !recIns input offset size =

80+trainSlice !lrate !net !recIns input offset size =

81 let e = fmap (x . oneHot) . V.toList $ V.slice offset size input

82 in case reverse e of

83 (o : l : xs) ->

84 let examples = reverse $ (l, Just o) : ((,Nothing) <$> xs)

85− in trainRecurrent rate net recIns examples

85+ in trainRecurrent lrate net recIns examples

86 _ -> error "Not enough input"

87 where

88 x = fromMaybe (error "Hot variable didn't fit.")

89

90runShakespeare :: ShakespeareOpts -> ExceptT String IO ()

91−runShakespeare ShakespeareOpts {..} = do

91+runShakespeare opts = do

92− (shakespeare, oneHotMap, oneHotDictionary) <- loadShakespeare trainingFile

92+ (shakespeare, oneHotMap, oneHotDictionary) <- loadShakespeare $ trainingFile opts

93 (net0, i0) <- lift $

94− case loadPath of

94+ case loadPath opts of

95 Just loadFile -> netLoad loadFile

96 Nothing -> (,0) <$> randomNet

97

98 (trained, bestInput) <- lift $ foldM (\(!net, !io) size -> do

99− xs <- take (iterations `div` 10) <$> getRandomRs (0, length shakespeare - size - 1)

99+ xs <- take (iterations opts `div` 10) <$> getRandomRs (0, length shakespeare - size - 1)

100− let (!trained, !bestInput) = foldl' (\(!n, !i) offset -> trainSlice rate n i shakespeare offset size) (net, io) xs

100+ let (!trained, !bestInput) = foldl' (\(!n, !i) offset -> trainSlice (rate opts) n i shakespeare offset size) (net, io) xs

101− results <- take 1000 <$> generateParagraph trained bestInput temperature oneHotMap oneHotDictionary ( S1D $ konst 0)

101+ results <- take 1000 <$> generateParagraph trained bestInput (temperature opts) oneHotMap oneHotDictionary ( S1D $ konst 0)

102 putStrLn ("TRAINING STEP WITH SIZE: " ++ show size)

103 putStrLn (unAnnotateCapitals results)

104 return (trained, bestInput)

105− ) (net0, i0) $ replicate 10 sequenceSize

105+ ) (net0, i0) $ replicate 10 (sequenceSize opts)

106

107− case savePath of

107+ case savePath opts of

108 Just saveFile -> lift . B.writeFile saveFile $ runPut (put trained >> put bestInput)

109 Nothing -> return ()

110

@@ -116,12 +116,12 @@ generateParagraph :: forall layers shapes n a. (Last shapes ~ 'D1 n, Head shapes

116 -> Vector a

117 -> S ('D1 n)

118 -> IO [a]

119−generateParagraph n s temperature hotmap hotdict =

119+generateParagraph n s temp hotmap hotdict =

120 go s

121 where

122 go x y =

123 do let (_, ns, o) = runRecurrent n x y

124− un <- sample temperature hotdict o

124+ un <- sample temp hotdict o

125 Just re <- return $ makeHot hotmap un

126 rest <- unsafeInterleaveIO $ go ns re

127 return (un : rest)

grenade.cabal+2−1

@@ -38,7 +38,7 @@ source-repository head

38library

39 build-depends:

40 base >= 4.8 && < 5

41− , bytestring == 0.10.*

41+ , bytestring >= 0.10.0

42 , containers >= 0.5 && < 0.7

43 , cereal >= 0.5 && < 0.6

44 , deepseq >= 1.4 && < 1.5

@@ -48,6 +48,7 @@ library

48 -- Versions of singletons are *tightly* coupled with the

49 -- GHC version so its fine to drop version bounds.

50 , singletons

51+ , singletons-base

51 , vector >= 0.11 && < 0.13

52 , vector >= 0.11 && < 0.13

52

53

53 ghc-options:

54 ghc-options:

src/Grenade/Core/Network.hs+1−1

@@ -34,7 +34,6 @@ module Grenade.Core.Network (

34import Control.Monad.Random ( MonadRandom )

35

36import Data.Singletons

37−import Data.Singletons.Prelude

38import Data.Serialize

37import Data.Serialize

39

38

40#if MIN_VERSION_base(4,9,0)

39#if MIN_VERSION_base(4,9,0)

@@ -44,6 +43,7 @@ import Data.Kind (Type)

44import Grenade.Core.Layer

43import Grenade.Core.Layer

45import Grenade.Core.LearningParameters

44import Grenade.Core.LearningParameters

46import Grenade.Core.Shape

45import Grenade.Core.Shape

46+import Prelude.Singletons

47

48-- | Type of a network.

49--

src/Grenade/Core/Runner.hs+2−1

@@ -13,11 +13,12 @@ module Grenade.Core.Runner (

13 , runNet

14 ) where

15

16−import Data.Singletons.Prelude

17

16

18import Grenade.Core.LearningParameters

17import Grenade.Core.LearningParameters

19import Grenade.Core.Network

18import Grenade.Core.Network

20import Grenade.Core.Shape

19import Grenade.Core.Shape

20+import Data.Singletons

21+import Prelude.Singletons

21

22

22-- | Perform reverse automatic differentiation on the network

23-- | Perform reverse automatic differentiation on the network

23-- for the current input and expected output.

24-- for the current input and expected output.

src/Grenade/Core/Shape.hs+16−30

@@ -21,34 +21,20 @@ Stability : experimental

21module Grenade.Core.Shape (

22 S (..)

23 , Shape (..)

24− , Sing (..)

25−#if MIN_VERSION_singletons(2,6,0)

26 , SShape (..)

24 , SShape (..)

27−#endif

28−

29 , randomOfShape

25 , randomOfShape

30 , fromStorable

26 , fromStorable

31 ) where

27 ) where

32

28

33import Control.DeepSeq (NFData (..))

29import Control.DeepSeq (NFData (..))

34import Control.Monad.Random ( MonadRandom, getRandom )

30import Control.Monad.Random ( MonadRandom, getRandom )

35−

36−#if MIN_VERSION_base(4,13,0)

37import Data.Kind (Type)

31import Data.Kind (Type)

38−#endif

39import Data.Proxy

32import Data.Proxy

40import Data.Serialize

33import Data.Serialize

41import Data.Singletons

34import Data.Singletons

42−import Data.Singletons.TypeLits

43import Data.Vector.Storable ( Vector )

35import Data.Vector.Storable ( Vector )

44import qualified Data.Vector.Storable as V

36import qualified Data.Vector.Storable as V

45−

46−#if MIN_VERSION_base(4,11,0)

47−import GHC.TypeLits hiding (natVal)

48−#else

49import GHC.TypeLits

37import GHC.TypeLits

50−#endif

51−

52import qualified Numeric.LinearAlgebra.Static as H

38import qualified Numeric.LinearAlgebra.Static as H

53import Numeric.LinearAlgebra.Static

39import Numeric.LinearAlgebra.Static

54import qualified Numeric.LinearAlgebra as NLA

40import qualified Numeric.LinearAlgebra as NLA

@@ -98,9 +84,9 @@ deriving instance Show (S n)

98type instance Sing = SShape

84type instance Sing = SShape

99

85

100data SShape :: Shape -> Type where

86data SShape :: Shape -> Type where

101− D1Sing :: Sing a -> SShape ('D1 a)

87+ D1Sing :: KnownNat a => SShape ('D1 a)

102− D2Sing :: Sing a -> Sing b -> SShape ('D2 a b)

88+ D2Sing :: (KnownNat a, KnownNat b) => SShape ('D2 a b)

103− D3Sing :: KnownNat (a * c) => Sing a -> Sing b -> Sing c -> SShape ('D3 a b c)

89+ D3Sing :: (KnownNat (a * c), KnownNat a, KnownNat b, KnownNat c) => SShape ('D3 a b c)

104#else

90#else

105data instance Sing (n :: Shape) where

91data instance Sing (n :: Shape) where

106 D1Sing :: Sing a -> Sing ('D1 a)

92 D1Sing :: Sing a -> Sing ('D1 a)

@@ -109,11 +95,11 @@ data instance Sing (n :: Shape) where

109#endif

95#endif

110

96

111instance KnownNat a => SingI ('D1 a) where

97instance KnownNat a => SingI ('D1 a) where

112− sing = D1Sing sing

98+ sing = D1Sing

113instance (KnownNat a, KnownNat b) => SingI ('D2 a b) where

99instance (KnownNat a, KnownNat b) => SingI ('D2 a b) where

114− sing = D2Sing sing sing

100+ sing = D2Sing

115instance (KnownNat a, KnownNat b, KnownNat c, KnownNat (a * c)) => SingI ('D3 a b c) where

101instance (KnownNat a, KnownNat b, KnownNat c, KnownNat (a * c)) => SingI ('D3 a b c) where

116− sing = D3Sing sing sing sing

102+ sing = D3Sing

117

103

118instance SingI x => Num (S x) where

104instance SingI x => Num (S x) where

119 (+) = n2 (+)

105 (+) = n2 (+)

@@ -162,13 +148,13 @@ randomOfShape :: forall x m. ( MonadRandom m, SingI x ) => m (S x)

162randomOfShape = do

148randomOfShape = do

163 seed :: Int <- getRandom

149 seed :: Int <- getRandom

164 return $ case (sing :: Sing x) of

150 return $ case (sing :: Sing x) of

165− D1Sing SNat ->

151+ D1Sing ->

166 S1D (randomVector seed Uniform * 2 - 1)

152 S1D (randomVector seed Uniform * 2 - 1)

167

153

168− D2Sing SNat SNat ->

154+ D2Sing ->

169 S2D (uniformSample seed (-1) 1)

155 S2D (uniformSample seed (-1) 1)

170

156

171− D3Sing SNat SNat SNat ->

157+ D3Sing ->

172 S3D (uniformSample seed (-1) 1)

158 S3D (uniformSample seed (-1) 1)

173

159

174-- | Generate a shape from a Storable Vector.

160-- | Generate a shape from a Storable Vector.

@@ -176,13 +162,13 @@ randomOfShape = do

176-- Returns Nothing if the vector is of the wrong size.

162-- Returns Nothing if the vector is of the wrong size.

177fromStorable :: forall x. SingI x => Vector Double -> Maybe (S x)

163fromStorable :: forall x. SingI x => Vector Double -> Maybe (S x)

178fromStorable xs = case sing :: Sing x of

164fromStorable xs = case sing :: Sing x of

179− D1Sing SNat ->

165+ D1Sing ->

180 S1D <$> H.create xs

166 S1D <$> H.create xs

181

167

182− D2Sing SNat SNat ->

168+ D2Sing ->

183 S2D <$> mkL xs

169 S2D <$> mkL xs

184

170

185− D3Sing SNat SNat SNat ->

171+ D3Sing ->

186 S3D <$> mkL xs

172 S3D <$> mkL xs

187 where

173 where

188 mkL :: forall rows columns. (KnownNat rows, KnownNat columns)

174 mkL :: forall rows columns. (KnownNat rows, KnownNat columns)

@@ -219,13 +205,13 @@ n2 f (S2D x) (S2D y) = S2D (f x y)

219n2 f (S3D x) (S3D y) = S3D (f x y)

205n2 f (S3D x) (S3D y) = S3D (f x y)

220

206

221-- Helper function for creating the number instances

207-- Helper function for creating the number instances

222−nk :: forall x. SingI x => Double -> S x

208+nk :: forall x. (SingI x) => Double -> S x

223nk x = case (sing :: Sing x) of

209nk x = case (sing :: Sing x) of

224− D1Sing SNat ->

210+ D1Sing ->

225 S1D (konst x)

211 S1D (konst x)

226

212

227− D2Sing SNat SNat ->

213+ D2Sing ->

228 S2D (konst x)

214 S2D (konst x)

229

215

230− D3Sing SNat SNat SNat ->

216+ D3Sing ->

231 S3D (konst x)

217 S3D (konst x)

src/Grenade/Layers/Convolution.hs+2−10

@@ -1,7 +1,6 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4−{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GADTs #-}

6{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

7{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeFamilies #-}

@@ -29,16 +28,9 @@ import Control.Monad.Random hiding ( fromList )

29import Data.Maybe

28import Data.Maybe

30import Data.Proxy

29import Data.Proxy

31import Data.Serialize

30import Data.Serialize

32−import Data.Singletons.TypeLits

33

31

34−#if MIN_VERSION_base(4,11,0)

35−import GHC.TypeLits hiding (natVal)

36−#else

37import GHC.TypeLits

32import GHC.TypeLits

38−#endif

39−#if MIN_VERSION_base(4,9,0)

40import Data.Kind (Type)

33import Data.Kind (Type)

41−#endif

42

34

43import Numeric.LinearAlgebra hiding ( uniformSample, konst )

35import Numeric.LinearAlgebra hiding ( uniformSample, konst )

44import qualified Numeric.LinearAlgebra as LA

36import qualified Numeric.LinearAlgebra as LA

@@ -139,8 +131,8 @@ instance ( KnownNat channels

139 , KnownNat (kernelRows * kernelColumns * channels)

131 , KnownNat (kernelRows * kernelColumns * channels)

140 ) => UpdateLayer (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) where

132 ) => UpdateLayer (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) where

141 type Gradient (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Convolution' channels filters kernelRows kernelColumns strideRows strideColumns)

133 type Gradient (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Convolution' channels filters kernelRows kernelColumns strideRows strideColumns)

142− runUpdate LearningParameters {..} (Convolution oldKernel oldMomentum) (Convolution' kernelGradient) =

134+ runUpdate lp (Convolution oldKernel oldMomentum) (Convolution' kernelGradient) =

143− let (newKernel, newMomentum) = descendMatrix learningRate learningMomentum learningRegulariser oldKernel kernelGradient oldMomentum

135+ let (newKernel, newMomentum) = descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldKernel kernelGradient oldMomentum

144 in Convolution newKernel newMomentum

136 in Convolution newKernel newMomentum

145

137

146 createRandom = randomConvolution

138 createRandom = randomConvolution

src/Grenade/Layers/Crop.hs−7

@@ -21,16 +21,9 @@ module Grenade.Layers.Crop (

21import Data.Maybe

22import Data.Proxy

23import Data.Serialize

24−import Data.Singletons.TypeLits

25

24

26−#if MIN_VERSION_base(4,11,0)

27−import GHC.TypeLits hiding (natVal)

28−#else

29import GHC.TypeLits

25import GHC.TypeLits

30−#endif

31−#if MIN_VERSION_base(4,9,0)

32import Data.Kind (Type)

26import Data.Kind (Type)

33−#endif

34

27

35import Grenade.Core

28import Grenade.Core

36import Grenade.Layers.Internal.Pad

29import Grenade.Layers.Internal.Pad

src/Grenade/Layers/Deconvolution.hs+2−10

@@ -1,7 +1,6 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4−{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GADTs #-}

6{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

7{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeFamilies #-}

@@ -33,16 +32,9 @@ import Control.Monad.Random hiding ( fromList )

33import Data.Maybe

32import Data.Maybe

34import Data.Proxy

33import Data.Proxy

35import Data.Serialize

34import Data.Serialize

36−import Data.Singletons.TypeLits

37

35

38−#if MIN_VERSION_base(4,11,0)

39−import GHC.TypeLits hiding (natVal)

40−#else

41import GHC.TypeLits

36import GHC.TypeLits

42−#endif

43−#if MIN_VERSION_base(4,9,0)

44import Data.Kind (Type)

37import Data.Kind (Type)

45−#endif

46

38

47import Numeric.LinearAlgebra hiding ( uniformSample, konst )

39import Numeric.LinearAlgebra hiding ( uniformSample, konst )

48import qualified Numeric.LinearAlgebra as LA

40import qualified Numeric.LinearAlgebra as LA

@@ -138,8 +130,8 @@ instance ( KnownNat channels

138 , KnownNat (kernelRows * kernelColumns * filters)

130 , KnownNat (kernelRows * kernelColumns * filters)

139 ) => UpdateLayer (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) where

131 ) => UpdateLayer (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) where

140 type Gradient (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Deconvolution' channels filters kernelRows kernelColumns strideRows strideColumns)

132 type Gradient (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Deconvolution' channels filters kernelRows kernelColumns strideRows strideColumns)

141− runUpdate LearningParameters {..} (Deconvolution oldKernel oldMomentum) (Deconvolution' kernelGradient) =

133+ runUpdate lp (Deconvolution oldKernel oldMomentum) (Deconvolution' kernelGradient) =

142− let (newKernel, newMomentum) = descendMatrix learningRate learningMomentum learningRegulariser oldKernel kernelGradient oldMomentum

134+ let (newKernel, newMomentum) = descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldKernel kernelGradient oldMomentum

143 in Deconvolution newKernel newMomentum

135 in Deconvolution newKernel newMomentum

144

136

145 createRandom = randomDeconvolution

137 createRandom = randomDeconvolution

src/Grenade/Layers/FullyConnected.hs+4−5

@@ -1,5 +1,4 @@

1{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE TypeOperators #-}

2{-# LANGUAGE TypeOperators #-}

4{-# LANGUAGE TypeFamilies #-}

3{-# LANGUAGE TypeFamilies #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

@@ -14,7 +13,6 @@ import Control.Monad.Random hiding (fromList)

14

13

15import Data.Proxy

14import Data.Proxy

16import Data.Serialize

15import Data.Serialize

17−import Data.Singletons.TypeLits

18

16

19import qualified Numeric.LinearAlgebra as LA

17import qualified Numeric.LinearAlgebra as LA

20import Numeric.LinearAlgebra.Static

18import Numeric.LinearAlgebra.Static

@@ -22,6 +20,7 @@ import Numeric.LinearAlgebra.Static

22import Grenade.Core

20import Grenade.Core

23

21

24import Grenade.Layers.Internal.Update

22import Grenade.Layers.Internal.Update

23+import GHC.TypeLits

25

24

26-- | A basic fully connected (or inner product) neural network layer.

25-- | A basic fully connected (or inner product) neural network layer.

27data FullyConnected i o = FullyConnected

26data FullyConnected i o = FullyConnected

@@ -38,9 +37,9 @@ instance Show (FullyConnected i o) where

38instance (KnownNat i, KnownNat o) => UpdateLayer (FullyConnected i o) where

37instance (KnownNat i, KnownNat o) => UpdateLayer (FullyConnected i o) where

39 type Gradient (FullyConnected i o) = (FullyConnected' i o)

38 type Gradient (FullyConnected i o) = (FullyConnected' i o)

40

39

41− runUpdate LearningParameters {..} (FullyConnected (FullyConnected' oldBias oldActivations) (FullyConnected' oldBiasMomentum oldMomentum)) (FullyConnected' biasGradient activationGradient) =

40+ runUpdate lp (FullyConnected (FullyConnected' oldBias oldActivations) (FullyConnected' oldBiasMomentum oldMomentum)) (FullyConnected' biasGradient activationGradient) =

42− let (newBias, newBiasMomentum) = descendVector learningRate learningMomentum learningRegulariser oldBias biasGradient oldBiasMomentum

41+ let (newBias, newBiasMomentum) = descendVector (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldBias biasGradient oldBiasMomentum

43− (newActivations, newMomentum) = descendMatrix learningRate learningMomentum learningRegulariser oldActivations activationGradient oldMomentum

42+ (newActivations, newMomentum) = descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldActivations activationGradient oldMomentum

44 in FullyConnected (FullyConnected' newBias newActivations) (FullyConnected' newBiasMomentum newMomentum)

43 in FullyConnected (FullyConnected' newBias newActivations) (FullyConnected' newBiasMomentum newMomentum)

45

44

46 createRandom = randomFullyConnected

45 createRandom = randomFullyConnected

src/Grenade/Layers/Pad.hs−7

@@ -21,16 +21,9 @@ module Grenade.Layers.Pad (

21import Data.Maybe

22import Data.Proxy

23import Data.Serialize

24−import Data.Singletons.TypeLits

25

24

26−#if MIN_VERSION_base(4,11,0)

27−import GHC.TypeLits hiding (natVal)

28−#else

29import GHC.TypeLits

25import GHC.TypeLits

30−#endif

31−#if MIN_VERSION_base(4,9,0)

32import Data.Kind (Type)

26import Data.Kind (Type)

33−#endif

34

27

35import Grenade.Core

28import Grenade.Core

36import Grenade.Layers.Internal.Pad

29import Grenade.Layers.Internal.Pad

src/Grenade/Layers/Pooling.hs−7

@@ -22,16 +22,9 @@ module Grenade.Layers.Pooling (

22import Data.Maybe

23import Data.Proxy

24import Data.Serialize

25−import Data.Singletons.TypeLits

26

25

27−#if MIN_VERSION_base(4,11,0)

28−import GHC.TypeLits hiding (natVal)

29−#else

30import GHC.TypeLits

26import GHC.TypeLits

31−#endif

32−#if MIN_VERSION_base(4,9,0)

33import Data.Kind (Type)

27import Data.Kind (Type)

34−#endif

35

28

36import Grenade.Core

29import Grenade.Core

37import Grenade.Layers.Internal.Pooling

30import Grenade.Layers.Internal.Pooling

src/Grenade/Layers/Reshape.hs−1

@@ -17,7 +17,6 @@ module Grenade.Layers.Reshape (

17

18import Data.Serialize

19

20−import Data.Singletons.TypeLits

21import GHC.TypeLits

20import GHC.TypeLits

22

21

23import Numeric.LinearAlgebra.Static

22import Numeric.LinearAlgebra.Static

src/Grenade/Recurrent/Core/Network.hs+1−4

@@ -29,16 +29,13 @@ module Grenade.Recurrent.Core.Network (

29

30

31import Control.Monad.Random ( MonadRandom )

32−import Data.Singletons ( SingI )

33−import Data.Singletons.Prelude ( Head, Last )

34import Data.Serialize

32import Data.Serialize

35

33

36−#if MIN_VERSION_base(4,9,0)

37import Data.Kind (Type)

34import Data.Kind (Type)

38−#endif

39

35

40import Grenade.Core

36import Grenade.Core

41import Grenade.Recurrent.Core.Layer

37import Grenade.Recurrent.Core.Layer

38+import Prelude.Singletons

42

39

43-- | Witness type to say indicate we're building up with a normal feed

40-- | Witness type to say indicate we're building up with a normal feed

44-- forward layer.

41-- forward layer.

src/Grenade/Recurrent/Core/Runner.hs+5−6

@@ -6,7 +6,6 @@

6{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE FlexibleContexts #-}

8{-# LANGUAGE RankNTypes #-}

9−{-# LANGUAGE RecordWildCards #-}

10

9

11module Grenade.Recurrent.Core.Runner (

10module Grenade.Recurrent.Core.Runner (

12 runRecurrentExamples

11 runRecurrentExamples

@@ -18,10 +17,10 @@ module Grenade.Recurrent.Core.Runner (

18 ) where

17 ) where

19

18

20import Data.List ( foldl' )

19import Data.List ( foldl' )

21−import Data.Singletons.Prelude

22import Grenade.Core

20import Grenade.Core

23

21

24import Grenade.Recurrent.Core.Network

22import Grenade.Recurrent.Core.Network

23+import Prelude.Singletons

25

24

26type RecurrentGradients layers = [RecurrentGradient layers]

25type RecurrentGradients layers = [RecurrentGradient layers]

27

26

@@ -101,11 +100,11 @@ updateRecInputs :: Fractional (RecurrentInputs sublayers)

101 -> RecurrentInputs sublayers

100 -> RecurrentInputs sublayers

102 -> RecurrentInputs sublayers

101 -> RecurrentInputs sublayers

103

102

104−updateRecInputs l@LearningParameters {..} (() :~~+> xs) (() :~~+> ys)

103+updateRecInputs lp (() :~~+> xs) (() :~~+> ys)

105− = () :~~+> updateRecInputs l xs ys

104+ = () :~~+> updateRecInputs lp xs ys

106

105

107−updateRecInputs l@LearningParameters {..} (x :~@+> xs) (y :~@+> ys)

106+updateRecInputs lp (x :~@+> xs) (y :~@+> ys)

108− = (realToFrac (1 - learningRate * learningRegulariser) * x - realToFrac learningRate * y) :~@+> updateRecInputs l xs ys

107+ = (realToFrac (1 - learningRate lp * learningRegulariser lp) * x - realToFrac (learningRate lp) * y) :~@+> updateRecInputs lp xs ys

109

108

110updateRecInputs _ RINil RINil

109updateRecInputs _ RINil RINil

111 = RINil

110 = RINil

src/Grenade/Recurrent/Layers/BasicRecurrent.hs+4−8

@@ -1,7 +1,6 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE GADTs #-}

4−{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE TypeOperators #-}

4{-# LANGUAGE TypeOperators #-}

6{-# LANGUAGE TypeFamilies #-}

5{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

@@ -17,11 +16,8 @@ module Grenade.Recurrent.Layers.BasicRecurrent (

17

16

18import Control.Monad.Random ( MonadRandom, getRandom )

17import Control.Monad.Random ( MonadRandom, getRandom )

19

18

20−import Data.Singletons.TypeLits

21

19

22−#if MIN_VERSION_base(4,9,0)

23import Data.Kind (Type)

20import Data.Kind (Type)

24−#endif

25

21

26import Numeric.LinearAlgebra.Static

22import Numeric.LinearAlgebra.Static

27

23

@@ -60,11 +56,11 @@ instance Show (BasicRecurrent i o) where

60instance (KnownNat i, KnownNat o, KnownNat (i + o)) => UpdateLayer (BasicRecurrent i o) where

56instance (KnownNat i, KnownNat o, KnownNat (i + o)) => UpdateLayer (BasicRecurrent i o) where

61 type Gradient (BasicRecurrent i o) = (BasicRecurrent' i o)

57 type Gradient (BasicRecurrent i o) = (BasicRecurrent' i o)

62

58

63− runUpdate LearningParameters {..} (BasicRecurrent oldBias oldBiasMomentum oldActivations oldMomentum) (BasicRecurrent' biasGradient activationGradient) =

59+ runUpdate lp (BasicRecurrent oldBias oldBiasMomentum oldActivations oldMomentum) (BasicRecurrent' biasGradient activationGradient) =

64− let newBiasMomentum = konst learningMomentum * oldBiasMomentum - konst learningRate * biasGradient

60+ let newBiasMomentum = konst (learningMomentum lp) * oldBiasMomentum - konst (learningRate lp) * biasGradient

65 newBias = oldBias + newBiasMomentum

61 newBias = oldBias + newBiasMomentum

66− newMomentum = konst learningMomentum * oldMomentum - konst learningRate * activationGradient

62+ newMomentum = konst (learningMomentum lp) * oldMomentum - konst (learningRate lp) * activationGradient

67− regulariser = konst (learningRegulariser * learningRate) * oldActivations

63+ regulariser = konst (learningRegulariser lp * learningRate lp) * oldActivations

68 newActivations = oldActivations + newMomentum - regulariser

64 newActivations = oldActivations + newMomentum - regulariser

69 in BasicRecurrent newBias newBiasMomentum newActivations newMomentum

65 in BasicRecurrent newBias newBiasMomentum newActivations newMomentum

70

66

src/Grenade/Recurrent/Layers/LSTM.hs+41−55

@@ -3,7 +3,6 @@

3{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE GADTs #-}

5{-# LANGUAGE RankNTypes #-}

6−{-# LANGUAGE RecordWildCards #-}

7{-# LANGUAGE TypeOperators #-}

6{-# LANGUAGE TypeOperators #-}

8{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE MultiParamTypeClasses #-}

8{-# LANGUAGE MultiParamTypeClasses #-}

@@ -22,11 +21,7 @@ import Control.Monad.Random ( MonadRandom, getRandom )

22-- import Data.List ( foldl1' )

21-- import Data.List ( foldl1' )

23import Data.Proxy

22import Data.Proxy

24import Data.Serialize

23import Data.Serialize

25−import Data.Singletons.TypeLits

26−

27−#if MIN_VERSION_base(4,9,0)

28import Data.Kind (Type)

24import Data.Kind (Type)

29−#endif

30

25

31import qualified Numeric.LinearAlgebra as LA

26import qualified Numeric.LinearAlgebra as LA

32import Numeric.LinearAlgebra.Static

27import Numeric.LinearAlgebra.Static

@@ -34,6 +29,7 @@ import Numeric.LinearAlgebra.Static

34import Grenade.Core

29import Grenade.Core

35import Grenade.Recurrent.Core

30import Grenade.Recurrent.Core

36import Grenade.Layers.Internal.Update

31import Grenade.Layers.Internal.Update

32+import GHC.TypeLits

37

33

38

34

39-- | Long Short Term Memory Recurrent unit

35-- | Long Short Term Memory Recurrent unit

@@ -75,7 +71,7 @@ instance (KnownNat i, KnownNat o) => UpdateLayer (LSTM i o) where

75

71

76 -- Run the update function for each group matrix/vector of weights, momentums and gradients.

72 -- Run the update function for each group matrix/vector of weights, momentums and gradients.

77 -- Hmm, maybe the function should be used instead of passing in the learning parameters.

73 -- Hmm, maybe the function should be used instead of passing in the learning parameters.

78− runUpdate LearningParameters {..} (LSTM w m) g =

74+ runUpdate lp (LSTM w m) g =

79 let (wf, wf') = u lstmWf w m g

75 let (wf, wf') = u lstmWf w m g

80 (uf, uf') = u lstmUf w m g

76 (uf, uf') = u lstmUf w m g

81 (bf, bf') = v lstmBf w m g

77 (bf, bf') = v lstmBf w m g

@@ -92,11 +88,11 @@ instance (KnownNat i, KnownNat o) => UpdateLayer (LSTM i o) where

92 -- Utility function for updating with the momentum, gradients, and weights.

88 -- Utility function for updating with the momentum, gradients, and weights.

93 u :: forall x ix out. (KnownNat ix, KnownNat out) => (x -> (L out ix)) -> x -> x -> x -> ((L out ix), (L out ix))

89 u :: forall x ix out. (KnownNat ix, KnownNat out) => (x -> (L out ix)) -> x -> x -> x -> ((L out ix), (L out ix))

94 u e (e -> weights) (e -> momentum) (e -> gradient) =

90 u e (e -> weights) (e -> momentum) (e -> gradient) =

95− descendMatrix learningRate learningMomentum learningRegulariser weights gradient momentum

91+ descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) weights gradient momentum

96

92

97 v :: forall x ix. (KnownNat ix) => (x -> (R ix)) -> x -> x -> x -> ((R ix), (R ix))

93 v :: forall x ix. (KnownNat ix) => (x -> (R ix)) -> x -> x -> x -> ((R ix), (R ix))

98 v e (e -> weights) (e -> momentum) (e -> gradient) =

94 v e (e -> weights) (e -> momentum) (e -> gradient) =

99− descendVector learningRate learningMomentum learningRegulariser weights gradient momentum

95+ descendVector (learningRate lp) (learningMomentum lp) (learningRegulariser lp) weights gradient momentum

100

96

101 -- There's a lot of updates here, so to try and minimise the number of data copies

97 -- There's a lot of updates here, so to try and minimise the number of data copies

102 -- we'll create a mutable bucket for each.

98 -- we'll create a mutable bucket for each.

@@ -137,18 +133,18 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w

137 type RecTape (LSTM i o) ('D1 i) ('D1 o) = (R o, R i, R o, R o, R o, R o, R o, R o, R o, R o, R o)

133 type RecTape (LSTM i o) ('D1 i) ('D1 o) = (R o, R i, R o, R o, R o, R o, R o, R o, R o, R o, R o)

138 -- Forward propagation for the LSTM layer.

134 -- Forward propagation for the LSTM layer.

139 -- The size of the cell state is also the size of the output.

135 -- The size of the cell state is also the size of the output.

140− runRecurrentForwards (LSTM (LSTMWeights {..}) _) (S1D cell) (S1D input) =

136+ runRecurrentForwards (LSTM lw _) (S1D cell) (S1D input) =

141 let -- Forget state vector

137 let -- Forget state vector

142− f_s = lstmBf + lstmWf #> input + lstmUf #> cell

138+ f_s = lstmBf lw + lstmWf lw #> input + lstmUf lw #> cell

143 f_t = sigmoid f_s

139 f_t = sigmoid f_s

144 -- Input state vector

140 -- Input state vector

145− i_s = lstmBi + lstmWi #> input + lstmUi #> cell

141+ i_s = lstmBi lw + lstmWi lw #> input + lstmUi lw #> cell

146 i_t = sigmoid i_s

142 i_t = sigmoid i_s

147 -- Output state vector

143 -- Output state vector

148− o_s = lstmBo + lstmWo #> input + lstmUo #> cell

144+ o_s = lstmBo lw + lstmWo lw #> input + lstmUo lw #> cell

149 o_t = sigmoid o_s

145 o_t = sigmoid o_s

150 -- Cell input state vector

146 -- Cell input state vector

151− c_s = lstmBc + lstmWc #> input

147+ c_s = lstmBc lw + lstmWc lw #> input

152 c_x = tanh c_s

148 c_x = tanh c_s

153 -- Cell state

149 -- Cell state

154 c_t = f_t * cell + i_t * c_x

150 c_t = f_t * cell + i_t * c_x

@@ -162,7 +158,7 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w

162 --

158 --

163 -- There's a test version using the AD library without hmatrix in the test

159 -- There's a test version using the AD library without hmatrix in the test

164 -- suite. These should match always.

160 -- suite. These should match always.

165− runRecurrentBackwards (LSTM (LSTMWeights {..}) _) (cell, input, f_s, f_t, i_s, i_t, o_s, o_t, c_s, c_x, c_t) (S1D cellGrad) (S1D h_t') =

161+ runRecurrentBackwards (LSTM lw _) (cell, input, f_s, f_t, i_s, i_t, o_s, o_t, c_s, c_x, c_t) (S1D cellGrad) (S1D h_t') =

166 let -- Reverse Mode AD Derivitives

162 let -- Reverse Mode AD Derivitives

167 c_t' = h_t' * o_t + cellGrad

163 c_t' = h_t' * o_t + cellGrad

168

164

@@ -179,8 +175,8 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w

179 c_s' = tanh' c_s * c_x'

175 c_s' = tanh' c_s * c_x'

180

176

181 -- The derivatives to pass sideways (recurrent) and downwards

177 -- The derivatives to pass sideways (recurrent) and downwards

182− cell' = tr lstmUf #> f_s' + tr lstmUo #> o_s' + tr lstmUi #> i_s' + c_t' * f_t

178+ cell' = tr (lstmUf lw) #> f_s' + tr (lstmUo lw) #> o_s' + tr (lstmUi lw) #> i_s' + c_t' * f_t

183− input' = tr lstmWf #> f_s' + tr lstmWo #> o_s' + tr lstmWi #> i_s' + tr lstmWc #> c_s'

179+ input' = tr (lstmWf lw) #> f_s' + tr (lstmWo lw) #> o_s' + tr (lstmWi lw) #> i_s' + tr (lstmWc lw) #> c_s'

184

180

185 -- Calculate the gradient Matricies for the input

181 -- Calculate the gradient Matricies for the input

186 lstmWf' = f_s' `outer` input

182 lstmWf' = f_s' `outer` input

@@ -239,44 +235,34 @@ tanh' :: (Floating a) => a -> a

239tanh' t = 1 - s ^ (2 :: Int) where s = tanh t

235tanh' t = 1 - s ^ (2 :: Int) where s = tanh t

240

236

241instance (KnownNat i, KnownNat o) => Serialize (LSTM i o) where

237instance (KnownNat i, KnownNat o) => Serialize (LSTM i o) where

242− put (LSTM LSTMWeights {..} _) = do

238+ put (LSTM lw _) = do

243− u lstmWf

239+ u (lstmWf lw)

244− u lstmUf

240+ u (lstmUf lw)

245− v lstmBf

241+ v (lstmBf lw)

246− u lstmWi

242+ u (lstmWi lw)

247− u lstmUi

243+ u (lstmUi lw)

248− v lstmBi

244+ v (lstmBi lw)

249− u lstmWo

245+ u (lstmWo lw)

250− u lstmUo

246+ u (lstmUo lw)

251− v lstmBo

247+ v (lstmBo lw)

252− u lstmWc

248+ u (lstmWc lw)

253− v lstmBc

249+ v (lstmBc lw)

254− where

250+ where

255− u :: forall a b. (KnownNat a, KnownNat b) => Putter (L b a)

251+ u :: forall a b. (KnownNat a, KnownNat b) => Putter (L b a)

256− u = putListOf put . LA.toList . LA.flatten . extract

252+ u = putListOf put . LA.toList . LA.flatten . extract

257− v :: forall a. (KnownNat a) => Putter (R a)

253+ v :: forall a. (KnownNat a) => Putter (R a)

258− v = putListOf put . LA.toList . extract

254+ v = putListOf put . LA.toList . extract

259

255

260 get = do

256 get = do

261− lstmWf <- u

257+ w <- LSTMWeights <$> u <*> u <*> v <*> u <*> u <*> v <*> u <*> u <*> v <*> u <*> v

262− lstmUf <- u

263− lstmBf <- v

264− lstmWi <- u

265− lstmUi <- u

266− lstmBi <- v

267− lstmWo <- u

268− lstmUo <- u

269− lstmBo <- v

270− lstmWc <- u

271− lstmBc <- v

272− return $ LSTM (LSTMWeights {..}) (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)

258+ return $ LSTM w (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)

273− where

259+ where

274− u :: forall a b. (KnownNat a, KnownNat b) => Get (L b a)

260+ u :: forall a b. (KnownNat a, KnownNat b) => Get (L b a)

275− u = let f = fromIntegral $ natVal (Proxy :: Proxy a)

261+ u = let f = fromIntegral $ natVal (Proxy :: Proxy a)

276− in maybe (fail "Vector of incorrect size") return . create . LA.reshape f . LA.fromList =<< getListOf get

262+ in maybe (fail "Vector of incorrect size") return . create . LA.reshape f . LA.fromList =<< getListOf get

277− v :: forall a. (KnownNat a) => Get (R a)

263+ v :: forall a. (KnownNat a) => Get (R a)

278− v = maybe (fail "Vector of incorrect size") return . create . LA.fromList =<< getListOf get

264+ v = maybe (fail "Vector of incorrect size") return . create . LA.fromList =<< getListOf get

279−

265+

280− w0 = konst 0

266+ w0 = konst 0

281− u0 = konst 0

267+ u0 = konst 0

282− v0 = konst 0

268+ v0 = konst 0

src/Grenade/Utils/OneHot.hs+1−1

@@ -22,7 +22,6 @@ import Data.Map ( Map )

22import qualified Data.Map as M

23

24import Data.Proxy

25−import Data.Singletons.TypeLits

26

25

27import Data.Vector ( Vector )

26import Data.Vector ( Vector )

28import qualified Data.Vector as V

27import qualified Data.Vector as V

@@ -31,6 +30,7 @@ import qualified Data.Vector.Storable as VS

31import Numeric.LinearAlgebra ( maxIndex )

30import Numeric.LinearAlgebra ( maxIndex )

32import Numeric.LinearAlgebra.Devel

31import Numeric.LinearAlgebra.Devel

33import Numeric.LinearAlgebra.Static

32import Numeric.LinearAlgebra.Static

33+import GHC.TypeLits

34

35import Grenade.Core.Shape

36

stack.yamlnew file+78

@@ -0,0 +1,78 @@

1+# This file was automatically generated by 'stack init'

2+#

3+# Some commonly used options have been documented as comments in this file.

4+# For advanced use and comprehensive documentation of the format, please see:

5+# https://docs.haskellstack.org/en/stable/yaml_configuration/

6+

7+# A warning or info to be displayed to the user on config load.

8+# user-message: |

9+

10+# Resolver to choose a 'specific' stackage snapshot or a compiler version.

11+# A snapshot resolver dictates the compiler version and the set of packages

12+# to be used for project dependencies. For example:

13+#

14+# resolver: lts-3.5

15+# resolver: nightly-2015-09-21

16+# resolver: ghc-7.10.2

17+#

18+# The location of a snapshot can be provided as a file or url. Stack assumes

19+# a snapshot provided as a file might change, whereas a url resource does not.

20+#

21+# resolver: ./custom-snapshot.yaml

22+# resolver: https://example.com/snapshots/2018-01-01.yaml

23+resolver: lts-20.18

24+

25+# User packages to be built.

26+# Various formats can be used as shown in the example below.

27+#

28+# packages:

29+# - some-directory

30+# - https://example.com/foo/bar/baz-0.0.2.tar.gz

31+# subdirs:

32+# - auto-update

33+# - wai

34+packages:

35+ - .

36+ - examples

37+

38+# Dependency packages to be pulled from upstream that are not in the resolver.

39+# These entries can reference officially published versions as well as

40+# forks / in-progress versions pinned to a git hash. For example:

41+#

42+# extra-deps:

43+# - acme-missiles-0.3

44+# - git: https://github.com/commercialhaskell/stack.git

45+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

46+#

47+extra-deps:

48+ - typelits-witnesses-0.3.0.3

49+

50+# Override default flag values for local packages and extra-deps

51+# flags: {}

52+

53+# Extra package databases containing global packages

54+# extra-package-dbs: []

55+

56+# Control whether we use the GHC we find on the path

57+# system-ghc: true

58+#

59+# Require a specific version of stack, using version ranges

60+# require-stack-version: -any # Default

61+# require-stack-version: ">=2.1"

62+#

63+# Override the architecture used by stack, especially useful on Windows

64+# arch: i386

65+# arch: x86_64

66+#

67+# Extra directories used by stack for building

68+# extra-include-dirs: [/path/to/dir]

69+# extra-lib-dirs: [/path/to/dir]

70+#

71+# Allow a newer minor version of GHC than the snapshot specifies

72+# compiler-check: newer-minor

73+

74+nix:

75+ enable: true

76+ packages:

77+ - blas

78+ - lapack

stack.yaml.locknew file+19

@@ -0,0 +1,19 @@

1+# This file was autogenerated by Stack.

2+# You should not edit this file by hand.

3+# For more information, please see the documentation at:

4+# https://docs.haskellstack.org/en/stable/lock_files

5+

6+packages:

7+- completed:

8+ hackage: typelits-witnesses-0.3.0.3@sha256:2d9df4ac6ff3077bfd2bf659e4b495e157723ac5b45c519762853f55df5c16db,2738

9+ pantry-tree:

10+ sha256: 6a42a462f98e94933b6e9721acd912c6c6b6a4743635efd15cc5871908c816a0

11+ size: 469

12+ original:

13+ hackage: typelits-witnesses-0.3.0.3

14+snapshots:

15+- completed:

16+ sha256: 9fa4bece7acfac1fc7930c5d6e24606004b09e80aa0e52e9f68b148201008db9

17+ size: 649606

18+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/18.yaml

19+ original: lts-20.18

test/Test/Grenade/Recurrent/Layers/LSTM/Reference.hs+25−21

@@ -6,7 +6,6 @@

6{-# LANGUAGE DeriveFunctor #-}

7{-# LANGUAGE DeriveFoldable #-}

8{-# LANGUAGE DeriveTraversable #-}

9−{-# LANGUAGE RecordWildCards #-}

10{-# LANGUAGE FlexibleContexts #-}

9{-# LANGUAGE FlexibleContexts #-}

11{-# LANGUAGE RankNTypes #-}

10{-# LANGUAGE RankNTypes #-}

12

11

@@ -15,9 +14,13 @@ module Test.Grenade.Recurrent.Layers.LSTM.Reference where

15

14

16import Data.Reflection

15import Data.Reflection

17import Numeric.AD.Mode.Reverse

16import Numeric.AD.Mode.Reverse

18−import Numeric.AD.Internal.Reverse ( Tape )

17+import Numeric.AD.Internal.Reverse (Tape)

19

18

19+import GHC.TypeLits (KnownNat)

20+

21+import Grenade.Recurrent.Layers.LSTM (LSTMWeights (..))

20import qualified Grenade.Recurrent.Layers.LSTM as LSTM

22import qualified Grenade.Recurrent.Layers.LSTM as LSTM

23+

21import qualified Numeric.LinearAlgebra.Static as S

24import qualified Numeric.LinearAlgebra.Static as S

22import qualified Numeric.LinearAlgebra as H

25import qualified Numeric.LinearAlgebra as H

23

26

@@ -54,31 +57,32 @@ data RefLSTM a = RefLSTM

54 , refLstmBc :: Vector a -- Bias Cell (b_c)

57 , refLstmBc :: Vector a -- Bias Cell (b_c)

55 } deriving (Functor, Foldable, Traversable, Eq, Show)

58 } deriving (Functor, Foldable, Traversable, Eq, Show)

56

59

57−lstmToReference :: LSTM.LSTMWeights a b -> RefLSTM Double

60+lstmToReference :: (KnownNat a, KnownNat b) => LSTM.LSTMWeights a b -> RefLSTM Double

58−lstmToReference LSTM.LSTMWeights {..} =

61+lstmToReference lw =

62+ RefLSTM

59− let refLstmWf = Matrix . H.toLists . S.extract $ lstmWf -- Weight Forget (W_f)

63+ { refLstmWf = Matrix . H.toLists . S.extract $ lstmWf lw -- Weight Forget (W_f)

60− refLstmUf = Matrix . H.toLists . S.extract $ lstmUf -- Cell State Forget (U_f)

64+ , refLstmUf = Matrix . H.toLists . S.extract $ lstmUf lw -- Cell State Forget (U_f)

61− refLstmBf = Vector . H.toList . S.extract $ lstmBf -- Bias Forget (b_f)

65+ , refLstmBf = Vector . H.toList . S.extract $ lstmBf lw -- Bias Forget (b_f)

62− refLstmWi = Matrix . H.toLists . S.extract $ lstmWi -- Weight Input (W_i)

66+ , refLstmWi = Matrix . H.toLists . S.extract $ lstmWi lw -- Weight Input (W_i)

63− refLstmUi = Matrix . H.toLists . S.extract $ lstmUi -- Cell State Input (U_i)

67+ , refLstmUi = Matrix . H.toLists . S.extract $ lstmUi lw -- Cell State Input (U_i)

64− refLstmBi = Vector . H.toList . S.extract $ lstmBi -- Bias Input (b_i)

68+ , refLstmBi = Vector . H.toList . S.extract $ lstmBi lw -- Bias Input (b_i)

65− refLstmWo = Matrix . H.toLists . S.extract $ lstmWo -- Weight Output (W_o)

69+ , refLstmWo = Matrix . H.toLists . S.extract $ lstmWo lw -- Weight Output (W_o)

66− refLstmUo = Matrix . H.toLists . S.extract $ lstmUo -- Cell State Output (U_o)

70+ , refLstmUo = Matrix . H.toLists . S.extract $ lstmUo lw -- Cell State Output (U_o)

67− refLstmBo = Vector . H.toList . S.extract $ lstmBo -- Bias Output (b_o)

71+ , refLstmBo = Vector . H.toList . S.extract $ lstmBo lw -- Bias Output (b_o)

68− refLstmWc = Matrix . H.toLists . S.extract $ lstmWc -- Weight Cell (W_c)

72+ , refLstmWc = Matrix . H.toLists . S.extract $ lstmWc lw -- Weight Cell (W_c)

69− refLstmBc = Vector . H.toList . S.extract $ lstmBc -- Bias Cell (b_c)

73+ , refLstmBc = Vector . H.toList . S.extract $ lstmBc lw -- Bias Cell (b_c)

70− in RefLSTM {..}

74+ }

71

75

72runLSTM :: Floating a => RefLSTM a -> Vector a -> Vector a -> (Vector a, Vector a)

76runLSTM :: Floating a => RefLSTM a -> Vector a -> Vector a -> (Vector a, Vector a)

73−runLSTM RefLSTM {..} cell input =

77+runLSTM rl cell input =

74 let -- Forget state vector

78 let -- Forget state vector

75− f_t = sigmoid $ refLstmBf #+ refLstmWf #> input #+ refLstmUf #> cell

79+ f_t = sigmoid $ refLstmBf rl #+ refLstmWf rl #> input #+ refLstmUf rl #> cell

76 -- Input state vector

80 -- Input state vector

77− i_t = sigmoid $ refLstmBi #+ refLstmWi #> input #+ refLstmUi #> cell

81+ i_t = sigmoid $ refLstmBi rl #+ refLstmWi rl #> input #+ refLstmUi rl #> cell

78 -- Output state vector

82 -- Output state vector

79− o_t = sigmoid $ refLstmBo #+ refLstmWo #> input #+ refLstmUo #> cell

83+ o_t = sigmoid $ refLstmBo rl #+ refLstmWo rl #> input #+ refLstmUo rl #> cell

80 -- Cell input state vector

84 -- Cell input state vector

81− c_x = fmap tanh $ refLstmBc #+ refLstmWc #> input

85+ c_x = fmap tanh $ refLstmBc rl #+ refLstmWc rl #> input

82 -- Cell state

86 -- Cell state

83 c_t = f_t #* cell #+ i_t #* c_x

87 c_t = f_t #* cell #+ i_t #* c_x

84 -- Output (it's sometimes recommended to use tanh c_t)

88 -- Output (it's sometimes recommended to use tanh c_t)