6e43a16 · grenade · git.iko.soy

git.iko.soy/grenade

Bump hedgehog and criterion

commit6e43a16a77e2bad6d58ca385e5329717fd73b56a authorHuw Campbell <huw.campbell@ambiata.com> dateThu 14 Dec 2017, 16:05 (9 years ago) parenta8ffdbc

9 files changed+30−39

compare with master

unifiedsplit

grenade.cabal+2−2 test/Test/Grenade/Layers/Convolution.hs+3−4 test/Test/Grenade/Layers/FullyConnected.hs+1−1 test/Test/Grenade/Layers/Pooling.hs+1−2 test/Test/Grenade/Network.hs+3−3 test/Test/Grenade/Recurrent/Layers/LSTM.hs+2−3 test/Test/Hedgehog/Compat.hs+8−16 test/Test/Hedgehog/Hmatrix.hs+4−3 test/Test/Hedgehog/TypeLits.hs+6−5

grenade.cabal+2−2

@@ -150,7 +150,7 @@ test-suite test

150150 build-depends:

151151 base >= 4.8 && < 5

152152 , grenade

153− , hedgehog >= 0.4 && < 0.5

153+ , hedgehog >= 0.5 && < 0.6

154154 , hmatrix

155155 , mtl

156156 , singletons

@@ -178,7 +178,7 @@ benchmark bench

178178 build-depends:

179179 base >= 3 && < 5

180180 , bytestring == 0.10.*

181− , criterion == 1.1.*

181+ , criterion >= 1.1 && < 1.3

182182 , grenade

183183 , hmatrix

184184

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

@@ -39,11 +39,10 @@ genConvolution :: ( KnownNat channels

3939 , KnownNat strideColumns

4040 , KnownNat kernelFlattened

4141 , kernelFlattened ~ (kernelRows * kernelColumns * channels)

42− , Monad m

43− ) => Gen.Gen m (Convolution channels filters kernelRows kernelColumns strideRows strideColumns)

42+ ) => Gen (Convolution channels filters kernelRows kernelColumns strideRows strideColumns)

4443genConvolution = Convolution <$> uniformSample <*> uniformSample

4544

46−genOpaqueOpaqueConvolution :: Monad m => Gen m OpaqueConvolution

45+genOpaqueOpaqueConvolution :: Gen OpaqueConvolution

4746genOpaqueOpaqueConvolution = do

4847 channels <- genNat

4948 filters <- genNat

@@ -59,7 +58,7 @@ genOpaqueOpaqueConvolution = do

5958 p2 = natDict pkc

6059 p3 = natDict pch

6160 in case p1 %* p2 %* p3 of

62− Dict -> OpaqueConvolution <$> (genConvolution :: Monad n => Gen n (Convolution ch fl kr kc sr sc))

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

6362

6463prop_conv_net_witness = property $

6564 blindForAll genOpaqueOpaqueConvolution >>= \onet ->

test/Test/Grenade/Layers/FullyConnected.hs+1−1

@@ -26,7 +26,7 @@ data OpaqueFullyConnected :: * where

2626instance Show OpaqueFullyConnected where

2727 show (OpaqueFullyConnected n) = show n

2828

29−genOpaqueFullyConnected :: Monad m => Gen m OpaqueFullyConnected

29+genOpaqueFullyConnected :: Gen OpaqueFullyConnected

3030genOpaqueFullyConnected = do

3131 input :: Integer <- choose 2 100

3232 output :: Integer <- choose 1 100

test/Test/Grenade/Layers/Pooling.hs+1−2

@@ -13,7 +13,6 @@ import GHC.TypeLits

1313import Grenade.Layers.Pooling

1414

1515import Hedgehog

16−import qualified Hedgehog.Gen as Gen

1716

1817import Test.Hedgehog.Compat

1918

@@ -23,7 +22,7 @@ data OpaquePooling :: * where

2322instance Show OpaquePooling where

2423 show (OpaquePooling n) = show n

2524

26−genOpaquePooling :: Monad m => Gen.Gen m OpaquePooling

25+genOpaquePooling :: Gen OpaquePooling

2726genOpaquePooling = do

2827 Just kernelHeight <- someNatVal <$> choose 2 15

2928 Just kernelWidth <- someNatVal <$> choose 2 15

test/Test/Grenade/Network.hs+3−3

@@ -53,7 +53,7 @@ instance Show SomeNetwork where

5353--

5454-- This is slightly insane for a few reasons. Everything must be wrapped up

5555-- in a SomeNetwork.

56−genNetwork :: Monad m => Gen.Gen m SomeNetwork

56+genNetwork :: Gen SomeNetwork

5757genNetwork =

5858 Gen.recursive Gen.choice [

5959 do SomeSing ( r :: Sing final ) <- genShape

@@ -438,7 +438,7 @@ prop_auto_diff = withDiscards 1000 . withTests 10000 . property $ do

438438 result ~~~ expected

439439

440440-- Make a shape where all are 0 except for 1 value, which is 1.

441−oneUp :: forall shape m. ( Monad m, SingI shape ) => Gen.Gen m (S shape)

441+oneUp :: forall shape. ( SingI shape ) => Gen (S shape)

442442oneUp =

443443 case ( sing :: Sing shape ) of

444444 D1Sing SNat ->

@@ -482,7 +482,7 @@ maxVal ( S1D x ) = norm_Inf x

482482maxVal ( S2D x ) = norm_Inf x

483483maxVal ( S3D x ) = norm_Inf x

484484

485−(~~~) :: (Monad m, HasCallStack) => Double -> Double -> Test m ()

485+(~~~) :: (Monad m, HasCallStack) => Double -> Double -> PropertyT m ()

486486(~~~) x y =

487487 if abs (x - y) < 2e-5 then

488488 success

test/Test/Grenade/Recurrent/Layers/LSTM.hs+2−3

@@ -11,7 +11,6 @@

1111module Test.Grenade.Recurrent.Layers.LSTM where

1212

1313import Hedgehog

14−import qualified Hedgehog.Gen as Gen

1514import Hedgehog.Internal.Source

1615import Hedgehog.Internal.Show

1716import Hedgehog.Internal.Property ( failWith, Diff (..) )

@@ -29,7 +28,7 @@ import qualified Numeric.LinearAlgebra.Static as S

2928import qualified Test.Grenade.Recurrent.Layers.LSTM.Reference as Reference

3029import Test.Hedgehog.Hmatrix

3130

32−genLSTM :: forall i o m. (KnownNat i, KnownNat o, Monad m) => Gen.Gen m (LSTM i o)

31+genLSTM :: forall i o. (KnownNat i, KnownNat o) => Gen (LSTM i o)

3332genLSTM = do

3433 let w = uniformSample

3534 u = uniformSample

@@ -103,7 +102,7 @@ prop_lstm_reference_backwards_cell =

103102 refGradients = Reference.runLSTMbackOnCell refInput refNet refCell

104103 in toList refGradients ~~~ H.toList (S.extract actualGradients)

105104

106−(~~~) :: (Monad m, Eq a, Ord a, Num a, Fractional a, Show a, HasCallStack) => [a] -> [a] -> Test m ()

105+(~~~) :: (Monad m, Eq a, Ord a, Num a, Fractional a, Show a, HasCallStack) => [a] -> [a] -> PropertyT m ()

107106(~~~) x y =

108107 if all (< 1e-8) (zipWith (-) x y) then

109108 success

test/Test/Hedgehog/Compat.hs+8−16

@@ -7,32 +7,24 @@ module Test.Hedgehog.Compat (

77 , forAllRender

88 )where

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

11−

10+import Hedgehog (Gen)

1211import qualified Hedgehog.Gen as Gen

1312import qualified Hedgehog.Range as Range

1413import Hedgehog.Internal.Property

1514import Hedgehog.Internal.Source

16−import Hedgehog.Internal.Show

1715

1816(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d

1917(...) = (.) . (.)

2018{-# INLINE (...) #-}

2119

22−choose :: ( Monad m, Integral a ) => a -> a -> Gen.Gen m a

20+choose :: ( Integral a ) => a -> a -> Gen a

2321choose = Gen.integral ... Range.constant

2422

25−blindForAll :: Monad m => Gen.Gen m a -> Test m a

26−blindForAll = Test . lift . lift

23+blindForAll :: Monad m => Gen a -> PropertyT m a

24+blindForAll = forAllWith (const "blind")

2725

28−semiBlindForAll :: (Monad m, Show a, HasCallStack) => Gen.Gen m a -> Test m a

29−semiBlindForAll gen = do

30− x <- Test . lift $ lift gen

31− withFrozenCallStack $ annotate (showPretty x)

32− return x

26+semiBlindForAll :: (Monad m, Show a, HasCallStack) => Gen a -> PropertyT m a

27+semiBlindForAll = forAllWith (const "blind")

3328

34−forAllRender :: (Monad m, HasCallStack) => ( a -> String ) -> Gen.Gen m a -> Test m a

35−forAllRender render gen = do

36− x <- Test . lift $ lift gen

37− withFrozenCallStack $ footnote (render x)

38− return x

29+forAllRender :: (Monad m, HasCallStack) => ( a -> String ) -> Gen a -> PropertyT m a

30+forAllRender render gen = forAllWith render gen

test/Test/Hedgehog/Hmatrix.hs+4−3

@@ -9,19 +9,20 @@ import Grenade

99import Data.Singletons

1010import Data.Singletons.TypeLits

1111

12+import Hedgehog (Gen)

1213import qualified Hedgehog.Gen as Gen

1314import qualified Hedgehog.Range as Range

1415

1516import qualified Numeric.LinearAlgebra.Static as HStatic

1617

17−randomVector :: forall m n. ( Monad m, KnownNat n ) => Gen.Gen m (HStatic.R n)

18+randomVector :: forall n. ( KnownNat n ) => Gen (HStatic.R n)

1819randomVector = (\s -> HStatic.randomVector s HStatic.Uniform * 2 - 1) <$> Gen.int Range.linearBounded

1920

20−uniformSample :: forall mm m n. ( Monad mm, KnownNat m, KnownNat n ) => Gen.Gen mm (HStatic.L m n)

21+uniformSample :: forall m n. ( KnownNat m, KnownNat n ) => Gen (HStatic.L m n)

2122uniformSample = (\s -> HStatic.uniformSample s (-1) 1 ) <$> Gen.int Range.linearBounded

2223

2324-- | Generate random data of the desired shape

24−genOfShape :: forall m x. ( Monad m, SingI x ) => Gen.Gen m (S x)

25+genOfShape :: forall x. ( SingI x ) => Gen (S x)

2526genOfShape =

2627 case (sing :: Sing x) of

2728 D1Sing l ->

test/Test/Hedgehog/TypeLits.hs+6−5

@@ -13,6 +13,7 @@ import Data.Proxy

1313#endif

1414import Data.Singletons

1515

16+import Hedgehog (Gen)

1617import qualified Hedgehog.Gen as Gen

1718

1819import Grenade

@@ -21,7 +22,7 @@ import GHC.TypeLits

2122import GHC.TypeLits.Witnesses

2223import Test.Hedgehog.Compat

2324

24−genNat :: Monad m => Gen.Gen m SomeNat

25+genNat :: Gen SomeNat

2526genNat = do

2627 Just n <- someNatVal <$> choose 1 10

2728 return n

@@ -32,7 +33,7 @@ type Shape' = ('KProxy :: KProxy Shape)

3233type Shape' = Shape

3334#endif

3435

35−genShape :: Monad m => Gen.Gen m (SomeSing Shape')

36+genShape :: Gen (SomeSing Shape')

3637genShape

3738 = Gen.choice [

3839 genD1

@@ -40,20 +41,20 @@ genShape

4041 , genD3

4142 ]

4243

43−genD1 :: Monad m => Gen.Gen m (SomeSing Shape')

44+genD1 :: Gen (SomeSing Shape')

4445genD1 = do

4546 n <- genNat

4647 return $ case n of

4748 SomeNat (_ :: Proxy x) -> SomeSing (sing :: Sing ('D1 x))

4849

49−genD2 :: Monad m => Gen.Gen m (SomeSing Shape')

50+genD2 :: Gen (SomeSing Shape')

5051genD2 = do

5152 n <- genNat

5253 m <- genNat

5354 return $ case (n, m) of

5455 (SomeNat (_ :: Proxy x), SomeNat (_ :: Proxy y)) -> SomeSing (sing :: Sing ('D2 x y))

5556

56−genD3 :: Monad m => Gen.Gen m (SomeSing Shape')

57+genD3 :: Gen (SomeSing Shape')

5758genD3 = do

5859 n <- genNat

5960 m <- genNat