c03fcb6 · grenade · git.iko.soy

README.md+3−1

@@ -3,6 +3,7 @@ Grenade

3

4[![Build Status](https://api.travis-ci.org/HuwCampbell/grenade.svg?branch=master)](https://travis-ci.org/HuwCampbell/grenade)

5[![Hackage page (downloads and API reference)][hackage-png]][hackage]

6+[![Hackage-Deps][hackage-deps-png]][hackage-deps]

6

7

8

8```

9```

@@ -187,4 +188,5 @@ Contributions are welcome.

187

188

188 [hackage]: http://hackage.haskell.org/package/grenade

189 [hackage]: http://hackage.haskell.org/package/grenade

189 [hackage-png]: http://img.shields.io/hackage/v/grenade.svg

190 [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

150 build-depends:

151 base >= 4.8 && < 5

152 , grenade

153− , hedgehog >= 0.4 && < 0.5

153+ , hedgehog >= 0.5 && < 0.6

154 , hmatrix

155 , mtl

156 , singletons

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

178 build-depends:

179 base >= 3 && < 5

180 , bytestring == 0.10.*

181− , criterion == 1.1.*

181+ , criterion >= 1.1 && < 1.3

182 , grenade

183 , hmatrix

184

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

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

39 , KnownNat strideColumns

40 , KnownNat kernelFlattened

41 , 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)

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

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

45

44

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

45+genOpaqueOpaqueConvolution :: Gen OpaqueConvolution

47genOpaqueOpaqueConvolution = do

46genOpaqueOpaqueConvolution = do

48 channels <- genNat

47 channels <- genNat

49 filters <- genNat

48 filters <- genNat

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

59 p2 = natDict pkc

58 p2 = natDict pkc

60 p3 = natDict pch

59 p3 = natDict pch

61 in case p1 %* p2 %* p3 of

60 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))

63

62

64prop_conv_net_witness = property $

63prop_conv_net_witness = property $

65 blindForAll genOpaqueOpaqueConvolution >>= \onet ->

64 blindForAll genOpaqueOpaqueConvolution >>= \onet ->

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

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

26instance Show OpaqueFullyConnected where

27 show (OpaqueFullyConnected n) = show n

28

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

29+genOpaqueFullyConnected :: Gen OpaqueFullyConnected

30genOpaqueFullyConnected = do

31 input :: Integer <- choose 2 100

32 output :: Integer <- choose 1 100

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

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

13import Grenade.Layers.Pooling

14

15import Hedgehog

16−import qualified Hedgehog.Gen as Gen

17

16

18import Test.Hedgehog.Compat

17import Test.Hedgehog.Compat

19

18

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

23instance Show OpaquePooling where

22instance Show OpaquePooling where

24 show (OpaquePooling n) = show n

23 show (OpaquePooling n) = show n

25

24

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

25+genOpaquePooling :: Gen OpaquePooling

27genOpaquePooling = do

26genOpaquePooling = do

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

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

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

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

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

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

53--

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

55-- in a SomeNetwork.

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

56+genNetwork :: Gen SomeNetwork

57genNetwork =

58 Gen.recursive Gen.choice [

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

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

438 result ~~~ expected

439

440-- 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)

442oneUp =

443 case ( sing :: Sing shape ) of

444 D1Sing SNat ->

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

482maxVal ( S2D x ) = norm_Inf x

483maxVal ( S3D x ) = norm_Inf x

484

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

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

486(~~~) x y =

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

488 success

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

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

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

12

13import Hedgehog

14−import qualified Hedgehog.Gen as Gen

15import Hedgehog.Internal.Source

14import Hedgehog.Internal.Source

16import Hedgehog.Internal.Show

15import Hedgehog.Internal.Show

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

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

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

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

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

30import Test.Hedgehog.Hmatrix

29import Test.Hedgehog.Hmatrix

31

30

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)

33genLSTM = do

32genLSTM = do

34 let w = uniformSample

33 let w = uniformSample

35 u = uniformSample

34 u = uniformSample

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

103 refGradients = Reference.runLSTMbackOnCell refInput refNet refCell

102 refGradients = Reference.runLSTMbackOnCell refInput refNet refCell

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

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

105

104

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 ()

107(~~~) x y =

106(~~~) x y =

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

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

109 success

108 success

test/Test/Hedgehog/Compat.hs+4−21

@@ -3,36 +3,19 @@ module Test.Hedgehog.Compat (

3 (...)

4 , choose

5 , blindForAll

6− , semiBlindForAll

7− , forAllRender

8 )where

6 )where

9

7

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

8+import Hedgehog (Gen)

11−

12import qualified Hedgehog.Gen as Gen

9import qualified Hedgehog.Gen as Gen

13import qualified Hedgehog.Range as Range

10import qualified Hedgehog.Range as Range

14import Hedgehog.Internal.Property

11import Hedgehog.Internal.Property

15−import Hedgehog.Internal.Source

16−import Hedgehog.Internal.Show

17

12

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

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

19(...) = (.) . (.)

14(...) = (.) . (.)

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

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

21

16

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

17+choose :: Integral a => a -> a -> Gen a

23choose = Gen.integral ... Range.constant

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

24

19

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

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

26−blindForAll = Test . lift . lift

21+blindForAll = forAllWith (const "blind")

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

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

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

9import Data.Singletons

10import Data.Singletons.TypeLits

11

12+import Hedgehog (Gen)

12import qualified Hedgehog.Gen as Gen

13import qualified Hedgehog.Gen as Gen

13import qualified Hedgehog.Range as Range

14import qualified Hedgehog.Range as Range

14

15

15import qualified Numeric.LinearAlgebra.Static as HStatic

16import qualified Numeric.LinearAlgebra.Static as HStatic

16

17

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)

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

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

19

20

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)

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

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

22

23

23-- | Generate random data of the desired shape

24-- | 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)

25genOfShape =

26genOfShape =

26 case (sing :: Sing x) of

27 case (sing :: Sing x) of

27 D1Sing l ->

28 D1Sing l ->

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

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

13#endif

14import Data.Singletons

15

16+import Hedgehog (Gen)

16import qualified Hedgehog.Gen as Gen

17import qualified Hedgehog.Gen as Gen

17

18

18import Grenade

19import Grenade

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

21import GHC.TypeLits.Witnesses

22import GHC.TypeLits.Witnesses

22import Test.Hedgehog.Compat

23import Test.Hedgehog.Compat

23

24

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

25+genNat :: Gen SomeNat

25genNat = do

26genNat = do

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

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

27 return n

28 return n

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

32type Shape' = Shape

33type Shape' = Shape

33#endif

34#endif

34

35

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

36+genShape :: Gen (SomeSing Shape')

36genShape

37genShape

37 = Gen.choice [

38 = Gen.choice [

38 genD1

39 genD1

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

40 , genD3

41 , genD3

41 ]

42 ]

42

43

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

44+genD1 :: Gen (SomeSing Shape')

44genD1 = do

45genD1 = do

45 n <- genNat

46 n <- genNat

46 return $ case n of

47 return $ case n of

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

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

48

49

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

50+genD2 :: Gen (SomeSing Shape')

50genD2 = do

51genD2 = do

51 n <- genNat

52 n <- genNat

52 m <- genNat

53 m <- genNat

53 return $ case (n, m) of

54 return $ case (n, m) of

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

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

55

56

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

57+genD3 :: Gen (SomeSing Shape')

57genD3 = do

58genD3 = do

58 n <- genNat

59 n <- genNat

59 m <- genNat

60 m <- genNat