@@ -10,7 +10,7 @@
1010{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
1111module Test.Grenade.Recurrent.Layers.LSTM where
1212
13−import Disorder.Jack
13+import Hedgehog
1414
1515import Data.Foldable ( toList )
1616import Data.Singletons.TypeLits
@@ -24,6 +24,7 @@ import qualified Numeric.LinearAlgebra.Static as S
2424
2525import qualified Test.Grenade.Recurrent.Layers.LSTM.Reference as Reference
2626import Test.Jack.Hmatrix
27+import Test.Jack.Compat
2728
2829genLSTM :: forall i o. (KnownNat i, KnownNat o) => Jack (LSTM i o)
2930genLSTM = do
@@ -39,63 +40,69 @@ genLSTM = do
3940 <*> pure (LSTMWeights w0 u0 v0 w0 u0 v0 w0 u0 v0 w0 v0)
4041
4142prop_lstm_reference_forwards =
42− gamble randomVector $ \(input :: S.R 3) ->
43− gamble randomVector $ \(cell :: S.R 2) ->
44− gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->
45− let actual = runRecurrentForwards net (S1D cell) (S1D input)
46− in case actual of
47− (_, (S1D cellOut) :: S ('D1 2), (S1D output) :: S ('D1 2)) ->
48− let cellOut' = Reference.Vector . H.toList . S.extract $ cellOut
49− output' = Reference.Vector . H.toList . S.extract $ output
50− refNet = Reference.lstmToReference lstmWeights
51− refCell = Reference.Vector . H.toList . S.extract $ cell
52− refInput = Reference.Vector . H.toList . S.extract $ input
53− (refCO, refO) = Reference.runLSTM refNet refCell refInput
54− in toList refCO ~~~ toList cellOut' .&&. toList refO ~~~ toList output'
43+ property $ do
44+ input :: S.R 3 <- forAll randomVector
45+ cell :: S.R 2 <- forAll randomVector
46+ net@(LSTM lstmWeights _) :: LSTM 3 2 <- forAll genLSTM
47+
48+ let actual = runRecurrentForwards net (S1D cell) (S1D input)
49+ case actual of
50+ (_, (S1D cellOut) :: S ('D1 2), (S1D output) :: S ('D1 2)) ->
51+ let cellOut' = Reference.Vector . H.toList . S.extract $ cellOut
52+ output' = Reference.Vector . H.toList . S.extract $ output
53+ refNet = Reference.lstmToReference lstmWeights
54+ refCell = Reference.Vector . H.toList . S.extract $ cell
55+ refInput = Reference.Vector . H.toList . S.extract $ input
56+ (refCO, refO) = Reference.runLSTM refNet refCell refInput
57+ in do assert (toList refCO ~~~ toList cellOut')
58+ assert (toList refO ~~~ toList output')
59+
5560
5661prop_lstm_reference_backwards =
57− gamble randomVector $ \(input :: S.R 3) ->
58− gamble randomVector $ \(cell :: S.R 2) ->
59− gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->
60− let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))
61− in case actualBacks of
62− (actualGradients, _, _ :: S ('D1 3)) ->
63− let refNet = Reference.lstmToReference lstmWeights
64− refCell = Reference.Vector . H.toList . S.extract $ cell
65− refInput = Reference.Vector . H.toList . S.extract $ input
66− refGradients = Reference.runLSTMback refCell refInput refNet
67− in toList refGradients ~~~ toList (Reference.lstmToReference actualGradients)
62+ property $ do
63+ input :: S.R 3 <- forAll randomVector
64+ cell :: S.R 2 <- forAll randomVector
65+ net@(LSTM lstmWeights _) :: LSTM 3 2 <- forAll genLSTM
66+ let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))
67+ case actualBacks of
68+ (actualGradients, _, _ :: S ('D1 3)) ->
69+ let refNet = Reference.lstmToReference lstmWeights
70+ refCell = Reference.Vector . H.toList . S.extract $ cell
71+ refInput = Reference.Vector . H.toList . S.extract $ input
72+ refGradients = Reference.runLSTMback refCell refInput refNet
73+ in assert $ toList refGradients ~~~ toList (Reference.lstmToReference actualGradients)
6874
6975prop_lstm_reference_backwards_input =
70− gamble randomVector $ \(input :: S.R 3) ->
71− gamble randomVector $ \(cell :: S.R 2) ->
72− gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->
73− let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))
74− in case actualBacks of
75− (_, _, S1D actualGradients :: S ('D1 3)) ->
76− let refNet = Reference.lstmToReference lstmWeights
77− refCell = Reference.Vector . H.toList . S.extract $ cell
78− refInput = Reference.Vector . H.toList . S.extract $ input
79− refGradients = Reference.runLSTMbackOnInput refCell refNet refInput
80− in toList refGradients ~~~ H.toList (S.extract actualGradients)
76+ property $ do
77+ input :: S.R 3 <- forAll randomVector
78+ cell :: S.R 2 <- forAll randomVector
79+ net@(LSTM lstmWeights _) :: LSTM 3 2 <- forAll genLSTM
80+ let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))
81+ case actualBacks of
82+ (_, _, S1D actualGradients :: S ('D1 3)) ->
83+ let refNet = Reference.lstmToReference lstmWeights
84+ refCell = Reference.Vector . H.toList . S.extract $ cell
85+ refInput = Reference.Vector . H.toList . S.extract $ input
86+ refGradients = Reference.runLSTMbackOnInput refCell refNet refInput
87+ in assert $ toList refGradients ~~~ H.toList (S.extract actualGradients)
8188
8289prop_lstm_reference_backwards_cell =
83− gamble randomVector $ \(input :: S.R 3) ->
84− gamble randomVector $ \(cell :: S.R 2) ->
85− gamble genLSTM $ \(net@(LSTM lstmWeights _) :: LSTM 3 2) ->
86− let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))
87− in case actualBacks of
88− (_, S1D actualGradients, _ :: S ('D1 3)) ->
89− let refNet = Reference.lstmToReference lstmWeights
90− refCell = Reference.Vector . H.toList . S.extract $ cell
91− refInput = Reference.Vector . H.toList . S.extract $ input
92− refGradients = Reference.runLSTMbackOnCell refInput refNet refCell
93− in toList refGradients ~~~ H.toList (S.extract actualGradients)
90+ property $ do
91+ input :: S.R 3 <- forAll randomVector
92+ cell :: S.R 2 <- forAll randomVector
93+ net@(LSTM lstmWeights _) :: LSTM 3 2 <- forAll genLSTM
94+ let actualBacks = runRecurrentBackwards net (S1D cell, S1D input) (S1D (S.konst 1) :: S ('D1 2)) (S1D (S.konst 1) :: S ('D1 2))
95+ case actualBacks of
96+ (_, S1D actualGradients, _ :: S ('D1 3)) ->
97+ let refNet = Reference.lstmToReference lstmWeights
98+ refCell = Reference.Vector . H.toList . S.extract $ cell
99+ refInput = Reference.Vector . H.toList . S.extract $ input
100+ refGradients = Reference.runLSTMbackOnCell refInput refNet refCell
101+ in assert $ toList refGradients ~~~ H.toList (S.extract actualGradients)
94102
95103
96104(~~~) as bs = all (< 1e-8) (zipWith (-) as bs)
97105infix 4 ~~~
98106
99−return []
100107tests :: IO Bool
101−tests = $quickCheckAll
108+tests = $$(checkConcurrent)