c2d48a3 · grenade · git.iko.soy

src/Grenade/Core/Network.hs+8−4

compare with master

unifiedsplit

@@ -125,7 +125,8 @@ runNetwork =

125-- Gives the gradients for the layer, and the gradient across the

126-- input (which may not be required).

127--

128−runGradient :: forall layers shapes. Network layers shapes

128+runGradient :: forall layers shapes.

129+ Network layers shapes

129 -> Tapes layers shapes

130 -> Tapes layers shapes

130 -> S (Last shapes)

131 -> S (Last shapes)

131 -> (Gradients layers, S (Head shapes))

132 -> (Gradients layers, S (Head shapes))

@@ -157,10 +158,13 @@ applyUpdate _ NNil GNil

157 = NNil

158 = NNil

158

159

160

160−-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random

161+-- | A network can easily be created by hand with (:~>), but an easy way to

161−-- network is with the randomNetwork.

162+-- initialise a random network is with the randomNetwork.

162class CreatableNetwork (xs :: [*]) (ss :: [Shape]) where

163class CreatableNetwork (xs :: [*]) (ss :: [Shape]) where

163− -- | Create a network of the types requested

164+ -- | Create a network with randomly initialised weights.

165+ --

166+ -- Calls to this function will not compile if the type of the neural

167+ -- network is not sound.

164 randomNetwork :: MonadRandom m => m (Network xs ss)

168 randomNetwork :: MonadRandom m => m (Network xs ss)

165

169

166instance SingI i => CreatableNetwork '[] '[i] where

170instance SingI i => CreatableNetwork '[] '[i] where

test/Test/Grenade/Layers/PadCrop.hsnew file+34

@@ -0,0 +1,34 @@

1+{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE TemplateHaskell #-}

3+{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE KindSignatures #-}

5+{-# LANGUAGE GADTs #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

7+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

8+module Test.Grenade.Layers.PadCrop where

9+

10+import Grenade

11+

12+import Disorder.Jack

13+

14+import Numeric.LinearAlgebra.Static ( norm_Inf )

15+

16+import Test.Jack.Hmatrix

17+

18+prop_pad_crop :: Property

19+prop_pad_crop =

20+ let net :: Network '[Pad 2 3 4 6, Crop 2 3 4 6] '[ 'D3 7 9 5, 'D3 16 15 5, 'D3 7 9 5 ]

21+ net = Pad :~> Crop :~> NNil

22+ in gamble genOfShape $ \(d :: S ('D3 7 9 5)) ->

23+ let (tapes, res) = runForwards net d

24+ (_ , grad) = runBackwards net tapes d

25+ in d ~~~ res .&&. grad ~~~ d

26+

27+(~~~) :: S x -> S x -> Bool

28+(S1D x) ~~~ (S1D y) = norm_Inf (x - y) < 0.00001

29+(S2D x) ~~~ (S2D y) = norm_Inf (x - y) < 0.00001

30+(S3D x) ~~~ (S3D y) = norm_Inf (x - y) < 0.00001

31+

32+return []

33+tests :: IO Bool

34+tests = $quickCheckAll

test/test.hs+2

@@ -4,6 +4,7 @@ import qualified Test.Grenade.Layers.Pooling

4import qualified Test.Grenade.Layers.Convolution

5import qualified Test.Grenade.Layers.FullyConnected

6import qualified Test.Grenade.Layers.Nonlinear

7+import qualified Test.Grenade.Layers.PadCrop

7

8

8import qualified Test.Grenade.Layers.Internal.Convolution

9import qualified Test.Grenade.Layers.Internal.Convolution

9import qualified Test.Grenade.Layers.Internal.Pooling

10import qualified Test.Grenade.Layers.Internal.Pooling

@@ -17,6 +18,7 @@ main =

17 , Test.Grenade.Layers.Convolution.tests

18 , Test.Grenade.Layers.Convolution.tests

18 , Test.Grenade.Layers.FullyConnected.tests

19 , Test.Grenade.Layers.FullyConnected.tests

19 , Test.Grenade.Layers.Nonlinear.tests

20 , Test.Grenade.Layers.Nonlinear.tests

21+ , Test.Grenade.Layers.PadCrop.tests

20

22

21 , Test.Grenade.Layers.Internal.Convolution.tests

23 , Test.Grenade.Layers.Internal.Convolution.tests

22 , Test.Grenade.Layers.Internal.Pooling.tests

24 , Test.Grenade.Layers.Internal.Pooling.tests