6c6e706 · grenade · git.iko.soy

git.iko.soy/grenade

on master help sign in

Use a blinded forAll for proxy like generators.

6c6e706Huw Campbell10 years ago

test/Test/Grenade/Layers/Convolution.hs+3−3

compare with master

unifiedsplit

@@ -61,13 +61,13 @@ genOpaqueOpaqueConvolution = do

61 Dict -> OpaqueConvolution <$> (genConvolution :: Jack (Convolution ch fl kr kc sr sc))

63prop_conv_net_witness = property $

64− forAll genOpaqueOpaqueConvolution >>= \onet ->

64+ blindForAll genOpaqueOpaqueConvolution >>= \onet ->

65 case onet of

66 (OpaqueConvolution ((Convolution _ _) :: Convolution channels filters kernelRows kernelCols strideRows strideCols)) -> success

69prop_conv_net = property $

70− forAll genOpaqueOpaqueConvolution >>= \onet ->

70+ blindForAll genOpaqueOpaqueConvolution >>= \onet ->

71 case onet of

72 (OpaqueConvolution (convLayer@(Convolution _ _) :: Convolution channels filters kernelRows kernelCols strideRows strideCols)) ->

73 let ok stride kernel = [extent | extent <- [(kernel + 1) .. 30 ], (extent - kernel) `mod` stride == 0]

@@ -92,7 +92,7 @@ prop_conv_net = property $

92 , (unsafeCoerce (Dict :: Dict ()) :: Dict (((outRows - 1) * strideRows) ~ (inRows - kernelRows)))

93 , (unsafeCoerce (Dict :: Dict ()) :: Dict (((outCols - 1) * strideCols) ~ (inCols - kernelCols)))) of

94 (Dict, Dict, Dict, Dict) ->

95− forAll (S3D <$> uniformSample) >>= \(input :: S ('D3 inRows inCols channels)) ->

95+ blindForAll (S3D <$> uniformSample) >>= \(input :: S ('D3 inRows inCols channels)) ->

96 let (tape, output :: S ('D3 outRows outCols filters)) = runForwards convLayer input

97 backed :: (Gradient (Convolution channels filters kernelRows kernelCols strideRows strideCols), S ('D3 inRows inCols channels))

98 = runBackwards convLayer tape output

test/Test/Grenade/Layers/FullyConnected.hs+3−4

@@ -17,9 +17,8 @@ import Grenade.Layers.FullyConnected

18import Hedgehog

20−import Test.Jack.Hmatrix

21import Test.Jack.Compat

20import Test.Jack.Compat

22−

21+import Test.Jack.Hmatrix

24data OpaqueFullyConnected :: * where

23data OpaqueFullyConnected :: * where

25 OpaqueFullyConnected :: (KnownNat i, KnownNat o) => FullyConnected i o -> OpaqueFullyConnected

24 OpaqueFullyConnected :: (KnownNat i, KnownNat o) => FullyConnected i o -> OpaqueFullyConnected

@@ -43,8 +42,8 @@ genOpaqueFullyConnected = do

44prop_fully_connected_forwards :: Property

43prop_fully_connected_forwards :: Property

45prop_fully_connected_forwards = property $ do

44prop_fully_connected_forwards = property $ do

46− OpaqueFullyConnected (fclayer :: FullyConnected i o) <- forAll genOpaqueFullyConnected

45+ OpaqueFullyConnected (fclayer :: FullyConnected i o) <- blindForAll genOpaqueFullyConnected

47− input :: S ('D1 i) <- forAll (S1D <$> randomVector)

46+ input :: S ('D1 i) <- blindForAll (S1D <$> randomVector)

48 let (tape, output :: S ('D1 o)) = runForwards fclayer input

47 let (tape, output :: S ('D1 o)) = runForwards fclayer input

49 backed :: (Gradient (FullyConnected i o), S ('D1 i))

48 backed :: (Gradient (FullyConnected i o), S ('D1 i))

50 = runBackwards fclayer tape output

49 = runBackwards fclayer tape output

test/Test/Grenade/Layers/Nonlinear.hs+3−11

@@ -9,9 +9,6 @@

9{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

10module Test.Grenade.Layers.Nonlinear where

12−

13−import Control.Monad.Trans.Class (MonadTrans(..))

14−

15import Data.Singletons

12import Data.Singletons

17#if __GLASGOW_HASKELL__ < 800

14#if __GLASGOW_HASKELL__ < 800

@@ -22,18 +19,13 @@ import Grenade

22import GHC.TypeLits

19import GHC.TypeLits

24import Hedgehog

21import Hedgehog

25−import Hedgehog.Internal.Property ( Test (..) )

23+import Test.Jack.Compat

27import Test.Jack.Hmatrix

24import Test.Jack.Hmatrix

28import Test.Jack.TypeLits

25import Test.Jack.TypeLits

30import Numeric.LinearAlgebra.Static ( norm_Inf )

27import Numeric.LinearAlgebra.Static ( norm_Inf )

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−

37prop_sigmoid_grad :: Property

29prop_sigmoid_grad :: Property

38prop_sigmoid_grad = property $

30prop_sigmoid_grad = property $

39 blindForAll genShape >>= \case

31 blindForAll genShape >>= \case

@@ -66,9 +58,9 @@ prop_tanh_grad = property $

67prop_softmax_grad :: Property

59prop_softmax_grad :: Property

68prop_softmax_grad = property $

60prop_softmax_grad = property $

69− forAll genNat >>= \case

61+ blindForAll genNat >>= \case

70 (SomeNat (_ :: Proxy s)) ->

62 (SomeNat (_ :: Proxy s)) ->

71− forAll genOfShape >>= \(ds :: S ('D1 s)) ->

63+ blindForAll genOfShape >>= \(ds :: S ('D1 s)) ->

72 let (tape, f :: S ('D1 s)) = runForwards Relu ds

64 let (tape, f :: S ('D1 s)) = runForwards Relu ds

73 ((), ret :: S ('D1 s)) = runBackwards Relu tape (1 :: S ('D1 s))

65 ((), ret :: S ('D1 s)) = runBackwards Relu tape (1 :: S ('D1 s))

74 (_, numer :: S ('D1 s)) = runForwards Relu (ds + 0.0001)

66 (_, numer :: S ('D1 s)) = runForwards Relu (ds + 0.0001)

test/Test/Jack/Compat.hs+6

@@ -1,9 +1,12 @@

1{-# LANGUAGE RankNTypes #-}

2module Test.Jack.Compat where

4+import Control.Monad.Trans.Class (MonadTrans(..))

4import Hedgehog

6import Hedgehog

5import qualified Hedgehog.Gen as Gen

7import qualified Hedgehog.Gen as Gen

6import qualified Hedgehog.Range as Range

8import qualified Hedgehog.Range as Range

9+import Hedgehog.Internal.Property ( Test (..) )

8type Jack x = forall m. Monad m => Gen m x

11type Jack x = forall m. Monad m => Gen m x

@@ -14,3 +17,6 @@ type Jack x = forall m. Monad m => Gen m x

14choose :: Integral a => a -> a -> Jack a

17choose :: Integral a => a -> a -> Jack a

15choose = Gen.integral ... Range.constant

18choose = Gen.integral ... Range.constant

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