on master help sign in
Remove Typeable, fix tests
cd4598bHuw Campbell
src/Grenade/Core/Network.hs+2−3
@@ -16,7 +16,6 @@ module Grenade.Core.Network (
16 , LearningParameters (..)
16 , LearningParameters (..)
17 ) where
17 ) where
18
18
19−import Data.Typeable
20import Grenade.Core.Shape
19import Grenade.Core.Shape
21
20
22data LearningParameters = LearningParameters {
21data LearningParameters = LearningParameters {
@@ -51,10 +50,10 @@ class UpdateLayer m x => Layer (m :: * -> *) x (i :: Shape) (o :: Shape) where
51-- Could be considered to be a heterogeneous list of layers which are able to
50-- Could be considered to be a heterogeneous list of layers which are able to
52-- transform the data shapes of the network.
51-- transform the data shapes of the network.
53data Network :: (* -> *) -> [Shape] -> * where
52data Network :: (* -> *) -> [Shape] -> * where
54− O :: (Typeable x, Show x, Layer m x i o, KnownShape o, KnownShape i)
53+ O :: (Show x, Layer m x i o, KnownShape o, KnownShape i)
55 => !x
54 => !x
56 -> Network m '[i, o]
55 -> Network m '[i, o]
57− (:~>) :: (Typeable x, Show x, Layer m x i h, KnownShape h, KnownShape i)
56+ (:~>) :: (Show x, Layer m x i h, KnownShape h, KnownShape i)
58 => !x
57 => !x
59 -> !(Network m (h ': hs))
58 -> !(Network m (h ': hs))
60 -> Network m (i ': h ': hs)
59 -> Network m (i ': h ': hs)
src/Grenade/Layers/Convolution.hs+1
@@ -14,6 +14,7 @@
14
14
15module Grenade.Layers.Convolution (
15module Grenade.Layers.Convolution (
16 Convolution (..)
16 Convolution (..)
17+ , Convolution' (..)
17 , randomConvolution
18 , randomConvolution
18 , im2col
19 , im2col
19 , vid2col
20 , vid2col
test/Test/Grenade/Layers/Convolution.hs+18−15
@@ -93,11 +93,12 @@ prop_simple_conv_forwards = once $
93 , 0.0, 0.0, 0.0, 0.0
93 , 0.0, 0.0, 0.0, 0.0
94 , 0.0, 0.0, 0.0, 0.0
94 , 0.0, 0.0, 0.0, 0.0
95 , 0.0, 0.0, 0.0, 0.0 ] :: HStatic.L 4 4)
95 , 0.0, 0.0, 0.0, 0.0 ] :: HStatic.L 4 4)
96+
96− --expectedKernel = (HStatic.matrix
97+ expectedGradient = (HStatic.matrix
97− -- [ 0.0, 0.0, 0.0, -2.0
98+ [ 1.0, 0.0, 0.0, 2.0
98− -- ,-2.0, 1.0, 1.0, -5.0
99+ , 2.0, 0.0, 0.0, 5.0
99− -- ,-3.0, -1.0, 1.0, -5.0
100+ , 3.0, 0.0, 0.0, 4.0
100− -- ,-5.0, 0.0, 0.0, -7.0 ] :: HStatic.L 4 4)
101+ , 4.0, 0.0, 0.0, 6.0 ] :: HStatic.L 4 4)
101
102
102 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
103 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
103
104
@@ -128,12 +129,13 @@ prop_simple_conv_forwards = once $
128 expectBack = (HStatic.matrix
129 expectBack = (HStatic.matrix
129 [ 1.0, 0.0, 0.0
130 [ 1.0, 0.0, 0.0
130 , 0.0, -2.0,-1.0] :: HStatic.L 2 3)
131 , 0.0, -2.0,-1.0] :: HStatic.L 2 3)
131− (nc, inX) = runIdentity $ runBackards 1 convLayer input grad :: ( Convolution 1 4 2 2 1 1 , S' ('D2 2 3))
132+ (nc, inX) = runIdentity $ runBackards convLayer input grad
132
133
133 in case (out, inX, nc) of
134 in case (out, inX, nc) of
134− (S3D' out' , S2D' inX', Convolution _ _)
135+ (S3D' out' , S2D' inX', Convolution' backGrad)
135 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
136 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
136 .&&. ((HStatic.extract expectBack) === (HStatic.extract inX'))
137 .&&. ((HStatic.extract expectBack) === (HStatic.extract inX'))
138+ .&&. ((HStatic.extract expectedGradient) === (HStatic.extract backGrad))
137 -- Temporarily disabled, as l2 adjustment puts in off 5%
139 -- Temporarily disabled, as l2 adjustment puts in off 5%
138 -- .&&. HStatic.extract expectedKernel === HStatic.extract kernel'
140 -- .&&. HStatic.extract expectedKernel === HStatic.extract kernel'
139
141
@@ -203,11 +205,12 @@ prop_single_conv_forwards = once $
203 , 0.0, 0.0, 0.0, 0.0
205 , 0.0, 0.0, 0.0, 0.0
204 , 0.0, 0.0, 0.0, 0.0
206 , 0.0, 0.0, 0.0, 0.0
205 , 0.0, 0.0, 0.0, 0.0 ] :: HStatic.L 4 4)
207 , 0.0, 0.0, 0.0, 0.0 ] :: HStatic.L 4 4)
208+
206− --expectedKernel = (HStatic.matrix
209+ expectedGradient = (HStatic.matrix
207− -- [ 0.0, 0.0, 0.0, -2.0
210+ [ 1.0, 0.0, 0.0, 2.0
208− -- ,-2.0, 1.0, 1.0, -5.0
211+ , 2.0, 0.0, 0.0, 5.0
209− -- ,-3.0, -1.0, 1.0, -5.0
212+ , 3.0, 0.0, 0.0, 4.0
210− -- ,-5.0, 0.0, 0.0, -7.0 ] :: HStatic.L 4 4)
213+ , 4.0, 0.0, 0.0, 6.0 ] :: HStatic.L 4 4)
211
214
212 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
215 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
213
216
@@ -238,13 +241,13 @@ prop_single_conv_forwards = once $
238 expectBack = (HStatic.matrix
241 expectBack = (HStatic.matrix
239 [ 1.0, 0.0, 0.0
242 [ 1.0, 0.0, 0.0
240 , 0.0, -2.0,-1.0] :: HStatic.L 2 3)
243 , 0.0, -2.0,-1.0] :: HStatic.L 2 3)
241− (nc, inX) = runIdentity $ runBackards 1 convLayer input grad :: ( Convolution 1 4 2 2 1 1 , S' ('D3 2 3 1))
244+ (nc, inX) = runIdentity $ runBackards convLayer input grad
242
245
243 in case (out, inX, nc) of
246 in case (out, inX, nc) of
244− (S3D' out' , S3D' inX', Convolution _ _)
247+ (S3D' out' , S3D' inX', Convolution' backGrad)
245 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
248 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
246 .&&. ([HStatic.extract expectBack] === (HStatic.extract <$> vecToList inX'))
249 .&&. ([HStatic.extract expectBack] === (HStatic.extract <$> vecToList inX'))
247− -- .&&. HStatic.extract expectedKernel === HStatic.extract kernel'
250+ .&&. ((HStatic.extract expectedGradient) === (HStatic.extract backGrad))
248
251
249return []
252return []
250tests :: IO Bool
253tests :: IO Bool