5206c95 · grenade · git.iko.soy

git.iko.soy/grenade

on master help sign in

Remove use of RecordWildCards

5206c95Erik de Castro Lopo7 years ago

examples/main/shakespeare.hs+12−13

compare with master

unifiedsplit

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

1{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE CPP #-}

3−{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

5{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE TypeOperators #-}

5{-# LANGUAGE TypeOperators #-}

@@ -83,34 +82,34 @@ loadShakespeare path = do

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

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

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

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

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

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

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

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

88 in case reverse e of

87 in case reverse e of

89 (o : l : xs) ->

88 (o : l : xs) ->

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

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

91− in trainRecurrent rate net recIns examples

90+ in trainRecurrent lrate net recIns examples

92 _ -> error "Not enough input"

91 _ -> error "Not enough input"

93 where

92 where

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

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

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

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

97−runShakespeare ShakespeareOpts {..} = do

96+runShakespeare opts = do

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

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

99 (net0, i0) <- lift $

98 (net0, i0) <- lift $

100− case loadPath of

99+ case loadPath opts of

101 Just loadFile -> netLoad loadFile

100 Just loadFile -> netLoad loadFile

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

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

103

102

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

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

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

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

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

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

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

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

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

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

109 putStrLn (unAnnotateCapitals results)

108 putStrLn (unAnnotateCapitals results)

110 return (trained, bestInput)

109 return (trained, bestInput)

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

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

112

111

113− case savePath of

112+ case savePath opts of

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

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

115 Nothing -> return ()

114 Nothing -> return ()

116

115

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

122 -> Vector a

121 -> Vector a

123 -> S ('D1 n)

122 -> S ('D1 n)

124 -> IO [a]

123 -> IO [a]

125−generateParagraph n s temperature hotmap hotdict =

124+generateParagraph n s temp hotmap hotdict =

126 go s

125 go s

127 where

126 where

128 go x y =

127 go x y =

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

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

130− un <- sample temperature hotdict o

129+ un <- sample temp hotdict o

131 Just re <- return $ makeHot hotmap un

130 Just re <- return $ makeHot hotmap un

132 rest <- unsafeInterleaveIO $ go ns re

131 rest <- unsafeInterleaveIO $ go ns re

133 return (un : rest)

132 return (un : rest)

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

@@ -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 #-}

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

139 , KnownNat (kernelRows * kernelColumns * channels)

138 , KnownNat (kernelRows * kernelColumns * channels)

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

139 ) => 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)

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

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

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

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

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

144 in Convolution newKernel newMomentum

143 in Convolution newKernel newMomentum

145

144

146 createRandom = randomConvolution

145 createRandom = randomConvolution

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

@@ -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 #-}

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

138 , KnownNat (kernelRows * kernelColumns * filters)

137 , KnownNat (kernelRows * kernelColumns * filters)

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

138 ) => 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)

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

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

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

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

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

143 in Deconvolution newKernel newMomentum

142 in Deconvolution newKernel newMomentum

144

143

145 createRandom = randomDeconvolution

144 createRandom = randomDeconvolution

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

@@ -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 #-}

@@ -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)

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)

46 createRandom = randomFullyConnected

45 createRandom = randomFullyConnected

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

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

6{-# LANGUAGE TypeFamilies #-}

7{-# LANGUAGE FlexibleContexts #-}

8{-# LANGUAGE RankNTypes #-}

9−{-# LANGUAGE RecordWildCards #-}

11module Grenade.Recurrent.Core.Runner (

10module Grenade.Recurrent.Core.Runner (

12 runRecurrentExamples

11 runRecurrentExamples

@@ -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−5

@@ -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 #-}

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

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

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

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

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

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

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

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

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

65 newBias = oldBias + newBiasMomentum

64 newBias = oldBias + newBiasMomentum

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

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

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

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

68 newActivations = oldActivations + newMomentum - regulariser

67 newActivations = oldActivations + newMomentum - regulariser

69 in BasicRecurrent newBias newBiasMomentum newActivations newMomentum

68 in BasicRecurrent newBias newBiasMomentum newActivations newMomentum

src/Grenade/Recurrent/Layers/LSTM.hs+40−51

@@ -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 #-}

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

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

75 -- 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.

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

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

77+ runUpdate lp (LSTM w m) g =

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

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

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

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

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

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

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

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

91 -- 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))

92 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) =

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

95− descendMatrix learningRate learningMomentum learningRegulariser weights gradient momentum

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

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

96 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) =

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

99− descendVector learningRate learningMomentum learningRegulariser weights gradient momentum

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

100

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

100 -- 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.

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

@@ -137,18 +136,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)

136 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.

137 -- Forward propagation for the LSTM layer.

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

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

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

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

141 let -- Forget state vector

140 let -- Forget state vector

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

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

143 f_t = sigmoid f_s

142 f_t = sigmoid f_s

144 -- Input state vector

143 -- Input state vector

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

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

146 i_t = sigmoid i_s

145 i_t = sigmoid i_s

147 -- Output state vector

146 -- Output state vector

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

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

149 o_t = sigmoid o_s

148 o_t = sigmoid o_s

150 -- Cell input state vector

149 -- Cell input state vector

151− c_s = lstmBc + lstmWc #> input

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

152 c_x = tanh c_s

151 c_x = tanh c_s

153 -- Cell state

152 -- Cell state

154 c_t = f_t * cell + i_t * c_x

153 c_t = f_t * cell + i_t * c_x

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

162 --

161 --

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

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

164 -- suite. These should match always.

163 -- 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') =

164+ 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

165 let -- Reverse Mode AD Derivitives

167 c_t' = h_t' * o_t + cellGrad

166 c_t' = h_t' * o_t + cellGrad

168

167

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

179 c_s' = tanh' c_s * c_x'

178 c_s' = tanh' c_s * c_x'

180

179

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

180 -- 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

181+ 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'

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

184

183

185 -- Calculate the gradient Matricies for the input

184 -- Calculate the gradient Matricies for the input

186 lstmWf' = f_s' `outer` input

185 lstmWf' = f_s' `outer` input

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

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

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

240

239

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

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

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

241+ put (LSTM lw _) = do

243− u lstmWf

242+ u (lstmWf lw)

244− u lstmUf

243+ u (lstmUf lw)

245− v lstmBf

244+ v (lstmBf lw)

246− u lstmWi

245+ u (lstmWi lw)

247− u lstmUi

246+ u (lstmUi lw)

248− v lstmBi

247+ v (lstmBi lw)

249− u lstmWo

248+ u (lstmWo lw)

250− u lstmUo

249+ u (lstmUo lw)

251− v lstmBo

250+ v (lstmBo lw)

252− u lstmWc

251+ u (lstmWc lw)

253− v lstmBc

252+ v (lstmBc lw)

254− where

253+ where

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

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

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

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

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

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

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

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

259

258

260 get = do

259 get = do

261− lstmWf <- u

260+ 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)

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

273− where

262+ where

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

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

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

264+ 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

265+ 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)

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

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

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

279−

268+

280− w0 = konst 0

269+ w0 = konst 0

281− u0 = konst 0

270+ u0 = konst 0

282− v0 = konst 0

271+ v0 = konst 0

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 #-}

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

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+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

@@ -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)

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+ }

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)