@@ -11,6 +11,9 @@
1111module Test.Grenade.Recurrent.Layers.LSTM where
1212
1313import Hedgehog
14+import Hedgehog.Internal.Source
15+import Hedgehog.Internal.Show
16+import Hedgehog.Internal.Property ( failWith, Diff (..) )
1417
1518import Data.Foldable ( toList )
1619import Data.Singletons.TypeLits
@@ -54,8 +57,8 @@ prop_lstm_reference_forwards =
5457 refCell = Reference.Vector . H.toList . S.extract $ cell
5558 refInput = Reference.Vector . H.toList . S.extract $ input
5659 (refCO, refO) = Reference.runLSTM refNet refCell refInput
57− in do assert (toList refCO ~~~ toList cellOut')
58− assert (toList refO ~~~ toList output')
60+ in do toList refCO ~~~ toList cellOut'
61+ toList refO ~~~ toList output'
5962
6063
6164prop_lstm_reference_backwards =
@@ -70,7 +73,7 @@ prop_lstm_reference_backwards =
7073 refCell = Reference.Vector . H.toList . S.extract $ cell
7174 refInput = Reference.Vector . H.toList . S.extract $ input
7275 refGradients = Reference.runLSTMback refCell refInput refNet
73− in assert $ toList refGradients ~~~ toList (Reference.lstmToReference actualGradients)
76+ in toList refGradients ~~~ toList (Reference.lstmToReference actualGradients)
7477
7578prop_lstm_reference_backwards_input =
7679 property $ do
@@ -84,7 +87,7 @@ prop_lstm_reference_backwards_input =
8487 refCell = Reference.Vector . H.toList . S.extract $ cell
8588 refInput = Reference.Vector . H.toList . S.extract $ input
8689 refGradients = Reference.runLSTMbackOnInput refCell refNet refInput
87− in assert $ toList refGradients ~~~ H.toList (S.extract actualGradients)
90+ in toList refGradients ~~~ H.toList (S.extract actualGradients)
8891
8992prop_lstm_reference_backwards_cell =
9093 property $ do
@@ -98,11 +101,26 @@ prop_lstm_reference_backwards_cell =
98101 refCell = Reference.Vector . H.toList . S.extract $ cell
99102 refInput = Reference.Vector . H.toList . S.extract $ input
100103 refGradients = Reference.runLSTMbackOnCell refInput refNet refCell
101− in assert $ toList refGradients ~~~ H.toList (S.extract actualGradients)
102−
103−
104−(~~~) as bs = all (< 1e-8) (zipWith (-) as bs)
104+ in toList refGradients ~~~ H.toList (S.extract actualGradients)
105+
106+(~~~) :: (Monad m, Eq a, Ord a, Num a, Fractional a, Show a, HasCallStack) => [a] -> [a] -> Test m ()
107+(~~~) x y =
108+ if all (< 1e-8) (zipWith (-) x y) then
109+ success
110+ else
111+ case valueDiff <$> mkValue x <*> mkValue y of
112+ Nothing ->
113+ withFrozenCallStack $
114+ failWith Nothing $ unlines [
115+ "━━━ Not Simliar ━━━"
116+ , showPretty x
117+ , showPretty y
118+ ]
119+ Just diff ->
120+ withFrozenCallStack $
121+ failWith (Just $ Diff "Failed (" "- lhs" "~/~" "+ rhs" ")" diff) ""
105122infix 4 ~~~
106123
124+
107125tests :: IO Bool
108126tests = $$(checkConcurrent)