git.iko.soy/grenade
on a161f2d help sign in
afb9f9b
swap
0 ahead, 5 behind
.travis.yml+6−7
since splitsnapshots
unifiedsplit
@@ -6,26 +6,25 @@ env:
6 - GHCVER=8.2.2
6 - GHCVER=8.2.2
7 - GHCVER=8.4.4
7 - GHCVER=8.4.4
8 - GHCVER=8.6.5
8 - GHCVER=8.6.5
9− - GHCVER=8.8.3
9+ - GHCVER=8.8.2
10− - GHCVER=8.10.1
11
10
12# Note: the distinction between `before_install` and `install` is not important.
11# Note: the distinction between `before_install` and `install` is not important.
13before_install:
12before_install:
14 - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
13 - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
15 - travis_retry sudo apt-get update
14 - travis_retry sudo apt-get update
16− - travis_retry sudo apt-get install cabal-install-3.2 ghc-$GHCVER libblas-dev liblapack-dev
15+ - travis_retry sudo apt-get install cabal-install-3.0 ghc-$GHCVER libblas-dev liblapack-dev
17 - export PATH=/opt/cabal/bin:/opt/ghc/$GHCVER/bin:$PATH
16 - export PATH=/opt/cabal/bin:/opt/ghc/$GHCVER/bin:$PATH
18
17
19install:
18install:
20 - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
19 - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
21− - travis_retry cabal-3.2 update
20+ - travis_retry cabal-3.0 update
22
21
23notifications:
22notifications:
24 email: false
23 email: false
25
24
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.
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.
27script:
26script:
28− - cabal-3.2 configure --enable-tests
27+ - cabal-3.0 configure --enable-tests
29− - cabal-3.2 build all
28+ - cabal-3.0 build all
30− - cabal-3.2 test --test-show-details=direct -j1
29+ - cabal-3.0 test --test-show-details=direct -j1
31
30
examples/grenade-examples.cabal+5−6
@@ -26,7 +26,7 @@ executable feedforward
26 , bytestring
26 , bytestring
27 , cereal
27 , cereal
28 , either
28 , either
29− , optparse-applicative >= 0.13 && < 0.18
29+ , optparse-applicative >= 0.13 && < 0.16
30 , text == 1.2.*
30 , text == 1.2.*
31 , mtl >= 2.2.1 && < 2.3
31 , mtl >= 2.2.1 && < 2.3
32 , hmatrix
32 , hmatrix
@@ -42,7 +42,7 @@ executable mnist
42 , grenade
42 , grenade
43 , attoparsec
43 , attoparsec
44 , either
44 , either
45− , optparse-applicative >= 0.13 && < 0.18
45+ , optparse-applicative >= 0.13 && < 0.16
46 , text == 1.2.*
46 , text == 1.2.*
47 , mtl >= 2.2.1 && < 2.3
47 , mtl >= 2.2.1 && < 2.3
48 , hmatrix >= 0.18 && < 0.21
48 , hmatrix >= 0.18 && < 0.21
@@ -61,7 +61,7 @@ executable gan-mnist
61 , bytestring
61 , bytestring
62 , cereal
62 , cereal
63 , either
63 , either
64− , optparse-applicative >= 0.13 && < 0.18
64+ , optparse-applicative >= 0.13 && < 0.16
65 , text == 1.2.*
65 , text == 1.2.*
66 , mtl >= 2.2.1 && < 2.3
66 , mtl >= 2.2.1 && < 2.3
67 , hmatrix >= 0.18 && < 0.21
67 , hmatrix >= 0.18 && < 0.21
@@ -78,7 +78,7 @@ executable recurrent
78 , grenade
78 , grenade
79 , attoparsec
79 , attoparsec
80 , either
80 , either
81− , optparse-applicative >= 0.13 && < 0.18
81+ , optparse-applicative >= 0.13 && < 0.16
82 , text == 1.2.*
82 , text == 1.2.*
83 , mtl >= 2.2.1 && < 2.3
83 , mtl >= 2.2.1 && < 2.3
84 , hmatrix >= 0.18 && < 0.21
84 , hmatrix >= 0.18 && < 0.21
@@ -96,14 +96,13 @@ executable shakespeare
96 , bytestring
96 , bytestring
97 , cereal
97 , cereal
98 , either
98 , either
99− , optparse-applicative >= 0.13 && < 0.18
99+ , optparse-applicative >= 0.13 && < 0.16
100 , text == 1.2.*
100 , text == 1.2.*
101 , mtl >= 2.2.1 && < 2.3
101 , mtl >= 2.2.1 && < 2.3
102 , hmatrix >= 0.18 && < 0.21
102 , hmatrix >= 0.18 && < 0.21
103 , transformers
103 , transformers
104 , semigroups
104 , semigroups
105 , singletons
105 , singletons
106− , singletons-base
107 , vector
106 , vector
108 , MonadRandom
107 , MonadRandom
109 , containers
108 , containers
examples/main/shakespeare.hs+20−14
@@ -1,5 +1,6 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
3+{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
@@ -14,15 +15,22 @@ import Data.Char ( isUpper, toUpper, toLower )
14import Data.List ( foldl' )
15import Data.List ( foldl' )
15import Data.Maybe ( fromMaybe )
16import Data.Maybe ( fromMaybe )
16
17
18+#if ! MIN_VERSION_base(4,13,0)
19+import Data.Semigroup ( (<>) )
20+#endif
17
21
18import qualified Data.Vector as V
22import qualified Data.Vector as V
19import Data.Vector ( Vector )
23import Data.Vector ( Vector )
20
24
21import qualified Data.Map as M
25import qualified Data.Map as M
26+#if ! MIN_VERSION_base(4,13,0)
27+import Data.Proxy ( Proxy (..) )
28+#endif
22
29
23import qualified Data.ByteString as B
30import qualified Data.ByteString as B
24import Data.Serialize
31import Data.Serialize
25
32
33+import Data.Singletons.Prelude
26import GHC.TypeLits
34import GHC.TypeLits
27
35
28import Numeric.LinearAlgebra.Static ( konst )
36import Numeric.LinearAlgebra.Static ( konst )
@@ -34,8 +42,6 @@ import Grenade.Recurrent
34import Grenade.Utils.OneHot
42import Grenade.Utils.OneHot
35
43
36import System.IO.Unsafe ( unsafeInterleaveIO )
44import System.IO.Unsafe ( unsafeInterleaveIO )
37−import Data.Proxy
38−import Prelude.Singletons
39
45
40-- The defininition for our natural language recurrent network.
46-- The defininition for our natural language recurrent network.
41-- This network is able to learn and generate simple words in
47-- This network is able to learn and generate simple words in
@@ -77,34 +83,34 @@ loadShakespeare path = do
77 return (V.fromList hot, m, cs)
83 return (V.fromList hot, m, cs)
78
84
79trainSlice :: LearningParameters -> Shakespeare -> Shakespearian -> Vector Int -> Int -> Int -> (Shakespeare, Shakespearian)
85trainSlice :: LearningParameters -> Shakespeare -> Shakespearian -> Vector Int -> Int -> Int -> (Shakespeare, Shakespearian)
80−trainSlice !lrate !net !recIns input offset size =
86+trainSlice !rate !net !recIns input offset size =
81 let e = fmap (x . oneHot) . V.toList $ V.slice offset size input
87 let e = fmap (x . oneHot) . V.toList $ V.slice offset size input
82 in case reverse e of
88 in case reverse e of
83 (o : l : xs) ->
89 (o : l : xs) ->
84 let examples = reverse $ (l, Just o) : ((,Nothing) <$> xs)
90 let examples = reverse $ (l, Just o) : ((,Nothing) <$> xs)
85− in trainRecurrent lrate net recIns examples
91+ in trainRecurrent rate net recIns examples
86 _ -> error "Not enough input"
92 _ -> error "Not enough input"
87 where
93 where
88 x = fromMaybe (error "Hot variable didn't fit.")
94 x = fromMaybe (error "Hot variable didn't fit.")
89
95
90runShakespeare :: ShakespeareOpts -> ExceptT String IO ()
96runShakespeare :: ShakespeareOpts -> ExceptT String IO ()
91−runShakespeare opts = do
97+runShakespeare ShakespeareOpts {..} = do
92− (shakespeare, oneHotMap, oneHotDictionary) <- loadShakespeare $ trainingFile opts
98+ (shakespeare, oneHotMap, oneHotDictionary) <- loadShakespeare trainingFile
93 (net0, i0) <- lift $
99 (net0, i0) <- lift $
94− case loadPath opts of
100+ case loadPath of
95 Just loadFile -> netLoad loadFile
101 Just loadFile -> netLoad loadFile
96 Nothing -> (,0) <$> randomNet
102 Nothing -> (,0) <$> randomNet
97
103
98 (trained, bestInput) <- lift $ foldM (\(!net, !io) size -> do
104 (trained, bestInput) <- lift $ foldM (\(!net, !io) size -> do
99− xs <- take (iterations opts `div` 10) <$> getRandomRs (0, length shakespeare - size - 1)
105+ xs <- take (iterations `div` 10) <$> getRandomRs (0, length shakespeare - size - 1)
100− let (!trained, !bestInput) = foldl' (\(!n, !i) offset -> trainSlice (rate opts) n i shakespeare offset size) (net, io) xs
106+ let (!trained, !bestInput) = foldl' (\(!n, !i) offset -> trainSlice rate n i shakespeare offset size) (net, io) xs
101− results <- take 1000 <$> generateParagraph trained bestInput (temperature opts) oneHotMap oneHotDictionary ( S1D $ konst 0)
107+ results <- take 1000 <$> generateParagraph trained bestInput temperature oneHotMap oneHotDictionary ( S1D $ konst 0)
102 putStrLn ("TRAINING STEP WITH SIZE: " ++ show size)
108 putStrLn ("TRAINING STEP WITH SIZE: " ++ show size)
103 putStrLn (unAnnotateCapitals results)
109 putStrLn (unAnnotateCapitals results)
104 return (trained, bestInput)
110 return (trained, bestInput)
105− ) (net0, i0) $ replicate 10 (sequenceSize opts)
111+ ) (net0, i0) $ replicate 10 sequenceSize
106
112
107− case savePath opts of
113+ case savePath of
108 Just saveFile -> lift . B.writeFile saveFile $ runPut (put trained >> put bestInput)
114 Just saveFile -> lift . B.writeFile saveFile $ runPut (put trained >> put bestInput)
109 Nothing -> return ()
115 Nothing -> return ()
110
116
@@ -116,12 +122,12 @@ generateParagraph :: forall layers shapes n a. (Last shapes ~ 'D1 n, Head shapes
116 -> Vector a
122 -> Vector a
117 -> S ('D1 n)
123 -> S ('D1 n)
118 -> IO [a]
124 -> IO [a]
119−generateParagraph n s temp hotmap hotdict =
125+generateParagraph n s temperature hotmap hotdict =
120 go s
126 go s
121 where
127 where
122 go x y =
128 go x y =
123 do let (_, ns, o) = runRecurrent n x y
129 do let (_, ns, o) = runRecurrent n x y
124− un <- sample temp hotdict o
130+ un <- sample temperature hotdict o
125 Just re <- return $ makeHot hotmap un
131 Just re <- return $ makeHot hotmap un
126 rest <- unsafeInterleaveIO $ go ns re
132 rest <- unsafeInterleaveIO $ go ns re
127 return (un : rest)
133 return (un : rest)
grenade.cabal+1−2
@@ -38,7 +38,7 @@ source-repository head
38library
38library
39 build-depends:
39 build-depends:
40 base >= 4.8 && < 5
40 base >= 4.8 && < 5
41− , bytestring >= 0.10.0
41+ , bytestring == 0.10.*
42 , containers >= 0.5 && < 0.7
42 , containers >= 0.5 && < 0.7
43 , cereal >= 0.5 && < 0.6
43 , cereal >= 0.5 && < 0.6
44 , deepseq >= 1.4 && < 1.5
44 , deepseq >= 1.4 && < 1.5
@@ -48,7 +48,6 @@ library
48 -- Versions of singletons are *tightly* coupled with the
48 -- Versions of singletons are *tightly* coupled with the
49 -- GHC version so its fine to drop version bounds.
49 -- GHC version so its fine to drop version bounds.
50 , singletons
50 , singletons
51− , singletons-base
52 , vector >= 0.11 && < 0.13
51 , vector >= 0.11 && < 0.13
53
52
54 ghc-options:
53 ghc-options:
src/Grenade/Core/Network.hs+1−1
@@ -34,6 +34,7 @@ module Grenade.Core.Network (
34import Control.Monad.Random ( MonadRandom )
34import Control.Monad.Random ( MonadRandom )
35
35
36import Data.Singletons
36import Data.Singletons
37+import Data.Singletons.Prelude
37import Data.Serialize
38import Data.Serialize
38
39
39#if MIN_VERSION_base(4,9,0)
40#if MIN_VERSION_base(4,9,0)
@@ -43,7 +44,6 @@ import Data.Kind (Type)
43import Grenade.Core.Layer
44import Grenade.Core.Layer
44import Grenade.Core.LearningParameters
45import Grenade.Core.LearningParameters
45import Grenade.Core.Shape
46import Grenade.Core.Shape
46−import Prelude.Singletons
47
47
48-- | Type of a network.
48-- | Type of a network.
49--
49--
src/Grenade/Core/Runner.hs+1−2
@@ -13,12 +13,11 @@ module Grenade.Core.Runner (
13 , runNet
13 , runNet
14 ) where
14 ) where
15
15
16+import Data.Singletons.Prelude
16
17
17import Grenade.Core.LearningParameters
18import Grenade.Core.LearningParameters
18import Grenade.Core.Network
19import Grenade.Core.Network
19import Grenade.Core.Shape
20import Grenade.Core.Shape
20−import Data.Singletons
21−import Prelude.Singletons
22
21
23-- | Perform reverse automatic differentiation on the network
22-- | Perform reverse automatic differentiation on the network
24-- for the current input and expected output.
23-- for the current input and expected output.
src/Grenade/Core/Shape.hs+31−16
@@ -21,20 +21,35 @@ Stability : experimental
21module Grenade.Core.Shape (
21module Grenade.Core.Shape (
22 S (..)
22 S (..)
23 , Shape (..)
23 , Shape (..)
24+#if MIN_VERSION_singletons(2,6,0)
24 , SShape (..)
25 , SShape (..)
26+#else
27+ , Sing (..)
28+#endif
29+
25 , randomOfShape
30 , randomOfShape
26 , fromStorable
31 , fromStorable
27 ) where
32 ) where
28
33
29import Control.DeepSeq (NFData (..))
34import Control.DeepSeq (NFData (..))
30import Control.Monad.Random ( MonadRandom, getRandom )
35import Control.Monad.Random ( MonadRandom, getRandom )
36+
37+#if MIN_VERSION_base(4,13,0)
31import Data.Kind (Type)
38import Data.Kind (Type)
39+#endif
32import Data.Proxy
40import Data.Proxy
33import Data.Serialize
41import Data.Serialize
34import Data.Singletons
42import Data.Singletons
43+import Data.Singletons.TypeLits
35import Data.Vector.Storable ( Vector )
44import Data.Vector.Storable ( Vector )
36import qualified Data.Vector.Storable as V
45import qualified Data.Vector.Storable as V
46+
47+#if MIN_VERSION_base(4,11,0)
48+import GHC.TypeLits hiding (natVal)
49+#else
37import GHC.TypeLits
50import GHC.TypeLits
51+#endif
52+
38import qualified Numeric.LinearAlgebra.Static as H
53import qualified Numeric.LinearAlgebra.Static as H
39import Numeric.LinearAlgebra.Static
54import Numeric.LinearAlgebra.Static
40import qualified Numeric.LinearAlgebra as NLA
55import qualified Numeric.LinearAlgebra as NLA
@@ -84,9 +99,9 @@ deriving instance Show (S n)
84type instance Sing = SShape
99type instance Sing = SShape
85
100
86data SShape :: Shape -> Type where
101data SShape :: Shape -> Type where
87− D1Sing :: KnownNat a => SShape ('D1 a)
102+ D1Sing :: Sing a -> SShape ('D1 a)
88− D2Sing :: (KnownNat a, KnownNat b) => SShape ('D2 a b)
103+ D2Sing :: Sing a -> Sing b -> SShape ('D2 a b)
89− D3Sing :: (KnownNat (a * c), KnownNat a, KnownNat b, KnownNat c) => SShape ('D3 a b c)
104+ D3Sing :: KnownNat (a * c) => Sing a -> Sing b -> Sing c -> SShape ('D3 a b c)
90#else
105#else
91data instance Sing (n :: Shape) where
106data instance Sing (n :: Shape) where
92 D1Sing :: Sing a -> Sing ('D1 a)
107 D1Sing :: Sing a -> Sing ('D1 a)
@@ -95,11 +110,11 @@ data instance Sing (n :: Shape) where
95#endif
110#endif
96
111
97instance KnownNat a => SingI ('D1 a) where
112instance KnownNat a => SingI ('D1 a) where
98− sing = D1Sing
113+ sing = D1Sing sing
99instance (KnownNat a, KnownNat b) => SingI ('D2 a b) where
114instance (KnownNat a, KnownNat b) => SingI ('D2 a b) where
100− sing = D2Sing
115+ sing = D2Sing sing sing
101instance (KnownNat a, KnownNat b, KnownNat c, KnownNat (a * c)) => SingI ('D3 a b c) where
116instance (KnownNat a, KnownNat b, KnownNat c, KnownNat (a * c)) => SingI ('D3 a b c) where
102− sing = D3Sing
117+ sing = D3Sing sing sing sing
103
118
104instance SingI x => Num (S x) where
119instance SingI x => Num (S x) where
105 (+) = n2 (+)
120 (+) = n2 (+)
@@ -148,13 +163,13 @@ randomOfShape :: forall x m. ( MonadRandom m, SingI x ) => m (S x)
148randomOfShape = do
163randomOfShape = do
149 seed :: Int <- getRandom
164 seed :: Int <- getRandom
150 return $ case (sing :: Sing x) of
165 return $ case (sing :: Sing x) of
151− D1Sing ->
166+ D1Sing SNat ->
152 S1D (randomVector seed Uniform * 2 - 1)
167 S1D (randomVector seed Uniform * 2 - 1)
153
168
154− D2Sing ->
169+ D2Sing SNat SNat ->
155 S2D (uniformSample seed (-1) 1)
170 S2D (uniformSample seed (-1) 1)
156
171
157− D3Sing ->
172+ D3Sing SNat SNat SNat ->
158 S3D (uniformSample seed (-1) 1)
173 S3D (uniformSample seed (-1) 1)
159
174
160-- | Generate a shape from a Storable Vector.
175-- | Generate a shape from a Storable Vector.
@@ -162,13 +177,13 @@ randomOfShape = do
162-- Returns Nothing if the vector is of the wrong size.
177-- Returns Nothing if the vector is of the wrong size.
163fromStorable :: forall x. SingI x => Vector Double -> Maybe (S x)
178fromStorable :: forall x. SingI x => Vector Double -> Maybe (S x)
164fromStorable xs = case sing :: Sing x of
179fromStorable xs = case sing :: Sing x of
165− D1Sing ->
180+ D1Sing SNat ->
166 S1D <$> H.create xs
181 S1D <$> H.create xs
167
182
168− D2Sing ->
183+ D2Sing SNat SNat ->
169 S2D <$> mkL xs
184 S2D <$> mkL xs
170
185
171− D3Sing ->
186+ D3Sing SNat SNat SNat ->
172 S3D <$> mkL xs
187 S3D <$> mkL xs
173 where
188 where
174 mkL :: forall rows columns. (KnownNat rows, KnownNat columns)
189 mkL :: forall rows columns. (KnownNat rows, KnownNat columns)
@@ -205,13 +220,13 @@ n2 f (S2D x) (S2D y) = S2D (f x y)
205n2 f (S3D x) (S3D y) = S3D (f x y)
220n2 f (S3D x) (S3D y) = S3D (f x y)
206
221
207-- Helper function for creating the number instances
222-- Helper function for creating the number instances
208−nk :: forall x. (SingI x) => Double -> S x
223+nk :: forall x. SingI x => Double -> S x
209nk x = case (sing :: Sing x) of
224nk x = case (sing :: Sing x) of
210− D1Sing ->
225+ D1Sing SNat ->
211 S1D (konst x)
226 S1D (konst x)
212
227
213− D2Sing ->
228+ D2Sing SNat SNat ->
214 S2D (konst x)
229 S2D (konst x)
215
230
216− D3Sing ->
231+ D3Sing SNat SNat SNat ->
217 S3D (konst x)
232 S3D (konst x)
src/Grenade/Layers/Convolution.hs+10−2
@@ -1,6 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4+{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
@@ -28,9 +29,16 @@ import Control.Monad.Random hiding ( fromList )
28import Data.Maybe
29import Data.Maybe
29import Data.Proxy
30import Data.Proxy
30import Data.Serialize
31import Data.Serialize
32+import Data.Singletons.TypeLits
31
33
34+#if MIN_VERSION_base(4,11,0)
35+import GHC.TypeLits hiding (natVal)
36+#else
32import GHC.TypeLits
37import GHC.TypeLits
38+#endif
39+#if MIN_VERSION_base(4,9,0)
33import Data.Kind (Type)
40import Data.Kind (Type)
41+#endif
34
42
35import Numeric.LinearAlgebra hiding ( uniformSample, konst )
43import Numeric.LinearAlgebra hiding ( uniformSample, konst )
36import qualified Numeric.LinearAlgebra as LA
44import qualified Numeric.LinearAlgebra as LA
@@ -131,8 +139,8 @@ instance ( KnownNat channels
131 , KnownNat (kernelRows * kernelColumns * channels)
139 , KnownNat (kernelRows * kernelColumns * channels)
132 ) => UpdateLayer (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) where
140 ) => UpdateLayer (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) where
133 type Gradient (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Convolution' channels filters kernelRows kernelColumns strideRows strideColumns)
141 type Gradient (Convolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Convolution' channels filters kernelRows kernelColumns strideRows strideColumns)
134− runUpdate lp (Convolution oldKernel oldMomentum) (Convolution' kernelGradient) =
142+ runUpdate LearningParameters {..} (Convolution oldKernel oldMomentum) (Convolution' kernelGradient) =
135− let (newKernel, newMomentum) = descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldKernel kernelGradient oldMomentum
143+ let (newKernel, newMomentum) = descendMatrix learningRate learningMomentum learningRegulariser oldKernel kernelGradient oldMomentum
136 in Convolution newKernel newMomentum
144 in Convolution newKernel newMomentum
137
145
138 createRandom = randomConvolution
146 createRandom = randomConvolution
src/Grenade/Layers/Crop.hs+7
@@ -21,9 +21,16 @@ module Grenade.Layers.Crop (
21import Data.Maybe
21import Data.Maybe
22import Data.Proxy
22import Data.Proxy
23import Data.Serialize
23import Data.Serialize
24+import Data.Singletons.TypeLits
24
25
26+#if MIN_VERSION_base(4,11,0)
27+import GHC.TypeLits hiding (natVal)
28+#else
25import GHC.TypeLits
29import GHC.TypeLits
30+#endif
31+#if MIN_VERSION_base(4,9,0)
26import Data.Kind (Type)
32import Data.Kind (Type)
33+#endif
27
34
28import Grenade.Core
35import Grenade.Core
29import Grenade.Layers.Internal.Pad
36import Grenade.Layers.Internal.Pad
src/Grenade/Layers/Deconvolution.hs+10−2
@@ -1,6 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4+{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
@@ -32,9 +33,16 @@ import Control.Monad.Random hiding ( fromList )
32import Data.Maybe
33import Data.Maybe
33import Data.Proxy
34import Data.Proxy
34import Data.Serialize
35import Data.Serialize
36+import Data.Singletons.TypeLits
35
37
38+#if MIN_VERSION_base(4,11,0)
39+import GHC.TypeLits hiding (natVal)
40+#else
36import GHC.TypeLits
41import GHC.TypeLits
42+#endif
43+#if MIN_VERSION_base(4,9,0)
37import Data.Kind (Type)
44import Data.Kind (Type)
45+#endif
38
46
39import Numeric.LinearAlgebra hiding ( uniformSample, konst )
47import Numeric.LinearAlgebra hiding ( uniformSample, konst )
40import qualified Numeric.LinearAlgebra as LA
48import qualified Numeric.LinearAlgebra as LA
@@ -130,8 +138,8 @@ instance ( KnownNat channels
130 , KnownNat (kernelRows * kernelColumns * filters)
138 , KnownNat (kernelRows * kernelColumns * filters)
131 ) => UpdateLayer (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) where
139 ) => UpdateLayer (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) where
132 type Gradient (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Deconvolution' channels filters kernelRows kernelColumns strideRows strideColumns)
140 type Gradient (Deconvolution channels filters kernelRows kernelColumns strideRows strideColumns) = (Deconvolution' channels filters kernelRows kernelColumns strideRows strideColumns)
133− runUpdate lp (Deconvolution oldKernel oldMomentum) (Deconvolution' kernelGradient) =
141+ runUpdate LearningParameters {..} (Deconvolution oldKernel oldMomentum) (Deconvolution' kernelGradient) =
134− let (newKernel, newMomentum) = descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldKernel kernelGradient oldMomentum
142+ let (newKernel, newMomentum) = descendMatrix learningRate learningMomentum learningRegulariser oldKernel kernelGradient oldMomentum
135 in Deconvolution newKernel newMomentum
143 in Deconvolution newKernel newMomentum
136
144
137 createRandom = randomDeconvolution
145 createRandom = randomDeconvolution
src/Grenade/Layers/FullyConnected.hs+5−4
@@ -1,4 +1,5 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
@@ -13,6 +14,7 @@ import Control.Monad.Random hiding (fromList)
13
14
14import Data.Proxy
15import Data.Proxy
15import Data.Serialize
16import Data.Serialize
17+import Data.Singletons.TypeLits
16
18
17import qualified Numeric.LinearAlgebra as LA
19import qualified Numeric.LinearAlgebra as LA
18import Numeric.LinearAlgebra.Static
20import Numeric.LinearAlgebra.Static
@@ -20,7 +22,6 @@ import Numeric.LinearAlgebra.Static
20import Grenade.Core
22import Grenade.Core
21
23
22import Grenade.Layers.Internal.Update
24import Grenade.Layers.Internal.Update
23−import GHC.TypeLits
24
25
25-- | A basic fully connected (or inner product) neural network layer.
26-- | A basic fully connected (or inner product) neural network layer.
26data FullyConnected i o = FullyConnected
27data FullyConnected i o = FullyConnected
@@ -37,9 +38,9 @@ instance Show (FullyConnected i o) where
37instance (KnownNat i, KnownNat o) => UpdateLayer (FullyConnected i o) where
38instance (KnownNat i, KnownNat o) => UpdateLayer (FullyConnected i o) where
38 type Gradient (FullyConnected i o) = (FullyConnected' i o)
39 type Gradient (FullyConnected i o) = (FullyConnected' i o)
39
40
40− runUpdate lp (FullyConnected (FullyConnected' oldBias oldActivations) (FullyConnected' oldBiasMomentum oldMomentum)) (FullyConnected' biasGradient activationGradient) =
41+ runUpdate LearningParameters {..} (FullyConnected (FullyConnected' oldBias oldActivations) (FullyConnected' oldBiasMomentum oldMomentum)) (FullyConnected' biasGradient activationGradient) =
41− let (newBias, newBiasMomentum) = descendVector (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldBias biasGradient oldBiasMomentum
42+ let (newBias, newBiasMomentum) = descendVector learningRate learningMomentum learningRegulariser oldBias biasGradient oldBiasMomentum
42− (newActivations, newMomentum) = descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) oldActivations activationGradient oldMomentum
43+ (newActivations, newMomentum) = descendMatrix learningRate learningMomentum learningRegulariser oldActivations activationGradient oldMomentum
43 in FullyConnected (FullyConnected' newBias newActivations) (FullyConnected' newBiasMomentum newMomentum)
44 in FullyConnected (FullyConnected' newBias newActivations) (FullyConnected' newBiasMomentum newMomentum)
44
45
45 createRandom = randomFullyConnected
46 createRandom = randomFullyConnected
src/Grenade/Layers/Pad.hs+7
@@ -21,9 +21,16 @@ module Grenade.Layers.Pad (
21import Data.Maybe
21import Data.Maybe
22import Data.Proxy
22import Data.Proxy
23import Data.Serialize
23import Data.Serialize
24+import Data.Singletons.TypeLits
24
25
26+#if MIN_VERSION_base(4,11,0)
27+import GHC.TypeLits hiding (natVal)
28+#else
25import GHC.TypeLits
29import GHC.TypeLits
30+#endif
31+#if MIN_VERSION_base(4,9,0)
26import Data.Kind (Type)
32import Data.Kind (Type)
33+#endif
27
34
28import Grenade.Core
35import Grenade.Core
29import Grenade.Layers.Internal.Pad
36import Grenade.Layers.Internal.Pad
src/Grenade/Layers/Pooling.hs+7
@@ -22,9 +22,16 @@ module Grenade.Layers.Pooling (
22import Data.Maybe
22import Data.Maybe
23import Data.Proxy
23import Data.Proxy
24import Data.Serialize
24import Data.Serialize
25+import Data.Singletons.TypeLits
25
26
27+#if MIN_VERSION_base(4,11,0)
28+import GHC.TypeLits hiding (natVal)
29+#else
26import GHC.TypeLits
30import GHC.TypeLits
31+#endif
32+#if MIN_VERSION_base(4,9,0)
27import Data.Kind (Type)
33import Data.Kind (Type)
34+#endif
28
35
29import Grenade.Core
36import Grenade.Core
30import Grenade.Layers.Internal.Pooling
37import Grenade.Layers.Internal.Pooling
src/Grenade/Layers/Reshape.hs+1
@@ -17,6 +17,7 @@ module Grenade.Layers.Reshape (
17
17
18import Data.Serialize
18import Data.Serialize
19
19
20+import Data.Singletons.TypeLits
20import GHC.TypeLits
21import GHC.TypeLits
21
22
22import Numeric.LinearAlgebra.Static
23import Numeric.LinearAlgebra.Static
src/Grenade/Recurrent/Core/Network.hs+4−1
@@ -29,13 +29,16 @@ module Grenade.Recurrent.Core.Network (
29
29
30
30
31import Control.Monad.Random ( MonadRandom )
31import Control.Monad.Random ( MonadRandom )
32+import Data.Singletons ( SingI )
33+import Data.Singletons.Prelude ( Head, Last )
32import Data.Serialize
34import Data.Serialize
33
35
36+#if MIN_VERSION_base(4,9,0)
34import Data.Kind (Type)
37import Data.Kind (Type)
38+#endif
35
39
36import Grenade.Core
40import Grenade.Core
37import Grenade.Recurrent.Core.Layer
41import Grenade.Recurrent.Core.Layer
38−import Prelude.Singletons
39
42
40-- | Witness type to say indicate we're building up with a normal feed
43-- | Witness type to say indicate we're building up with a normal feed
41-- forward layer.
44-- forward layer.
src/Grenade/Recurrent/Core/Runner.hs+6−5
@@ -6,6 +6,7 @@
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RankNTypes #-}
9+{-# LANGUAGE RecordWildCards #-}
9
10
10module Grenade.Recurrent.Core.Runner (
11module Grenade.Recurrent.Core.Runner (
11 runRecurrentExamples
12 runRecurrentExamples
@@ -17,10 +18,10 @@ module Grenade.Recurrent.Core.Runner (
17 ) where
18 ) where
18
19
19import Data.List ( foldl' )
20import Data.List ( foldl' )
21+import Data.Singletons.Prelude
20import Grenade.Core
22import Grenade.Core
21
23
22import Grenade.Recurrent.Core.Network
24import Grenade.Recurrent.Core.Network
23−import Prelude.Singletons
24
25
25type RecurrentGradients layers = [RecurrentGradient layers]
26type RecurrentGradients layers = [RecurrentGradient layers]
26
27
@@ -100,11 +101,11 @@ updateRecInputs :: Fractional (RecurrentInputs sublayers)
100 -> RecurrentInputs sublayers
101 -> RecurrentInputs sublayers
101 -> RecurrentInputs sublayers
102 -> RecurrentInputs sublayers
102
103
103−updateRecInputs lp (() :~~+> xs) (() :~~+> ys)
104+updateRecInputs l@LearningParameters {..} (() :~~+> xs) (() :~~+> ys)
104− = () :~~+> updateRecInputs lp xs ys
105+ = () :~~+> updateRecInputs l xs ys
105
106
106−updateRecInputs lp (x :~@+> xs) (y :~@+> ys)
107+updateRecInputs l@LearningParameters {..} (x :~@+> xs) (y :~@+> ys)
107− = (realToFrac (1 - learningRate lp * learningRegulariser lp) * x - realToFrac (learningRate lp) * y) :~@+> updateRecInputs lp xs ys
108+ = (realToFrac (1 - learningRate * learningRegulariser) * x - realToFrac learningRate * y) :~@+> updateRecInputs l xs ys
108
109
109updateRecInputs _ RINil RINil
110updateRecInputs _ RINil RINil
110 = RINil
111 = RINil
src/Grenade/Recurrent/Layers/BasicRecurrent.hs+8−4
@@ -1,6 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE GADTs #-}
3{-# LANGUAGE GADTs #-}
4+{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
@@ -16,8 +17,11 @@ module Grenade.Recurrent.Layers.BasicRecurrent (
16
17
17import Control.Monad.Random ( MonadRandom, getRandom )
18import Control.Monad.Random ( MonadRandom, getRandom )
18
19
20+import Data.Singletons.TypeLits
19
21
22+#if MIN_VERSION_base(4,9,0)
20import Data.Kind (Type)
23import Data.Kind (Type)
24+#endif
21
25
22import Numeric.LinearAlgebra.Static
26import Numeric.LinearAlgebra.Static
23
27
@@ -56,11 +60,11 @@ instance Show (BasicRecurrent i o) where
56instance (KnownNat i, KnownNat o, KnownNat (i + o)) => UpdateLayer (BasicRecurrent i o) where
60instance (KnownNat i, KnownNat o, KnownNat (i + o)) => UpdateLayer (BasicRecurrent i o) where
57 type Gradient (BasicRecurrent i o) = (BasicRecurrent' i o)
61 type Gradient (BasicRecurrent i o) = (BasicRecurrent' i o)
58
62
59− runUpdate lp (BasicRecurrent oldBias oldBiasMomentum oldActivations oldMomentum) (BasicRecurrent' biasGradient activationGradient) =
63+ runUpdate LearningParameters {..} (BasicRecurrent oldBias oldBiasMomentum oldActivations oldMomentum) (BasicRecurrent' biasGradient activationGradient) =
60− let newBiasMomentum = konst (learningMomentum lp) * oldBiasMomentum - konst (learningRate lp) * biasGradient
64+ let newBiasMomentum = konst learningMomentum * oldBiasMomentum - konst learningRate * biasGradient
61 newBias = oldBias + newBiasMomentum
65 newBias = oldBias + newBiasMomentum
62− newMomentum = konst (learningMomentum lp) * oldMomentum - konst (learningRate lp) * activationGradient
66+ newMomentum = konst learningMomentum * oldMomentum - konst learningRate * activationGradient
63− regulariser = konst (learningRegulariser lp * learningRate lp) * oldActivations
67+ regulariser = konst (learningRegulariser * learningRate) * oldActivations
64 newActivations = oldActivations + newMomentum - regulariser
68 newActivations = oldActivations + newMomentum - regulariser
65 in BasicRecurrent newBias newBiasMomentum newActivations newMomentum
69 in BasicRecurrent newBias newBiasMomentum newActivations newMomentum
66
70
src/Grenade/Recurrent/Layers/LSTM.hs+55−41
@@ -3,6 +3,7 @@
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE RankNTypes #-}
6+{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
@@ -21,7 +22,11 @@ import Control.Monad.Random ( MonadRandom, getRandom )
21-- import Data.List ( foldl1' )
22-- import Data.List ( foldl1' )
22import Data.Proxy
23import Data.Proxy
23import Data.Serialize
24import Data.Serialize
25+import Data.Singletons.TypeLits
26+
27+#if MIN_VERSION_base(4,9,0)
24import Data.Kind (Type)
28import Data.Kind (Type)
29+#endif
25
30
26import qualified Numeric.LinearAlgebra as LA
31import qualified Numeric.LinearAlgebra as LA
27import Numeric.LinearAlgebra.Static
32import Numeric.LinearAlgebra.Static
@@ -29,7 +34,6 @@ import Numeric.LinearAlgebra.Static
29import Grenade.Core
34import Grenade.Core
30import Grenade.Recurrent.Core
35import Grenade.Recurrent.Core
31import Grenade.Layers.Internal.Update
36import Grenade.Layers.Internal.Update
32−import GHC.TypeLits
33
37
34
38
35-- | Long Short Term Memory Recurrent unit
39-- | Long Short Term Memory Recurrent unit
@@ -71,7 +75,7 @@ instance (KnownNat i, KnownNat o) => UpdateLayer (LSTM i o) where
71
75
72 -- Run the update function for each group matrix/vector of weights, momentums and gradients.
76 -- Run the update function for each group matrix/vector of weights, momentums and gradients.
73 -- Hmm, maybe the function should be used instead of passing in the learning parameters.
77 -- Hmm, maybe the function should be used instead of passing in the learning parameters.
74− runUpdate lp (LSTM w m) g =
78+ runUpdate LearningParameters {..} (LSTM w m) g =
75 let (wf, wf') = u lstmWf w m g
79 let (wf, wf') = u lstmWf w m g
76 (uf, uf') = u lstmUf w m g
80 (uf, uf') = u lstmUf w m g
77 (bf, bf') = v lstmBf w m g
81 (bf, bf') = v lstmBf w m g
@@ -88,11 +92,11 @@ instance (KnownNat i, KnownNat o) => UpdateLayer (LSTM i o) where
88 -- Utility function for updating with the momentum, gradients, and weights.
92 -- Utility function for updating with the momentum, gradients, and weights.
89 u :: forall x ix out. (KnownNat ix, KnownNat out) => (x -> (L out ix)) -> x -> x -> x -> ((L out ix), (L out ix))
93 u :: forall x ix out. (KnownNat ix, KnownNat out) => (x -> (L out ix)) -> x -> x -> x -> ((L out ix), (L out ix))
90 u e (e -> weights) (e -> momentum) (e -> gradient) =
94 u e (e -> weights) (e -> momentum) (e -> gradient) =
91− descendMatrix (learningRate lp) (learningMomentum lp) (learningRegulariser lp) weights gradient momentum
95+ descendMatrix learningRate learningMomentum learningRegulariser weights gradient momentum
92
96
93 v :: forall x ix. (KnownNat ix) => (x -> (R ix)) -> x -> x -> x -> ((R ix), (R ix))
97 v :: forall x ix. (KnownNat ix) => (x -> (R ix)) -> x -> x -> x -> ((R ix), (R ix))
94 v e (e -> weights) (e -> momentum) (e -> gradient) =
98 v e (e -> weights) (e -> momentum) (e -> gradient) =
95− descendVector (learningRate lp) (learningMomentum lp) (learningRegulariser lp) weights gradient momentum
99+ descendVector learningRate learningMomentum learningRegulariser weights gradient momentum
96
100
97 -- There's a lot of updates here, so to try and minimise the number of data copies
101 -- There's a lot of updates here, so to try and minimise the number of data copies
98 -- we'll create a mutable bucket for each.
102 -- we'll create a mutable bucket for each.
@@ -133,18 +137,18 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w
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)
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)
134 -- Forward propagation for the LSTM layer.
138 -- Forward propagation for the LSTM layer.
135 -- The size of the cell state is also the size of the output.
139 -- The size of the cell state is also the size of the output.
136− runRecurrentForwards (LSTM lw _) (S1D cell) (S1D input) =
140+ runRecurrentForwards (LSTM (LSTMWeights {..}) _) (S1D cell) (S1D input) =
137 let -- Forget state vector
141 let -- Forget state vector
138− f_s = lstmBf lw + lstmWf lw #> input + lstmUf lw #> cell
142+ f_s = lstmBf + lstmWf #> input + lstmUf #> cell
139 f_t = sigmoid f_s
143 f_t = sigmoid f_s
140 -- Input state vector
144 -- Input state vector
141− i_s = lstmBi lw + lstmWi lw #> input + lstmUi lw #> cell
145+ i_s = lstmBi + lstmWi #> input + lstmUi #> cell
142 i_t = sigmoid i_s
146 i_t = sigmoid i_s
143 -- Output state vector
147 -- Output state vector
144− o_s = lstmBo lw + lstmWo lw #> input + lstmUo lw #> cell
148+ o_s = lstmBo + lstmWo #> input + lstmUo #> cell
145 o_t = sigmoid o_s
149 o_t = sigmoid o_s
146 -- Cell input state vector
150 -- Cell input state vector
147− c_s = lstmBc lw + lstmWc lw #> input
151+ c_s = lstmBc + lstmWc #> input
148 c_x = tanh c_s
152 c_x = tanh c_s
149 -- Cell state
153 -- Cell state
150 c_t = f_t * cell + i_t * c_x
154 c_t = f_t * cell + i_t * c_x
@@ -158,7 +162,7 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w
158 --
162 --
159 -- There's a test version using the AD library without hmatrix in the test
163 -- There's a test version using the AD library without hmatrix in the test
160 -- suite. These should match always.
164 -- suite. These should match always.
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') =
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') =
162 let -- Reverse Mode AD Derivitives
166 let -- Reverse Mode AD Derivitives
163 c_t' = h_t' * o_t + cellGrad
167 c_t' = h_t' * o_t + cellGrad
164
168
@@ -175,8 +179,8 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w
175 c_s' = tanh' c_s * c_x'
179 c_s' = tanh' c_s * c_x'
176
180
177 -- The derivatives to pass sideways (recurrent) and downwards
181 -- The derivatives to pass sideways (recurrent) and downwards
178− cell' = tr (lstmUf lw) #> f_s' + tr (lstmUo lw) #> o_s' + tr (lstmUi lw) #> i_s' + c_t' * f_t
182+ cell' = tr lstmUf #> f_s' + tr lstmUo #> o_s' + tr lstmUi #> i_s' + c_t' * f_t
179− input' = tr (lstmWf lw) #> f_s' + tr (lstmWo lw) #> o_s' + tr (lstmWi lw) #> i_s' + tr (lstmWc lw) #> c_s'
183+ input' = tr lstmWf #> f_s' + tr lstmWo #> o_s' + tr lstmWi #> i_s' + tr lstmWc #> c_s'
180
184
181 -- Calculate the gradient Matricies for the input
185 -- Calculate the gradient Matricies for the input
182 lstmWf' = f_s' `outer` input
186 lstmWf' = f_s' `outer` input
@@ -235,34 +239,44 @@ tanh' :: (Floating a) => a -> a
235tanh' t = 1 - s ^ (2 :: Int) where s = tanh t
239tanh' t = 1 - s ^ (2 :: Int) where s = tanh t
236
240
237instance (KnownNat i, KnownNat o) => Serialize (LSTM i o) where
241instance (KnownNat i, KnownNat o) => Serialize (LSTM i o) where
238− put (LSTM lw _) = do
242+ put (LSTM LSTMWeights {..} _) = do
239− u (lstmWf lw)
243+ u lstmWf
240− u (lstmUf lw)
244+ u lstmUf
241− v (lstmBf lw)
245+ v lstmBf
242− u (lstmWi lw)
246+ u lstmWi
243− u (lstmUi lw)
247+ u lstmUi
244− v (lstmBi lw)
248+ v lstmBi
245− u (lstmWo lw)
249+ u lstmWo
246− u (lstmUo lw)
250+ u lstmUo
247− v (lstmBo lw)
251+ v lstmBo
248− u (lstmWc lw)
252+ u lstmWc
249− v (lstmBc lw)
253+ v lstmBc
250− where
254+ where
251− u :: forall a b. (KnownNat a, KnownNat b) => Putter (L b a)
255+ u :: forall a b. (KnownNat a, KnownNat b) => Putter (L b a)
252− u = putListOf put . LA.toList . LA.flatten . extract
256+ u = putListOf put . LA.toList . LA.flatten . extract
253− v :: forall a. (KnownNat a) => Putter (R a)
257+ v :: forall a. (KnownNat a) => Putter (R a)
254− v = putListOf put . LA.toList . extract
258+ v = putListOf put . LA.toList . extract
255
259
256 get = do
260 get = do
257− w <- LSTMWeights <$> u <*> u <*> v <*> u <*> u <*> v <*> u <*> u <*> v <*> u <*> v
261+ lstmWf <- u
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
258− return $ LSTM w (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)
272+ return $ LSTM (LSTMWeights {..}) (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)
259− where
273+ where
260− u :: forall a b. (KnownNat a, KnownNat b) => Get (L b a)
274+ u :: forall a b. (KnownNat a, KnownNat b) => Get (L b a)
261− u = let f = fromIntegral $ natVal (Proxy :: Proxy a)
275+ u = let f = fromIntegral $ natVal (Proxy :: Proxy a)
262− in maybe (fail "Vector of incorrect size") return . create . LA.reshape f . LA.fromList =<< getListOf get
276+ in maybe (fail "Vector of incorrect size") return . create . LA.reshape f . LA.fromList =<< getListOf get
263− v :: forall a. (KnownNat a) => Get (R a)
277+ v :: forall a. (KnownNat a) => Get (R a)
264− v = maybe (fail "Vector of incorrect size") return . create . LA.fromList =<< getListOf get
278+ v = maybe (fail "Vector of incorrect size") return . create . LA.fromList =<< getListOf get
265−
279+
266− w0 = konst 0
280+ w0 = konst 0
267− u0 = konst 0
281+ u0 = konst 0
268− v0 = konst 0
282+ v0 = konst 0
src/Grenade/Utils/OneHot.hs+1−1
@@ -22,6 +22,7 @@ import Data.Map ( Map )
22import qualified Data.Map as M
22import qualified Data.Map as M
23
23
24import Data.Proxy
24import Data.Proxy
25+import Data.Singletons.TypeLits
25
26
26import Data.Vector ( Vector )
27import Data.Vector ( Vector )
27import qualified Data.Vector as V
28import qualified Data.Vector as V
@@ -30,7 +31,6 @@ import qualified Data.Vector.Storable as VS
30import Numeric.LinearAlgebra ( maxIndex )
31import Numeric.LinearAlgebra ( maxIndex )
31import Numeric.LinearAlgebra.Devel
32import Numeric.LinearAlgebra.Devel
32import Numeric.LinearAlgebra.Static
33import Numeric.LinearAlgebra.Static
33−import GHC.TypeLits
34
34
35import Grenade.Core.Shape
35import Grenade.Core.Shape
36
36
stack.yaml+1−7
@@ -20,7 +20,7 @@
20#
20#
21# resolver: ./custom-snapshot.yaml
21# resolver: ./custom-snapshot.yaml
22# resolver: https://example.com/snapshots/2018-01-01.yaml
22# resolver: https://example.com/snapshots/2018-01-01.yaml
23−resolver: lts-20.18
23+resolver: lts-15.5
24
24
25# User packages to be built.
25# User packages to be built.
26# Various formats can be used as shown in the example below.
26# Various formats can be used as shown in the example below.
@@ -70,9 +70,3 @@ extra-deps:
70#
70#
71# Allow a newer minor version of GHC than the snapshot specifies
71# Allow a newer minor version of GHC than the snapshot specifies
72# compiler-check: newer-minor
72# compiler-check: newer-minor
73−
74−nix:
75− enable: true
76− packages:
77− - blas
78− - lapack
stack.yaml.lock+5−5
@@ -7,13 +7,13 @@ packages:
7- completed:
7- completed:
8 hackage: typelits-witnesses-0.3.0.3@sha256:2d9df4ac6ff3077bfd2bf659e4b495e157723ac5b45c519762853f55df5c16db,2738
8 hackage: typelits-witnesses-0.3.0.3@sha256:2d9df4ac6ff3077bfd2bf659e4b495e157723ac5b45c519762853f55df5c16db,2738
9 pantry-tree:
9 pantry-tree:
10− sha256: 6a42a462f98e94933b6e9721acd912c6c6b6a4743635efd15cc5871908c816a0
11 size: 469
10 size: 469
11+ sha256: 6a42a462f98e94933b6e9721acd912c6c6b6a4743635efd15cc5871908c816a0
12 original:
12 original:
13 hackage: typelits-witnesses-0.3.0.3
13 hackage: typelits-witnesses-0.3.0.3
14snapshots:
14snapshots:
15- completed:
15- completed:
16− sha256: 9fa4bece7acfac1fc7930c5d6e24606004b09e80aa0e52e9f68b148201008db9
17− size: 649606
16+ size: 491372
18− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/18.yaml
17+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/5.yaml
18+ sha256: 1b549cfff328040c382a70a84a2087aac8dab6d778bf92f32a93a771a1980dfc
19− original: lts-20.18
19+ original: lts-15.5
test/Test/Grenade/Recurrent/Layers/LSTM/Reference.hs+21−25
@@ -6,6 +6,7 @@
6{-# LANGUAGE DeriveFunctor #-}
6{-# LANGUAGE DeriveFunctor #-}
7{-# LANGUAGE DeriveFoldable #-}
7{-# LANGUAGE DeriveFoldable #-}
8{-# LANGUAGE DeriveTraversable #-}
8{-# LANGUAGE DeriveTraversable #-}
9+{-# LANGUAGE RecordWildCards #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RankNTypes #-}
11
12
@@ -14,13 +15,9 @@ module Test.Grenade.Recurrent.Layers.LSTM.Reference where
14
15
15import Data.Reflection
16import Data.Reflection
16import Numeric.AD.Mode.Reverse
17import Numeric.AD.Mode.Reverse
17−import Numeric.AD.Internal.Reverse (Tape)
18+import Numeric.AD.Internal.Reverse ( Tape )
18
19
19−import GHC.TypeLits (KnownNat)
20−
21−import Grenade.Recurrent.Layers.LSTM (LSTMWeights (..))
22import qualified Grenade.Recurrent.Layers.LSTM as LSTM
20import qualified Grenade.Recurrent.Layers.LSTM as LSTM
23−
24import qualified Numeric.LinearAlgebra.Static as S
21import qualified Numeric.LinearAlgebra.Static as S
25import qualified Numeric.LinearAlgebra as H
22import qualified Numeric.LinearAlgebra as H
26
23
@@ -57,32 +54,31 @@ data RefLSTM a = RefLSTM
57 , refLstmBc :: Vector a -- Bias Cell (b_c)
54 , refLstmBc :: Vector a -- Bias Cell (b_c)
58 } deriving (Functor, Foldable, Traversable, Eq, Show)
55 } deriving (Functor, Foldable, Traversable, Eq, Show)
59
56
60−lstmToReference :: (KnownNat a, KnownNat b) => LSTM.LSTMWeights a b -> RefLSTM Double
57+lstmToReference :: LSTM.LSTMWeights a b -> RefLSTM Double
61−lstmToReference lw =
58+lstmToReference LSTM.LSTMWeights {..} =
62− RefLSTM
63− { refLstmWf = Matrix . H.toLists . S.extract $ lstmWf lw -- Weight Forget (W_f)
59+ let refLstmWf = Matrix . H.toLists . S.extract $ lstmWf -- Weight Forget (W_f)
64− , refLstmUf = Matrix . H.toLists . S.extract $ lstmUf lw -- Cell State Forget (U_f)
60+ refLstmUf = Matrix . H.toLists . S.extract $ lstmUf -- Cell State Forget (U_f)
65− , refLstmBf = Vector . H.toList . S.extract $ lstmBf lw -- Bias Forget (b_f)
61+ refLstmBf = Vector . H.toList . S.extract $ lstmBf -- Bias Forget (b_f)
66− , refLstmWi = Matrix . H.toLists . S.extract $ lstmWi lw -- Weight Input (W_i)
62+ refLstmWi = Matrix . H.toLists . S.extract $ lstmWi -- Weight Input (W_i)
67− , refLstmUi = Matrix . H.toLists . S.extract $ lstmUi lw -- Cell State Input (U_i)
63+ refLstmUi = Matrix . H.toLists . S.extract $ lstmUi -- Cell State Input (U_i)
68− , refLstmBi = Vector . H.toList . S.extract $ lstmBi lw -- Bias Input (b_i)
64+ refLstmBi = Vector . H.toList . S.extract $ lstmBi -- Bias Input (b_i)
69− , refLstmWo = Matrix . H.toLists . S.extract $ lstmWo lw -- Weight Output (W_o)
65+ refLstmWo = Matrix . H.toLists . S.extract $ lstmWo -- Weight Output (W_o)
70− , refLstmUo = Matrix . H.toLists . S.extract $ lstmUo lw -- Cell State Output (U_o)
66+ refLstmUo = Matrix . H.toLists . S.extract $ lstmUo -- Cell State Output (U_o)
71− , refLstmBo = Vector . H.toList . S.extract $ lstmBo lw -- Bias Output (b_o)
67+ refLstmBo = Vector . H.toList . S.extract $ lstmBo -- Bias Output (b_o)
72− , refLstmWc = Matrix . H.toLists . S.extract $ lstmWc lw -- Weight Cell (W_c)
68+ refLstmWc = Matrix . H.toLists . S.extract $ lstmWc -- Weight Cell (W_c)
73− , refLstmBc = Vector . H.toList . S.extract $ lstmBc lw -- Bias Cell (b_c)
69+ refLstmBc = Vector . H.toList . S.extract $ lstmBc -- Bias Cell (b_c)
74− }
70+ in RefLSTM {..}
75
71
76runLSTM :: Floating a => RefLSTM a -> Vector a -> Vector a -> (Vector a, Vector a)
72runLSTM :: Floating a => RefLSTM a -> Vector a -> Vector a -> (Vector a, Vector a)
77−runLSTM rl cell input =
73+runLSTM RefLSTM {..} cell input =
78 let -- Forget state vector
74 let -- Forget state vector
79− f_t = sigmoid $ refLstmBf rl #+ refLstmWf rl #> input #+ refLstmUf rl #> cell
75+ f_t = sigmoid $ refLstmBf #+ refLstmWf #> input #+ refLstmUf #> cell
80 -- Input state vector
76 -- Input state vector
81− i_t = sigmoid $ refLstmBi rl #+ refLstmWi rl #> input #+ refLstmUi rl #> cell
77+ i_t = sigmoid $ refLstmBi #+ refLstmWi #> input #+ refLstmUi #> cell
82 -- Output state vector
78 -- Output state vector
83− o_t = sigmoid $ refLstmBo rl #+ refLstmWo rl #> input #+ refLstmUo rl #> cell
79+ o_t = sigmoid $ refLstmBo #+ refLstmWo #> input #+ refLstmUo #> cell
84 -- Cell input state vector
80 -- Cell input state vector
85− c_x = fmap tanh $ refLstmBc rl #+ refLstmWc rl #> input
81+ c_x = fmap tanh $ refLstmBc #+ refLstmWc #> input
86 -- Cell state
82 -- Cell state
87 c_t = f_t #* cell #+ i_t #* c_x
83 c_t = f_t #* cell #+ i_t #* c_x
88 -- Output (it's sometimes recommended to use tanh c_t)
84 -- Output (it's sometimes recommended to use tanh c_t)