git.iko.soy/grenade
on master help sign in
Add tests for Pad and Crop layers
commitc2d48a368ca14f41185489df5e338dd2604cf8c9 authorHuw Campbell <huw.campbell@ambiata.com> dateFri 3 Feb 2017, 23:56 (10 years ago) parentdf9f80a
3 files changed+44−4
compare with master
unifiedsplit
src/Grenade/Core/Network.hs+8−4 test/Test/Grenade/Layers/PadCrop.hs+34 test/test.hs+2
src/Grenade/Core/Network.hs+8−4
@@ -125,7 +125,8 @@ runNetwork =
125125-- Gives the gradients for the layer, and the gradient across the
126126-- input (which may not be required).
127127--
128−runGradient :: forall layers shapes. Network layers shapes
128+runGradient :: forall layers shapes.
129+ Network layers shapes
129130 -> Tapes layers shapes
130131 -> S (Last shapes)
131132 -> (Gradients layers, S (Head shapes))
@@ -157,10 +158,13 @@ applyUpdate _ NNil GNil
157158 = NNil
158159
159160
160−-- | A network can easily be created by hand with (:~>), but an easy way to initialise a random
161−-- network is with the randomNetwork.
161+-- | A network can easily be created by hand with (:~>), but an easy way to
162+-- initialise a random network is with the randomNetwork.
162163class 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.
164168 randomNetwork :: MonadRandom m => m (Network xs ss)
165169
166170instance 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
44import qualified Test.Grenade.Layers.Convolution
55import qualified Test.Grenade.Layers.FullyConnected
66import qualified Test.Grenade.Layers.Nonlinear
7+import qualified Test.Grenade.Layers.PadCrop
78
89import qualified Test.Grenade.Layers.Internal.Convolution
910import qualified Test.Grenade.Layers.Internal.Pooling
@@ -17,6 +18,7 @@ main =
1718 , Test.Grenade.Layers.Convolution.tests
1819 , Test.Grenade.Layers.FullyConnected.tests
1920 , Test.Grenade.Layers.Nonlinear.tests
21+ , Test.Grenade.Layers.PadCrop.tests
2022
2123 , Test.Grenade.Layers.Internal.Convolution.tests
2224 , Test.Grenade.Layers.Internal.Pooling.tests