@@ -3,7 +3,6 @@
33{-# LANGUAGE DataKinds #-}
44{-# LANGUAGE GADTs #-}
55{-# LANGUAGE RankNTypes #-}
6−{-# LANGUAGE RecordWildCards #-}
76{-# LANGUAGE TypeOperators #-}
87{-# LANGUAGE TypeFamilies #-}
98{-# LANGUAGE MultiParamTypeClasses #-}
@@ -75,7 +74,7 @@ instance (KnownNat i, KnownNat o) => UpdateLayer (LSTM i o) where
7574
7675 -- Run the update function for each group matrix/vector of weights, momentums and gradients.
7776 -- 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 =
7978 let (wf, wf') = u lstmWf w m g
8079 (uf, uf') = u lstmUf w m g
8180 (bf, bf') = v lstmBf w m g
@@ -92,11 +91,11 @@ instance (KnownNat i, KnownNat o) => UpdateLayer (LSTM i o) where
9291 -- Utility function for updating with the momentum, gradients, and weights.
9392 u :: forall x ix out. (KnownNat ix, KnownNat out) => (x -> (L out ix)) -> x -> x -> x -> ((L out ix), (L out ix))
9493 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
9695
9796 v :: forall x ix. (KnownNat ix) => (x -> (R ix)) -> x -> x -> x -> ((R ix), (R ix))
9897 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
10099
101100 -- There's a lot of updates here, so to try and minimise the number of data copies
102101 -- 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
137136 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)
138137 -- Forward propagation for the LSTM layer.
139138 -- 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) =
141140 let -- Forget state vector
142− f_s = lstmBf + lstmWf #> input + lstmUf #> cell
141+ f_s = lstmBf lw + lstmWf lw #> input + lstmUf lw #> cell
143142 f_t = sigmoid f_s
144143 -- Input state vector
145− i_s = lstmBi + lstmWi #> input + lstmUi #> cell
144+ i_s = lstmBi lw + lstmWi lw #> input + lstmUi lw #> cell
146145 i_t = sigmoid i_s
147146 -- Output state vector
148− o_s = lstmBo + lstmWo #> input + lstmUo #> cell
147+ o_s = lstmBo lw + lstmWo lw #> input + lstmUo lw #> cell
149148 o_t = sigmoid o_s
150149 -- Cell input state vector
151− c_s = lstmBc + lstmWc #> input
150+ c_s = lstmBc lw + lstmWc lw #> input
152151 c_x = tanh c_s
153152 -- Cell state
154153 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
162161 --
163162 -- There's a test version using the AD library without hmatrix in the test
164163 -- 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') =
166165 let -- Reverse Mode AD Derivitives
167166 c_t' = h_t' * o_t + cellGrad
168167
@@ -179,8 +178,8 @@ instance (KnownNat i, KnownNat o) => RecurrentLayer (LSTM i o) ('D1 i) ('D1 o) w
179178 c_s' = tanh' c_s * c_x'
180179
181180 -- 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
183− input' = tr lstmWf #> f_s' + tr lstmWo #> o_s' + tr lstmWi #> i_s' + tr lstmWc #> c_s'
181+ cell' = tr (lstmUf lw) #> f_s' + tr (lstmUo lw) #> o_s' + tr (lstmUi lw) #> i_s' + c_t' * f_t
182+ input' = tr (lstmWf lw) #> f_s' + tr (lstmWo lw) #> o_s' + tr (lstmWi lw) #> i_s' + tr (lstmWc lw) #> c_s'
184183
185184 -- Calculate the gradient Matricies for the input
186185 lstmWf' = f_s' `outer` input
@@ -239,44 +238,34 @@ tanh' :: (Floating a) => a -> a
239238tanh' t = 1 - s ^ (2 :: Int) where s = tanh t
240239
241240instance (KnownNat i, KnownNat o) => Serialize (LSTM i o) where
242− put (LSTM LSTMWeights {..} _) = do
243− u lstmWf
244− u lstmUf
245− v lstmBf
246− u lstmWi
247− u lstmUi
248− v lstmBi
249− u lstmWo
250− u lstmUo
251− v lstmBo
252− u lstmWc
253− v lstmBc
254− where
255− u :: forall a b. (KnownNat a, KnownNat b) => Putter (L b a)
256− u = putListOf put . LA.toList . LA.flatten . extract
257− v :: forall a. (KnownNat a) => Putter (R a)
258− v = putListOf put . LA.toList . extract
241+ put (LSTM lw _) = do
242+ u (lstmWf lw)
243+ u (lstmUf lw)
244+ v (lstmBf lw)
245+ u (lstmWi lw)
246+ u (lstmUi lw)
247+ v (lstmBi lw)
248+ u (lstmWo lw)
249+ u (lstmUo lw)
250+ v (lstmBo lw)
251+ u (lstmWc lw)
252+ v (lstmBc lw)
253+ where
254+ u :: forall a b. (KnownNat a, KnownNat b) => Putter (L b a)
255+ u = putListOf put . LA.toList . LA.flatten . extract
256+ v :: forall a. (KnownNat a) => Putter (R a)
257+ v = putListOf put . LA.toList . extract
259258
260259 get = do
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
272− return $ LSTM (LSTMWeights {..}) (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)
273− where
274− u :: forall a b. (KnownNat a, KnownNat b) => Get (L b a)
275− 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
277− v :: forall a. (KnownNat a) => Get (R a)
278− v = maybe (fail "Vector of incorrect size") return . create . LA.fromList =<< getListOf get
279−
280− w0 = konst 0
281− u0 = konst 0
282− v0 = konst 0
260+ w <- LSTMWeights <$> u <*> u <*> v <*> u <*> u <*> v <*> u <*> u <*> v <*> u <*> v
261+ return $ LSTM w (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)
262+ where
263+ u :: forall a b. (KnownNat a, KnownNat b) => Get (L b a)
264+ u = let f = fromIntegral $ natVal (Proxy :: Proxy a)
265+ in maybe (fail "Vector of incorrect size") return . create . LA.reshape f . LA.fromList =<< getListOf get
266+ v :: forall a. (KnownNat a) => Get (R a)
267+ v = maybe (fail "Vector of incorrect size") return . create . LA.fromList =<< getListOf get
268+
269+ w0 = konst 0
270+ u0 = konst 0
271+ v0 = konst 0