git.iko.soy/grenade
on master help sign in
Use a blinded forAll for proxy like generators.

This is a bit ironic, as the Typable constraint only exists for 7.10 printing in hedgehog, but the 7.10 proxies don't have typeable.

commit6c6e706e6662b5745cf1014d004d9d86b44bfe1c authorHuw Campbell <huw.campbell@ambiata.com> dateMon 10 Apr 2017, 12:37 (10 years ago) parentadf7312
4 files changed+15−18
compare with master
unifiedsplit
test/Test/Grenade/Layers/Convolution.hs+3−3 test/Test/Grenade/Layers/FullyConnected.hs+3−4 test/Test/Grenade/Layers/Nonlinear.hs+3−11 test/Test/Jack/Compat.hs+6
test/Test/Grenade/Layers/Convolution.hs+3−3
@@ -61,13 +61,13 @@ genOpaqueOpaqueConvolution = do
6161 Dict -> OpaqueConvolution <$> (genConvolution :: Jack (Convolution ch fl kr kc sr sc))
6262
6363prop_conv_net_witness = property $
64− forAll genOpaqueOpaqueConvolution >>= \onet ->
64+ blindForAll genOpaqueOpaqueConvolution >>= \onet ->
6565 case onet of
6666 (OpaqueConvolution ((Convolution _ _) :: Convolution channels filters kernelRows kernelCols strideRows strideCols)) -> success
6767
6868
6969prop_conv_net = property $
70− forAll genOpaqueOpaqueConvolution >>= \onet ->
70+ blindForAll genOpaqueOpaqueConvolution >>= \onet ->
7171 case onet of
7272 (OpaqueConvolution (convLayer@(Convolution _ _) :: Convolution channels filters kernelRows kernelCols strideRows strideCols)) ->
7373 let ok stride kernel = [extent | extent <- [(kernel + 1) .. 30 ], (extent - kernel) `mod` stride == 0]
@@ -92,7 +92,7 @@ prop_conv_net = property $
9292 , (unsafeCoerce (Dict :: Dict ()) :: Dict (((outRows - 1) * strideRows) ~ (inRows - kernelRows)))
9393 , (unsafeCoerce (Dict :: Dict ()) :: Dict (((outCols - 1) * strideCols) ~ (inCols - kernelCols)))) of
9494 (Dict, Dict, Dict, Dict) ->
95− forAll (S3D <$> uniformSample) >>= \(input :: S ('D3 inRows inCols channels)) ->
95+ blindForAll (S3D <$> uniformSample) >>= \(input :: S ('D3 inRows inCols channels)) ->
9696 let (tape, output :: S ('D3 outRows outCols filters)) = runForwards convLayer input
9797 backed :: (Gradient (Convolution channels filters kernelRows kernelCols strideRows strideCols), S ('D3 inRows inCols channels))
9898 = runBackwards convLayer tape output
test/Test/Grenade/Layers/FullyConnected.hs+3−4
@@ -17,9 +17,8 @@ import Grenade.Layers.FullyConnected
1717
1818import Hedgehog
1919
20−import Test.Jack.Hmatrix
2120import Test.Jack.Compat
22−
21+import Test.Jack.Hmatrix
2322
2423data OpaqueFullyConnected :: * where
2524 OpaqueFullyConnected :: (KnownNat i, KnownNat o) => FullyConnected i o -> OpaqueFullyConnected
@@ -43,8 +42,8 @@ genOpaqueFullyConnected = do
4342
4443prop_fully_connected_forwards :: Property
4544prop_fully_connected_forwards = property $ do
46− OpaqueFullyConnected (fclayer :: FullyConnected i o) <- forAll genOpaqueFullyConnected
47− input :: S ('D1 i) <- forAll (S1D <$> randomVector)
45+ OpaqueFullyConnected (fclayer :: FullyConnected i o) <- blindForAll genOpaqueFullyConnected
46+ input :: S ('D1 i) <- blindForAll (S1D <$> randomVector)
4847 let (tape, output :: S ('D1 o)) = runForwards fclayer input
4948 backed :: (Gradient (FullyConnected i o), S ('D1 i))
5049 = runBackwards fclayer tape output
test/Test/Grenade/Layers/Nonlinear.hs+3−11
@@ -9,9 +9,6 @@
99{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
1010module Test.Grenade.Layers.Nonlinear where
1111
12−
13−import Control.Monad.Trans.Class (MonadTrans(..))
14−
1512import Data.Singletons
1613
1714#if __GLASGOW_HASKELL__ < 800
@@ -22,18 +19,13 @@ import Grenade
2219import GHC.TypeLits
2320
2421import Hedgehog
25−import Hedgehog.Internal.Property ( Test (..) )
2622
23+import Test.Jack.Compat
2724import Test.Jack.Hmatrix
2825import Test.Jack.TypeLits
2926
3027import Numeric.LinearAlgebra.Static ( norm_Inf )
3128
32−-- | Generates a random input for the test by running the provided generator.
33−--
34−blindForAll :: Monad m => Gen m a -> Test m a
35−blindForAll = Test . lift . lift
36−
3729prop_sigmoid_grad :: Property
3830prop_sigmoid_grad = property $
3931 blindForAll genShape >>= \case
@@ -66,9 +58,9 @@ prop_tanh_grad = property $
6658
6759prop_softmax_grad :: Property
6860prop_softmax_grad = property $
69− forAll genNat >>= \case
61+ blindForAll genNat >>= \case
7062 (SomeNat (_ :: Proxy s)) ->
71− forAll genOfShape >>= \(ds :: S ('D1 s)) ->
63+ blindForAll genOfShape >>= \(ds :: S ('D1 s)) ->
7264 let (tape, f :: S ('D1 s)) = runForwards Relu ds
7365 ((), ret :: S ('D1 s)) = runBackwards Relu tape (1 :: S ('D1 s))
7466 (_, numer :: S ('D1 s)) = runForwards Relu (ds + 0.0001)
test/Test/Jack/Compat.hs+6
@@ -1,9 +1,12 @@
11{-# LANGUAGE RankNTypes #-}
22module Test.Jack.Compat where
33
4+import Control.Monad.Trans.Class (MonadTrans(..))
5+
46import Hedgehog
57import qualified Hedgehog.Gen as Gen
68import qualified Hedgehog.Range as Range
9+import Hedgehog.Internal.Property ( Test (..) )
710
811type Jack x = forall m. Monad m => Gen m x
912
@@ -14,3 +17,6 @@ type Jack x = forall m. Monad m => Gen m x
1417choose :: Integral a => a -> a -> Jack a
1518choose = Gen.integral ... Range.constant
1619
20+-- | Generates a random input for the test by running the provided generator.
21+blindForAll :: Monad m => Gen m a -> Test m a
22+blindForAll = Test . lift . lift