@@ -0,0 +1,72 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE BangPatterns #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+import Criterion.Main
5+
6+import Grenade
7+import Grenade.Recurrent
8+import Grenade.Layers.Internal.Update
9+
10+import qualified Numeric.LinearAlgebra.Static as H
11+
12+main :: IO ()
13+main = do
14+ layer60 :: LSTM 40 60 <- createRandom
15+ layer512 :: LSTM 40 512 <- createRandom
16+ input40 :: S ('D1 40) <- randomOfShape
17+ rec60 :: S ('D1 60) <- randomOfShape
18+ rec512 :: S ('D1 512) <- randomOfShape
19+ (lstm, lstm') :: (RecNet, RecInput) <- randomRecurrent
20+
21+ let upIn60 :: H.R 3600 = H.randomVector 1 H.Uniform * 2 - 1
22+ let upIn512 :: H.R 262144 = H.randomVector 1 H.Uniform * 2 - 1
23+
24+ defaultMain [
25+ bgroup "lstm" [ bench "forwards-60" $ nf (nfT2 . uncurry (testRun60 layer60)) (rec60, input40)
26+ , bench "forwards-512" $ nf (nfT2 . uncurry (testRun512 layer512)) (rec512, input40)
27+ , bench "backwards-60" $ nf (nfT3 . uncurry4 (testRun60' layer60)) (rec60, input40, rec60, rec60)
28+ , bench "backwards-512" $ nf (nfT3 . uncurry4 (testRun512' layer512)) (rec512, input40, rec512, rec512)
29+ ]
30+ , bgroup "update" [ bench "matrix-60x60" $ nf (uncurry3 (decendVector 1 1 1)) (upIn60, upIn60, upIn60)
31+ , bench "matrix-512x512" $ nf (uncurry3 (decendVector 1 1 1)) (upIn512, upIn512, upIn512)
32+ ]
33+ , bgroup "train" [ bench "one-time-step" $ whnf (nfT2 . trainRecurrent lp lstm lstm') [(input40, Just input40)]
34+ , bench "ten-time-steps" $ whnf (nfT2 . trainRecurrent lp lstm lstm') $ replicate 10 (input40, Just input40)
35+ , bench "fifty-time-steps" $ whnf (nfT2 . trainRecurrent lp lstm lstm') $ replicate 50 (input40, Just input40)
36+ ]
37+ ]
38+
39+testRun60 :: LSTM 40 60 -> S ('D1 60) -> S ('D1 40) -> (S ('D1 60), S ('D1 60))
40+testRun60 = runRecurrentForwards
41+
42+testRun60' :: LSTM 40 60 -> S ('D1 60) -> S ('D1 40) -> S ('D1 60) -> S ('D1 60) -> (Gradient (LSTM 40 60), S ('D1 60), S ('D1 40))
43+testRun60' = runRecurrentBackwards
44+
45+testRun512 :: LSTM 40 512 -> S ('D1 512) -> S ('D1 40) -> (S ('D1 512), S ('D1 512))
46+testRun512 = runRecurrentForwards
47+
48+testRun512' :: LSTM 40 512 -> S ('D1 512) -> S ('D1 40) -> S ('D1 512) -> S ('D1 512) -> (Gradient (LSTM 40 512), S ('D1 512), S ('D1 40))
49+testRun512' = runRecurrentBackwards
50+
51+uncurry4 :: (t -> t1 -> t2 -> t3 -> t4) -> (t, t1, t2, t3) -> t4
52+uncurry4 f (a,b,c,d) = f a b c d
53+
54+uncurry3 :: (t -> t1 -> t2 -> t3) -> (t, t1, t2) -> t3
55+uncurry3 f (a,b,c) = f a b c
56+
57+nfT2 :: (a, b) -> (a, b)
58+nfT2 (!a, !b) = (a, b)
59+
60+nfT3 :: (a, b, c) -> (b, c)
61+nfT3 (!_, !b, !c) = (b, c)
62+
63+
64+type F = FeedForward
65+type R = Recurrent
66+type RecNet = RecurrentNetwork '[ R (LSTM 40 512), R (LSTM 512 40), F (FullyConnected 40 40), F Logit]
67+ '[ 'D1 40, 'D1 512, 'D1 40, 'D1 40, 'D1 40 ]
68+
69+type RecInput = RecurrentInputs '[ R (LSTM 40 512), R (LSTM 512 40), F (FullyConnected 40 40), F Logit]
70+
71+lp :: LearningParameters
72+lp = LearningParameters 0.1 0 0