on master help sign in
Merge pull request #44 from HuwCampbell/topic/bumps

Bump hedgehog and criterion

commitc03fcb63e9ea20551c96099f385b64a25c2e11d8 authorHuw Campbell <huw.campbell@gmail.com> dateThu 14 Dec 2017, 22:50 (9 years ago) parenta8ffdbccbefe61
10 files changed+29−45
README.md+3−1 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+4−21 test/Test/Hedgehog/Hmatrix.hs+4−3 test/Test/Hedgehog/TypeLits.hs+6−5
README.md+3−1
@@ -3,6 +3,7 @@ Grenade
33
44[![Build Status](https://api.travis-ci.org/HuwCampbell/grenade.svg?branch=master)](https://travis-ci.org/HuwCampbell/grenade)
55[![Hackage page (downloads and API reference)][hackage-png]][hackage]
6+[![Hackage-Deps][hackage-deps-png]][hackage-deps]
67
78
89```
@@ -187,4 +188,5 @@ Contributions are welcome.
187188
188189 [hackage]: http://hackage.haskell.org/package/grenade
189190 [hackage-png]: http://img.shields.io/hackage/v/grenade.svg
190−
191+ [hackage-deps]: http://packdeps.haskellers.com/reverse/grenade
192+ [hackage-deps-png]: https://img.shields.io/hackage-deps/v/grenade.svg
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+4−21
@@ -3,36 +3,19 @@ module Test.Hedgehog.Compat (
33 (...)
44 , choose
55 , blindForAll
6− , semiBlindForAll
7− , forAllRender
86 )where
97
10−import Control.Monad.Trans.Class (MonadTrans(..))
11−
8+import Hedgehog (Gen)
129import qualified Hedgehog.Gen as Gen
1310import qualified Hedgehog.Range as Range
1411import Hedgehog.Internal.Property
15−import Hedgehog.Internal.Source
16−import Hedgehog.Internal.Show
1712
1813(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
1914(...) = (.) . (.)
2015{-# INLINE (...) #-}
2116
22−choose :: ( Monad m, Integral a ) => a -> a -> Gen.Gen m a
17+choose :: Integral a => a -> a -> Gen a
2318choose = Gen.integral ... Range.constant
2419
25−blindForAll :: Monad m => Gen.Gen m a -> Test m a
26−blindForAll = Test . lift . lift
27−
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
33−
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
20+blindForAll :: Monad m => Gen a -> PropertyT m a
21+blindForAll = forAllWith (const "blind")
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