git.iko.soy/grenade
on master help sign in
Merge pull request #16 from HuwCampbell/topic/performance
fc95863Huw Campbell
README.md+21−16
compare with master
unifiedsplit
@@ -10,21 +10,22 @@ Five is right out.
10
10
11💣 Machine learning which might blow up in your face 💣
11💣 Machine learning which might blow up in your face 💣
12
12
13−Grenade is a dependently typed, practical, and pretty quick neural network
13+Grenade is a dependently typed, practical, and fast neural network library for
14−library for concise and precise specifications of complex networks in Haskell.
14+concise and precise specifications of complex networks in Haskell.
15
15
16−As an example, a network which can achieve less than 1% error on MNIST can be
16+As an example, a network which can achieve ~1.5% error on MNIST can be
17specified and initialised with random weights in a few lines of code with
17specified and initialised with random weights in a few lines of code with
18```haskell
18```haskell
19+type MNIST = Network '[ Convolution 1 10 5 5 1 1, Pooling 2 2 2 2, Relu, Convolution 10 16 5 5 1 1, Pooling 2 2 2 2, FlattenLayer, Relu, FullyConnected 256 80, Logit, FullyConnected 80 10, Logit]
20+ '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D1 256, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10]
21+
19−randomMnist :: MonadRandom m
22+randomMnist :: MonadRandom m => m MNIST
20− => m (Network '[ Convolution 1 10 5 5 1 1, Pooling 2 2 2 2, Relu, Convolution 10 16 5 5 1 1, Pooling 2 2 2 2, FlattenLayer, Relu, FullyConnected 256 80, Logit, FullyConnected 80 10, Logit]
21− '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D1 256, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10])
22randomMnist = randomNetwork
23randomMnist = randomNetwork
23```
24```
24
25
25−And that's it. Because the types contain all the information we need, there's
26+And that's it. Because the types are rich, there's no specific term level code
26−no specific term level code required; although it is of course possible and
27+required; although it is of course possible and easy to construct one explicitly
27−easy to build one oneself.
28+oneself.
28
29
29The network can be thought of as a heterogeneous list of layers, where its type
30The network can be thought of as a heterogeneous list of layers, where its type
30includes not only the layers of the network, but also the shapes of data that
31includes not only the layers of the network, but also the shapes of data that
@@ -36,6 +37,9 @@ data Network :: [*] -> [Shape] -> * where
36 (:~>) :: Layer x i h => !x -> !(Network xs (h ': hs)) -> Network (x ': xs) (i ': h ': hs)
37 (:~>) :: Layer x i h => !x -> !(Network xs (h ': hs)) -> Network (x ': xs) (i ': h ': hs)
37```
38```
38
39
40+The `Layer x i o` constraint ensures that the layer `x` can sensibly perform a
41+transformation between the input and output shapes `i` and `o`.
42+
39In the above example, the input layer can be seen to be a two dimensional (`D2`),
43In the above example, the input layer can be seen to be a two dimensional (`D2`),
40image with 28 by 28 pixels. When the first *Convolution* layer runs, it outputs
44image with 28 by 28 pixels. When the first *Convolution* layer runs, it outputs
41a three dimensional (`D3`) 24x24x10 image. The last item in the list is one
45a three dimensional (`D3`) 24x24x10 image. The last item in the list is one
@@ -96,15 +100,16 @@ needed, and was a great starting point for writing this library.
96
100
97Performance
101Performance
98-----------
102-----------
99−Grenade is backed by hmatrix and blas, and uses a pretty clever convolution
103+Grenade is backed by hmatrix, BLAS, and LAPACK, with critical functions optimised
100−trick popularised by Caffe, which is surprisingly effective and fast. So for many
104+in C. Using the im2col trick popularised by Caffe, it should be sufficient for
101−small scale problems it should be sufficient.
105+many problems.
102
106
103−Being purely functional, it's probably pretty easy to parallelise and batch up.
107+Being purely functional, it should also be easy to run batches in parallel, which
104−My current examples however are single threaded.
108+would be appropriate for larger networks, my current examples however are single
109+threaded.
105
110
106−Training 15 generations over Kaggle's 42000 sample MNIST training set took under
111+Training 15 generations over Kaggle's 41000 sample MNIST training set on a single
107−an hour, achieving 0.5% error rate on a 1000 sample holdout set.
112+core took around 12 minutes, achieving 1.5% error rate on a 1000 sample holdout set.
108
113
109Contributing
114Contributing
110------------
115------------
bench/bench.hsnew file+26
@@ -0,0 +1,26 @@
1+import Criterion.Main
2+
3+import Grenade.Layers.Internal.Convolution
4+import Grenade.Layers.Internal.Pooling
5+
6+import Numeric.LinearAlgebra
7+
8+main :: IO ()
9+main = defaultMain [
10+ bgroup "im2col" [ bench "im2col 3x4" $ whnf (im2col 2 2 1 1) ((3><4) [1..])
11+ , bench "im2col 28x28" $ whnf (im2col 5 5 1 1) ((28><28) [1..])
12+ , bench "im2col 100x100" $ whnf (im2col 10 10 1 1) ((100><100) [1..])
13+ ]
14+ , bgroup "col2im" [ bench "col2im 3x4" $ whnf (col2im 2 2 1 1 3 4) ((6><4) [1..])
15+ , bench "col2im 28x28" $ whnf (col2im 5 5 1 1 28 28) ((576><25) [1..])
16+ , bench "col2im 100x100" $ whnf (col2im 10 10 1 1 100 100) ((8281><100) [1..])
17+ ]
18+ , bgroup "poolfw" [ bench "poolforwards 3x4" $ whnf (poolForward 1 3 4 2 2 1 1) ((3><4) [1..])
19+ , bench "poolforwards 28x28" $ whnf (poolForward 1 28 28 5 5 1 1) ((28><28) [1..])
20+ , bench "poolforwards 100x100" $ whnf (poolForward 1 100 100 10 10 1 1) ((100><100) [1..])
21+ ]
22+ , bgroup "poolbw" [ bench "poolbackwards 3x4" $ whnf (poolBackward 1 3 4 2 2 1 1 ((3><4) [1..])) ((2><3) [1..])
23+ , bench "poolbackwards 28x28" $ whnf (poolBackward 1 28 28 5 5 1 1 ((28><28) [1..])) ((24><24) [1..])
24+ , bench "poolbackwards 100x100" $ whnf (poolBackward 1 100 100 10 10 1 1 ((100><100) [1..])) ((91><91) [1..])
25+ ]
26+ ]
cbits/im2col.cnew file+134
@@ -0,0 +1,134 @@
1+#include "im2col.h"
2+
3+inline int is_a_ge_zero_and_a_lt_b(int a, int b) {
4+ return a >= 0 && a < b;
5+}
6+
7+void im2col_cpu(const double* data_im, int dataOffset, const int channels,
8+ const int height, const int width, const int kernel_h, const int kernel_w,
9+ const int stride_h, const int stride_w,
10+ double* data_col) {
11+
12+ data_im += dataOffset;
13+ const int channel_size = height * width;
14+
15+ for (int fitting_height = 0; fitting_height <= (height - kernel_h); fitting_height += stride_h) {
16+ for (int fitting_width = 0; fitting_width <= (width - kernel_w); fitting_width += stride_w) {
17+ for (int channel = 0; channel < channels; channel++) {
18+ for (int kernel_row = 0; kernel_row < kernel_h; kernel_row++) {
19+ for (int kernel_col = 0; kernel_col < kernel_w; kernel_col++) {
20+ int input_row = fitting_height + kernel_row;
21+ int input_col = fitting_width + kernel_col;
22+ *(data_col++) = data_im[input_row * width + input_col + channel_size * channel];
23+ }
24+ }
25+ }
26+ }
27+ }
28+}
29+
30+void col2im_cpu(const double* data_col, int dataOffset, const int channels,
31+ const int height, const int width, const int kernel_h, const int kernel_w,
32+ const int stride_h, const int stride_w,
33+ double* data_im) {
34+
35+ memset(data_im, 0, height * width * channels * sizeof(double));
36+ data_col += dataOffset;
37+
38+ const int channel_size = height * width;
39+
40+ for (int fitting_height = 0; fitting_height <= (height - kernel_h); fitting_height += stride_h) {
41+ for (int fitting_width = 0; fitting_width <= (width - kernel_w); fitting_width += stride_w) {
42+ for (int channel = 0; channel < channels; channel++) {
43+ for (int kernel_row = 0; kernel_row < kernel_h; kernel_row++) {
44+ for (int kernel_col = 0; kernel_col < kernel_w; kernel_col++) {
45+ int input_row = fitting_height + kernel_row;
46+ int input_col = fitting_width + kernel_col;
47+ data_im[input_row * width + input_col + channel_size * channel] += *(data_col++);
48+ }
49+ }
50+ }
51+ }
52+ }
53+}
54+
55+inline int max ( int a, int b ) { return a > b ? a : b; }
56+
57+void pool_forwards_cpu(const double* data_im, int dataOffset, const int channels,
58+ const int height, const int width, const int kernel_h, const int kernel_w,
59+ const int stride_h, const int stride_w,
60+ double* data_pooled) {
61+
62+ data_im += dataOffset;
63+
64+ const int channel_size = height * width;
65+
66+ for (int channel = 0; channel < channels; channel++) {
67+ for (int fitting_height = 0; fitting_height <= (height - kernel_h); fitting_height += stride_h) {
68+ for (int fitting_width = 0; fitting_width <= (width - kernel_w); fitting_width += stride_w) {
69+ // Start with the value in 0,0
70+ int max_value = data_im[fitting_height * width + fitting_width + channel_size * channel];
71+ // Initial row, skipping the corner we've done
72+ for (int kernel_col = 1; kernel_col < kernel_w; kernel_col++) {
73+ int input_row = fitting_height;
74+ int input_col = fitting_width + kernel_col;
75+ max_value = max ( max_value, data_im[input_row * width + input_col + channel_size * channel] );
76+ }
77+ // The remaining rows
78+ for (int kernel_row = 1; kernel_row < kernel_h; kernel_row++) {
79+ for (int kernel_col = 0; kernel_col < kernel_w; kernel_col++) {
80+ int input_row = fitting_height + kernel_row;
81+ int input_col = fitting_width + kernel_col;
82+ max_value = max ( max_value, data_im[input_row * width + input_col + channel_size * channel] );
83+ }
84+ }
85+ *(data_pooled++) = max_value;
86+ }
87+ }
88+ }
89+}
90+
91+void pool_backwards_cpu(const double* data_im, int data_im_offset,
92+ const double* data_pooled, int data_pooled_offset,
93+ const int channels, const int height, const int width, const int kernel_h,
94+ const int kernel_w, const int stride_h, const int stride_w,
95+ double* data_backgrad ) {
96+
97+ data_im += data_im_offset;
98+ data_pooled += data_pooled_offset;
99+ memset(data_backgrad, 0, height * width * channels * sizeof(double));
100+
101+ const int channel_size = height * width;
102+
103+ for (int channel = 0; channel < channels; channel++) {
104+ for (int fitting_height = 0; fitting_height <= (height - kernel_h); fitting_height += stride_h) {
105+ for (int fitting_width = 0; fitting_width <= (width - kernel_w); fitting_width += stride_w) {
106+ int max_index = fitting_height * width + fitting_width + channel_size * channel;
107+ int max_value = data_im[max_index];
108+ for (int kernel_col = 1; kernel_col < kernel_w; kernel_col++) {
109+ int input_row = fitting_height;
110+ int input_col = fitting_width + kernel_col;
111+ int data_index = input_row * width + input_col + channel_size * channel;
112+ int data_value = data_im[data_index];
113+ if ( data_value > max_value ) {
114+ max_value = data_value;
115+ max_index = data_index;
116+ }
117+ }
118+ for (int kernel_row = 1; kernel_row < kernel_h; kernel_row++) {
119+ for (int kernel_col = 0; kernel_col < kernel_w; kernel_col++) {
120+ int input_row = fitting_height + kernel_row;
121+ int input_col = fitting_width + kernel_col;
122+ int data_index = input_row * width + input_col + channel_size * channel;
123+ int data_value = data_im[data_index];
124+ if ( data_value > max_value ) {
125+ max_value = data_value;
126+ max_index = data_index;
127+ }
128+ }
129+ }
130+ data_backgrad[max_index] += *(data_pooled++);
131+ }
132+ }
133+ }
134+}
cbits/im2col.hnew file+24
@@ -0,0 +1,24 @@
1+#include <stdio.h>
2+#include <stdint.h>
3+#include <string.h>
4+
5+void im2col_cpu(const double* data_im, int dataOffset, const int channels,
6+ const int height, const int width, const int kernel_h, const int kernel_w,
7+ const int stride_h, const int stride_w,
8+ double* data_col);
9+
10+void col2im_cpu(const double* data_col, int dataOffset, const int channels,
11+ const int height, const int width, const int kernel_h, const int kernel_w,
12+ const int stride_h, const int stride_w,
13+ double* data_im);
14+
15+void pool_forwards_cpu(const double* data_im, int dataOffset, const int channels,
16+ const int height, const int width, const int kernel_h, const int kernel_w,
17+ const int stride_h, const int stride_w,
18+ double* data_pooled);
19+
20+void pool_backwards_cpu(const double* data_im, int data_im_offset,
21+ const double* data_pooled, int data_pooled_offset,
22+ const int channels, const int height, const int width, const int kernel_h,
23+ const int kernel_w, const int stride_h, const int stride_w,
24+ double* data_backgrad );
grenade.cabal+26−1
@@ -10,6 +10,10 @@ cabal-version: >= 1.8
10build-type: Simple
10build-type: Simple
11description: grenade.
11description: grenade.
12
12
13+extra-source-files:
14+ cbits/im2col.h
15+ cbits/im2col.c
16+
13library
17library
14 build-depends:
18 build-depends:
15 base >= 4.8 && < 5
19 base >= 4.8 && < 5
@@ -35,7 +39,6 @@ library
35 exposed-modules:
39 exposed-modules:
36 Grenade
40 Grenade
37 Grenade.Core.Network
41 Grenade.Core.Network
38− Grenade.Core.Vector
39 Grenade.Core.Runner
42 Grenade.Core.Runner
40 Grenade.Core.Shape
43 Grenade.Core.Shape
41 Grenade.Layers.Crop
44 Grenade.Layers.Crop
@@ -53,6 +56,10 @@ library
53 Grenade.Layers.Internal.Convolution
56 Grenade.Layers.Internal.Convolution
54 Grenade.Layers.Internal.Pooling
57 Grenade.Layers.Internal.Pooling
55
58
59+ includes: cbits/im2col.h
60+ c-sources: cbits/im2col.c
61+
62+ cc-options: -std=c99 -O3 -msse4.2 -Wall -Werror -DCABAL=1
56
63
57executable feedforward
64executable feedforward
58 ghc-options: -Wall -threaded -O2
65 ghc-options: -Wall -threaded -O2
@@ -104,3 +111,21 @@ test-suite test
104 , text == 1.2.*
111 , text == 1.2.*
105 , QuickCheck >= 2.7 && < 2.9
112 , QuickCheck >= 2.7 && < 2.9
106 , quickcheck-instances == 0.3.*
113 , quickcheck-instances == 0.3.*
114+
115+
116+benchmark bench
117+ type: exitcode-stdio-1.0
118+
119+ main-is: bench.hs
120+
121+ ghc-options: -Wall -threaded -O2
122+
123+ hs-source-dirs:
124+ bench
125+
126+ build-depends:
127+ base >= 3 && < 5
128+ , bytestring == 0.10.*
129+ , criterion == 1.1.*
130+ , grenade
131+ , hmatrix
main/feedforward.hs+4−3
@@ -24,9 +24,10 @@ import Grenade
24-- between the shapes, so inference can't do it all for us.
24-- between the shapes, so inference can't do it all for us.
25
25
26-- With around 100000 examples, this should show two clear circles which have been learned by the network.
26-- With around 100000 examples, this should show two clear circles which have been learned by the network.
27−randomNet :: MonadRandom m
28− => m (Network '[ FullyConnected 2 40, Tanh, FullyConnected 40 10, Relu, FullyConnected 10 1, Logit ]
27+type FFNet = Network '[ FullyConnected 2 40, Tanh, FullyConnected 40 10, Relu, FullyConnected 10 1, Logit ]
29− '[ 'D1 2, 'D1 40, 'D1 40, 'D1 10, 'D1 10, 'D1 1, 'D1 1])
28+ '[ 'D1 2, 'D1 40, 'D1 40, 'D1 10, 'D1 10, 'D1 1, 'D1 1]
29+
30+randomNet :: MonadRandom m => m FFNet
30randomNet = randomNetwork
31randomNet = randomNetwork
31
32
32netTest :: MonadRandom m => LearningParameters -> Int -> m String
33netTest :: MonadRandom m => LearningParameters -> Int -> m String
main/mnist.hs+4−3
@@ -32,9 +32,10 @@ import Grenade
32
32
33-- With the mnist data from Kaggle normalised to doubles between 0 and 1, learning rate of 0.01 and 15 iterations,
33-- With the mnist data from Kaggle normalised to doubles between 0 and 1, learning rate of 0.01 and 15 iterations,
34-- this network should get down to about a 1.3% error rate.
34-- this network should get down to about a 1.3% error rate.
35+type MNIST = Network '[ Convolution 1 10 5 5 1 1, Pooling 2 2 2 2, Relu, Convolution 10 16 5 5 1 1, Pooling 2 2 2 2, FlattenLayer, Relu, FullyConnected 256 80, Logit, FullyConnected 80 10, Logit]
36+ '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D1 256, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10]
37+
35−randomMnist :: MonadRandom m
38+randomMnist :: MonadRandom m => m MNIST
36− => m (Network '[ Convolution 1 10 5 5 1 1, Pooling 2 2 2 2, Relu, Convolution 10 16 5 5 1 1, Pooling 2 2 2 2, FlattenLayer, Relu, FullyConnected 256 80, Logit, FullyConnected 80 10, Logit]
37− '[ 'D2 28 28, 'D3 24 24 10, 'D3 12 12 10, 'D3 12 12 10, 'D3 8 8 16, 'D3 4 4 16, 'D1 256, 'D1 256, 'D1 80, 'D1 80, 'D1 10, 'D1 10])
38randomMnist = randomNetwork
39randomMnist = randomNetwork
39
40
40convTest :: Int -> FilePath -> FilePath -> LearningParameters -> ExceptT String IO ()
41convTest :: Int -> FilePath -> FilePath -> LearningParameters -> ExceptT String IO ()
src/Grenade.hs−1
@@ -2,7 +2,6 @@ module Grenade (
2 module X
2 module X
3 ) where
3 ) where
4
4
5−import Grenade.Core.Vector as X
6import Grenade.Core.Network as X
5import Grenade.Core.Network as X
7import Grenade.Core.Runner as X
6import Grenade.Core.Runner as X
8import Grenade.Core.Shape as X
7import Grenade.Core.Shape as X
src/Grenade/Core/Shape.hs+14−9
@@ -19,10 +19,10 @@ module Grenade.Core.Shape (
19 ) where
19 ) where
20
20
21import Data.Singletons.TypeLits
21import Data.Singletons.TypeLits
22+import GHC.TypeLits
22
23
23import Numeric.LinearAlgebra.Static
24import Numeric.LinearAlgebra.Static
24
25
25−import Grenade.Core.Vector
26
26
27-- | The current shapes we accept.
27-- | The current shapes we accept.
28-- at the moment this is just one, two, and three dimensional
28-- at the moment this is just one, two, and three dimensional
@@ -35,34 +35,39 @@ data Shape =
35instance Num (S' x) where
35instance Num (S' x) where
36 (+) (S1D' x) (S1D' y) = S1D' (x + y)
36 (+) (S1D' x) (S1D' y) = S1D' (x + y)
37 (+) (S2D' x) (S2D' y) = S2D' (x + y)
37 (+) (S2D' x) (S2D' y) = S2D' (x + y)
38− (+) (S3D' x) (S3D' y) = S3D' (vectorZip (+) x y)
38+ (+) (S3D' x) (S3D' y) = S3D' (x + y)
39 (+) _ _ = error "Impossible to have different constructors for the same shaped network"
39 (+) _ _ = error "Impossible to have different constructors for the same shaped network"
40
40
41 (-) (S1D' x) (S1D' y) = S1D' (x - y)
41 (-) (S1D' x) (S1D' y) = S1D' (x - y)
42 (-) (S2D' x) (S2D' y) = S2D' (x - y)
42 (-) (S2D' x) (S2D' y) = S2D' (x - y)
43− (-) (S3D' x) (S3D' y) = S3D' (vectorZip (-) x y)
43+ (-) (S3D' x) (S3D' y) = S3D' (x - y)
44 (-) _ _ = error "Impossible to have different constructors for the same shaped network"
44 (-) _ _ = error "Impossible to have different constructors for the same shaped network"
45
45
46 (*) (S1D' x) (S1D' y) = S1D' (x * y)
46 (*) (S1D' x) (S1D' y) = S1D' (x * y)
47 (*) (S2D' x) (S2D' y) = S2D' (x * y)
47 (*) (S2D' x) (S2D' y) = S2D' (x * y)
48− (*) (S3D' x) (S3D' y) = S3D' (vectorZip (*) x y)
48+ (*) (S3D' x) (S3D' y) = S3D' (x * y)
49 (*) _ _ = error "Impossible to have different constructors for the same shaped network"
49 (*) _ _ = error "Impossible to have different constructors for the same shaped network"
50
50
51 abs (S1D' x) = S1D' (abs x)
51 abs (S1D' x) = S1D' (abs x)
52 abs (S2D' x) = S2D' (abs x)
52 abs (S2D' x) = S2D' (abs x)
53− abs (S3D' x) = S3D' (fmap abs x)
53+ abs (S3D' x) = S3D' (abs x)
54
54
55 signum (S1D' x) = S1D' (signum x)
55 signum (S1D' x) = S1D' (signum x)
56 signum (S2D' x) = S2D' (signum x)
56 signum (S2D' x) = S2D' (signum x)
57− signum (S3D' x) = S3D' (fmap signum x)
57+ signum (S3D' x) = S3D' (signum x)
58
58
59 fromInteger _ = error "Unimplemented: fromInteger on Shape"
59 fromInteger _ = error "Unimplemented: fromInteger on Shape"
60
60
61-- | Given a Shape n, these are the possible data structures with that shape.
61-- | Given a Shape n, these are the possible data structures with that shape.
62+-- All shapes are held in contiguous memory.
63+-- 3D is held in a matrix (usually row oriented) which has height depth * rows.
62data S' (n :: Shape) where
64data S' (n :: Shape) where
63− S1D' :: (KnownNat o) => R o -> S' ('D1 o)
65+ S1D' :: ( KnownNat o ) => R o -> S' ('D1 o)
64− S2D' :: (KnownNat rows, KnownNat columns) => L rows columns -> S' ('D2 rows columns)
66+ S2D' :: ( KnownNat rows, KnownNat columns ) => L rows columns -> S' ('D2 rows columns)
67+ S3D' :: ( KnownNat rows
68+ , KnownNat columns
69+ , KnownNat depth
65− S3D' :: (KnownNat rows, KnownNat columns, KnownNat depth) => Vector depth (L rows columns) -> S' ('D3 rows columns depth)
70+ , KnownNat (rows * depth)) => L (rows * depth) columns -> S' ('D3 rows columns depth)
66
71
67instance Show (S' n) where
72instance Show (S' n) where
68 show (S1D' a) = "S1D' " ++ show a
73 show (S1D' a) = "S1D' " ++ show a
src/Grenade/Core/Vector.hsdeleted−53
@@ -1,53 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE GADTs #-}
4−{-# LANGUAGE KindSignatures #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE StandaloneDeriving #-}
7−{-# LANGUAGE TypeOperators #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE PolyKinds #-}
10−
11−module Grenade.Core.Vector (
12− Vector
13− , vectorZip
14− , vecToList
15− , mkVector
16− ) where
17−
18−import Data.Proxy
19−import GHC.TypeLits
20−
21−-- | A more specific Tagged type, ensuring that a list
22−-- is equal to the Nat value.
23−newtype Vector (n :: Nat) a = Vector [a]
24−
25−instance Foldable (Vector n) where
26− foldr f b (Vector as) = foldr f b as
27−
28−instance KnownNat n => Traversable (Vector n) where
29− traverse f (Vector as) = mkVector <$> traverse f as
30−
31−instance Functor (Vector n) where
32− fmap f (Vector as) = Vector (fmap f as)
33−
34−instance Show a => Show (Vector n a) where
35− showsPrec d = showsPrec d . vecToList
36−
37−instance Eq a => Eq (Vector n a) where
38− (Vector as) == (Vector bs) = as == bs
39−
40−mkVector :: forall n a. KnownNat n => [a] -> Vector n a
41−mkVector as
42− = let du = fromIntegral . natVal $ (undefined :: Proxy n)
43− la = length as
44− in if du == la
45− then Vector as
46− else error $ "Error creating staticly sized Vector of length: " ++
47− show du ++ " list is of length:" ++ show la
48−
49−vecToList :: Vector n a -> [a]
50−vecToList (Vector as) = as
51−
52−vectorZip :: (a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
53−vectorZip f (Vector as) (Vector bs) = Vector (zipWith f as bs)
src/Grenade/Layers/Convolution.hs+21−20
@@ -30,7 +30,6 @@ import Numeric.LinearAlgebra.Static hiding ((|||), build, toRows)
30
30
31import Grenade.Core.Network
31import Grenade.Core.Network
32import Grenade.Core.Shape
32import Grenade.Core.Shape
33−import Grenade.Core.Vector
34import Grenade.Layers.Internal.Convolution
33import Grenade.Layers.Internal.Convolution
35
34
36-- | A convolution layer for a neural network.
35-- | A convolution layer for a neural network.
@@ -145,6 +144,7 @@ instance ( KnownNat kernelRows
145 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
144 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
146 , ((outputCols - 1) * strideCols) ~ (inputCols - kernelCols)
145 , ((outputCols - 1) * strideCols) ~ (inputCols - kernelCols)
147 , KnownNat (kernelRows * kernelCols * 1)
146 , KnownNat (kernelRows * kernelCols * 1)
147+ , KnownNat (outputRows * filters)
148 ) => Layer (Convolution 1 filters kernelRows kernelCols strideRows strideCols) ('D2 inputRows inputCols) ('D3 outputRows outputCols filters) where
148 ) => Layer (Convolution 1 filters kernelRows kernelCols strideRows strideCols) ('D2 inputRows inputCols) ('D3 outputRows outputCols filters) where
149 runForwards (Convolution kernel _) (S2D' input) =
149 runForwards (Convolution kernel _) (S2D' input) =
150 let ex = extract input
150 let ex = extract input
@@ -155,11 +155,11 @@ instance ( KnownNat kernelRows
155 sy = fromIntegral $ natVal (Proxy :: Proxy strideCols)
155 sy = fromIntegral $ natVal (Proxy :: Proxy strideCols)
156 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
156 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
157 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
157 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
158− c = im2colUnsafe kx ky sx sy ex
158+ c = im2col kx ky sx sy ex
159 mt = c LA.<> ek
159 mt = c LA.<> ek
160− r = col2vidUnsafe 1 1 1 1 ox oy mt
160+ r = col2vid 1 1 1 1 ox oy mt
161− rs = fmap (fromJust . create) r
161+ rs = fromJust . create $ r
162− in S3D' $ mkVector rs
162+ in S3D' rs
163
163
164 runBackwards (Convolution kernel _) (S2D' input) (S3D' dEdy) =
164 runBackwards (Convolution kernel _) (S2D' input) (S3D' dEdy) =
165 let ex = extract input
165 let ex = extract input
@@ -172,17 +172,17 @@ instance ( KnownNat kernelRows
172 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
172 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
173 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
173 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
174
174
175− c = im2colUnsafe kx ky sx sy ex
175+ c = im2col kx ky sx sy ex
176
176
177− eo = vecToList $ fmap extract dEdy
177+ eo = extract dEdy
178 ek = extract kernel
178 ek = extract kernel
179
179
180− vs = vid2colUnsafe 1 1 1 1 ox oy eo
180+ vs = vid2col 1 1 1 1 ox oy eo
181
181
182 kN = fromJust . create $ tr c LA.<> vs
182 kN = fromJust . create $ tr c LA.<> vs
183 dW = vs LA.<> tr ek
183 dW = vs LA.<> tr ek
184
184
185− xW = col2imUnsafe kx ky sx sy ix iy dW
185+ xW = col2im kx ky sx sy ix iy dW
186 in (Convolution' kN, S2D' . fromJust . create $ xW)
186 in (Convolution' kN, S2D' . fromJust . create $ xW)
187
187
188
188
@@ -201,9 +201,10 @@ instance ( KnownNat kernelRows
201 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
201 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
202 , ((outputCols - 1) * strideCols) ~ (inputCols - kernelCols)
202 , ((outputCols - 1) * strideCols) ~ (inputCols - kernelCols)
203 , KnownNat (kernelRows * kernelCols * channels)
203 , KnownNat (kernelRows * kernelCols * channels)
204+ , KnownNat (outputRows * filters)
204 ) => Layer (Convolution channels filters kernelRows kernelCols strideRows strideCols) ('D3 inputRows inputCols channels) ('D3 outputRows outputCols filters) where
205 ) => Layer (Convolution channels filters kernelRows kernelCols strideRows strideCols) ('D3 inputRows inputCols channels) ('D3 outputRows outputCols filters) where
205 runForwards (Convolution kernel _) (S3D' input) =
206 runForwards (Convolution kernel _) (S3D' input) =
206− let ex = vecToList $ fmap extract input
207+ let ex = extract input
207 ek = extract kernel
208 ek = extract kernel
208 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
209 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
209 iy = fromIntegral $ natVal (Proxy :: Proxy inputCols)
210 iy = fromIntegral $ natVal (Proxy :: Proxy inputCols)
@@ -214,13 +215,13 @@ instance ( KnownNat kernelRows
214 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
215 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
215 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
216 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
216
217
217− c = vid2colUnsafe kx ky sx sy ix iy ex
218+ c = vid2col kx ky sx sy ix iy ex
218 mt = c LA.<> ek
219 mt = c LA.<> ek
219− r = col2vidUnsafe 1 1 1 1 ox oy mt
220+ r = col2vid 1 1 1 1 ox oy mt
220− rs = fmap (fromJust . create) r
221+ rs = fromJust . create $ r
221− in S3D' $ mkVector rs
222+ in S3D' rs
222 runBackwards (Convolution kernel _) (S3D' input) (S3D' dEdy) =
223 runBackwards (Convolution kernel _) (S3D' input) (S3D' dEdy) =
223− let ex = vecToList $ fmap extract input
224+ let ex = extract input
224 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
225 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
225 iy = fromIntegral $ natVal (Proxy :: Proxy inputCols)
226 iy = fromIntegral $ natVal (Proxy :: Proxy inputCols)
226 kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
227 kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
@@ -230,16 +231,16 @@ instance ( KnownNat kernelRows
230 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
231 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
231 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
232 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
232
233
233− c = vid2colUnsafe kx ky sx sy ix iy ex
234+ c = vid2col kx ky sx sy ix iy ex
234
235
235− eo = vecToList $ fmap extract dEdy
236+ eo = extract dEdy
236 ek = extract kernel
237 ek = extract kernel
237
238
238− vs = vid2colUnsafe 1 1 1 1 ox oy eo
239+ vs = vid2col 1 1 1 1 ox oy eo
239
240
240 kN = fromJust . create $ tr c LA.<> vs
241 kN = fromJust . create $ tr c LA.<> vs
241
242
242 dW = vs LA.<> tr ek
243 dW = vs LA.<> tr ek
243
244
244− xW = col2vidUnsafe kx ky sx sy ix iy dW
245+ xW = col2vid kx ky sx sy ix iy dW
245− in (Convolution' kN, S3D' . mkVector . fmap (fromJust . create) $ xW)
246+ in (Convolution' kN, S3D' . fromJust . create $ xW)
src/Grenade/Layers/Flatten.hs+6−18
@@ -5,20 +5,19 @@
5{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE FlexibleInstances #-}
9
10
10module Grenade.Layers.Flatten (
11module Grenade.Layers.Flatten (
11 FlattenLayer (..)
12 FlattenLayer (..)
12 ) where
13 ) where
13
14
14−import Data.Proxy
15import Data.Singletons.TypeLits
15import Data.Singletons.TypeLits
16import GHC.TypeLits
16import GHC.TypeLits
17
17
18import Numeric.LinearAlgebra.Static
18import Numeric.LinearAlgebra.Static
19−import Numeric.LinearAlgebra.Data as LA (flatten, toList, takesV, reshape, vjoin)
19+import Numeric.LinearAlgebra.Data as LA (flatten, toList)
20
20
21−import Grenade.Core.Vector
22import Grenade.Core.Shape
21import Grenade.Core.Shape
23import Grenade.Core.Network
22import Grenade.Core.Network
24
23
@@ -31,21 +30,10 @@ instance UpdateLayer FlattenLayer where
31 createRandom = return FlattenLayer
30 createRandom = return FlattenLayer
32
31
33
32
34−instance (KnownNat a, KnownNat x, KnownNat y, a ~ (x * y)) => Layer FlattenLayer ('D2 x y) ('D1 a) where
33+instance (KnownNat a, KnownNat x, KnownNat y, a ~ (x * z)) => Layer FlattenLayer ('D2 x y) ('D1 a) where
35 runForwards _ (S2D' y) = S1D' . fromList . toList . flatten . extract $ y
34 runForwards _ (S2D' y) = S1D' . fromList . toList . flatten . extract $ y
36 runBackwards _ _ (S1D' y) = ((), S2D' . fromList . toList . unwrap $ y)
35 runBackwards _ _ (S1D' y) = ((), S2D' . fromList . toList . unwrap $ y)
37
36
38−instance (KnownNat a, KnownNat x, KnownNat y, KnownNat z, a ~ (x * y * z)) => Layer FlattenLayer ('D3 x y z) ('D1 a) where
37+instance (KnownNat a, KnownNat x, KnownNat y, KnownNat (x * z), KnownNat z, a ~ (x * y * z)) => Layer FlattenLayer ('D3 x y z) ('D1 a) where
39− runForwards _ (S3D' y) = S1D' . raiseShapeError . create . vjoin . vecToList . fmap (flatten . extract) $ y
38+ runForwards _ (S3D' y) = S1D' . fromList . toList . flatten . extract $ y
40− runBackwards _ _ (S1D' o) =
39+ runBackwards _ _ (S1D' y) = ((), S3D' . fromList . toList . unwrap $ y)
41− let x' = fromIntegral $ natVal (Proxy :: Proxy x)
42− y' = fromIntegral $ natVal (Proxy :: Proxy y)
43− z' = fromIntegral $ natVal (Proxy :: Proxy z)
44− vecs = takesV (replicate z' (x' * y')) (extract o)
45− ls = fmap (raiseShapeError . create . reshape y') vecs
46− ls' = mkVector ls :: Vector z (L x y)
47− in ((), S3D' ls')
48−
49−raiseShapeError :: Maybe a -> a
50−raiseShapeError (Just x) = x
51−raiseShapeError Nothing = error "Static shape creation from Flatten layer produced the wrong result"
src/Grenade/Layers/Internal/Convolution.hs+68−185
@@ -1,195 +1,78 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
1module Grenade.Layers.Internal.Convolution (
2module Grenade.Layers.Internal.Convolution (
2− col2vidUnsafe
3+ im2col
3− , col2imUnsafe
4+ , col2im
4− , vid2colUnsafe
5+ , col2vid
5− , im2colUnsafe
6+ , vid2col
6− , fittingStarts
7− , unsafeModifyMatrix
8 ) where
7 ) where
9
8
10−import Control.Monad.ST ( ST, runST )
9+import Foreign ( mallocForeignPtrArray0, withForeignPtr )
10+import Foreign.Ptr ( Ptr )
11
11
12−import Data.STRef ( newSTRef, modifySTRef', writeSTRef, readSTRef )
13−import Data.Foldable ( forM_ )
14−import Data.Traversable ( forM )
15−
16−import Foreign.Storable( Storable )
17−
18−import Numeric.LinearAlgebra hiding ( uniformSample, konst )
12+import Numeric.LinearAlgebra ( Matrix, flatten, rows, cols )
19import qualified Numeric.LinearAlgebra.Devel as U
13import qualified Numeric.LinearAlgebra.Devel as U
20
14
21−-- This module provides provides im2col function and friends, ala caffe.
15+import System.IO.Unsafe ( unsafePerformIO )
22−--
16+
23−-- /* From Caffe */
17+col2vid :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
24−-- @
18+col2vid kernelRows kernelColumns strideRows strideColumns height width dataCol =
25−-- void col2im_cpu(const Dtype* data_col, const int channels,
19+ let channels = cols dataCol `div` (kernelRows * kernelColumns)
26−-- const int height, const int width, const int kernel_h, const int kernel_w,
20+ in col2im_c channels height width kernelRows kernelColumns strideRows strideColumns dataCol
27−-- const int pad_h, const int pad_w,
21+
28−-- const int stride_h, const int stride_w,
29−-- const int dilation_h, const int dilation_w,
30−-- Dtype* data_im) {
31−-- caffe_set(height * width * channels, Dtype(0), data_im);
32−-- const int output_h = (height + 2 * pad_h -
33−-- (dilation_h * (kernel_h - 1) + 1)) / stride_h + 1;
34−-- const int output_w = (width + 2 * pad_w -
35−-- (dilation_w * (kernel_w - 1) + 1)) / stride_w + 1;
36−-- const int channel_size = height * width;
37−-- for (int channel = channels; channel--; data_im += channel_size) {
38−-- for (int kernel_row = 0; kernel_row < kernel_h; kernel_row++) {
39−-- for (int kernel_col = 0; kernel_col < kernel_w; kernel_col++) {
40−-- int input_row = -pad_h + kernel_row * dilation_h;
41−-- for (int output_rows = output_h; output_rows; output_rows--) {
42−-- if (!is_a_ge_zero_and_a_lt_b(input_row, height)) {
43−-- data_col += output_w;
44−-- } else {
45−-- int input_col = -pad_w + kernel_col * dilation_w;
46−-- for (int output_col = output_w; output_col; output_col--) {
47−-- if (is_a_ge_zero_and_a_lt_b(input_col, width)) {
48−-- data_im[input_row * width + input_col] += *data_col;
49−-- }
50−-- data_col++;
51−-- input_col += stride_w;
52−-- }
53−-- }
54−-- input_row += stride_h;
55−-- }
56−-- }
57−-- }
58−-- }
59−-- }
60−-- @
61−--
62−
63−-- | col2im function.
64−--
65−-- Takes a column patch, and reconstitutes it into a normal image.
66−-- Does not do any bounds checking on the matrix, so should only
67−-- be called once the sizes are ensured correct.
68−col2imUnsafe :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
22+col2im :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
69−col2imUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows destinationCols columnMatrix = U.runSTMatrix $ do
23+col2im kernelRows kernelColumns strideRows strideColumns height width dataCol =
70− let columnMatrixRows = rows columnMatrix
24+ let channels = 1
71−
25+ in col2im_c channels height width kernelRows kernelColumns strideRows strideColumns dataCol
72− dataIm <- U.newMatrix 0 destinationRows destinationCols
26+
73− offsetR <- newSTRef 0
27+col2im_c :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
74− offsetC <- newSTRef 0
28+col2im_c channels height width kernelRows kernelColumns strideRows strideColumns dataCol =
75−
29+ let vec = flatten dataCol
76− forM_ [0 .. columnMatrixRows - 1] $ \inputRow -> do
30+ in unsafePerformIO $ do
77− inputColumnRef <- newSTRef 0
31+ outPtr <- mallocForeignPtrArray0 (height * width * channels)
78− offsetR' <- readSTRef offsetR
32+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
79− offsetC' <- readSTRef offsetC
33+
80− forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
34+ withForeignPtr inPtr $ \inPtr' ->
81− forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
35+ withForeignPtr outPtr $ \outPtr' ->
82− inputColumn <- readSTRef inputColumnRef
36+ col2im_cpu inPtr' inOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
83− unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix inputRow inputColumn)
37+
84− modifySTRef' inputColumnRef (+1)
38+ let matVec = U.unsafeFromForeignPtr outPtr 0 (height * width * channels)
85−
39+ return $ U.matrixFromVector U.RowMajor (height * channels) width matVec
86− if offsetC' + kernelColumns < destinationCols
40+
87− then modifySTRef' offsetC (+ strideColumns)
41+foreign import ccall unsafe
88− else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
42+ col2im_cpu
89−
43+ :: Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
90− return dataIm
44+
91−
92−-- | col2vid function.
93−--
94−-- Takes a column patch image, and reconstitutes it into a normal image with multiple channels.
95−-- Does not do any bounds checking on the matrix, so should only
96−-- be called once the sizes are ensured correct.
97−col2vidUnsafe :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> [Matrix Double]
45+vid2col :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
98−col2vidUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows destinationCols columnMatrix = runST $ do
46+vid2col kernelRows kernelColumns strideRows strideColumns height width dataVid =
99− let columnMatrixRows = rows columnMatrix
47+ let channels = rows dataVid `div` height
100− let filters = cols columnMatrix `div` (kernelRows * kernelColumns)
48+ in im2col_c channels height width kernelRows kernelColumns strideRows strideColumns dataVid
101−
49+
102− forM [0 .. filters - 1] $ \iter -> do
50+
51+im2col :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
103− let offsetM = iter * (kernelRows * kernelColumns)
52+im2col kernelRows kernelColumns strideRows strideColumns dataIm =
104− dataIm <- U.newMatrix 0 destinationRows destinationCols
53+ let channels = 1
105− offsetR <- newSTRef 0
54+ height = rows dataIm
106− offsetC <- newSTRef 0
55+ width = cols dataIm
107− forM_ [0 .. columnMatrixRows - 1] $ \ir -> do
56+ in im2col_c channels height width kernelRows kernelColumns strideRows strideColumns dataIm
108− inputColumn <- newSTRef 0
57+
109− offsetR' <- readSTRef offsetR
110− offsetC' <- readSTRef offsetC
111− forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
112− forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
113− ic <- readSTRef inputColumn
114− unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix ir (ic + offsetM))
115− modifySTRef' inputColumn (+1)
116−
117− if offsetC' + kernelColumns < destinationCols
118− then modifySTRef' offsetC (+ strideColumns)
119− else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
120−
121− U.unsafeFreezeMatrix dataIm
122−
123−vid2colUnsafe :: Int -> Int -> Int -> Int -> Int -> Int -> [Matrix Double] -> Matrix Double
58+im2col_c :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
124−vid2colUnsafe kernelRows kernelColumns striderows stridecols vidrows vidcols dataVid = U.runSTMatrix $ do
59+im2col_c channels height width kernelRows kernelColumns strideRows strideColumns dataIm =
125− let starts = fittingStarts vidrows kernelRows striderows vidcols kernelColumns stridecols
60+ let vec = flatten dataIm
61+ rowOut = (height - kernelRows) `div` strideRows + 1
62+ colOut = (width - kernelColumns) `div` strideColumns + 1
126 kernelSize = kernelRows * kernelColumns
63 kernelSize = kernelRows * kernelColumns
127− numberOfPatches = length starts
64+ numberOfPatches = rowOut * colOut
128− channels = length dataVid
65+ in unsafePerformIO $ do
129−
66+ outPtr <- mallocForeignPtrArray0 (numberOfPatches * kernelSize * channels)
130− dataCol <- U.newMatrix 0 numberOfPatches (channels * kernelSize)
67+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
131
68
132− offsetC <- newSTRef 0
69+ withForeignPtr inPtr $ \inPtr' ->
70+ withForeignPtr outPtr $ \outPtr' ->
71+ im2col_cpu inPtr' inOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
133
72
134− forM_ dataVid $ \dataIm -> do
73+ let matVec = U.unsafeFromForeignPtr outPtr 0 (numberOfPatches * kernelSize * channels)
135− inputRowRef <- newSTRef 0
74+ return $ U.matrixFromVector U.RowMajor numberOfPatches (kernelSize * channels) matVec
136− offsetC' <- readSTRef offsetC
137− forM_ starts $ \(startRow, startCol) -> do
138− inputColumnRef <- newSTRef 0
139− inputRow <- readSTRef inputRowRef
140− forM_ [startRow .. startRow + kernelRows -1] $ \kr ->
141− forM_ [startCol .. startCol + kernelColumns -1] $ \kc -> do
142− inputColumn <- readSTRef inputColumnRef
143− unsafeModifyMatrix dataCol inputRow (inputColumn + offsetC') (+ U.atM' dataIm kr kc)
144− modifySTRef' inputColumnRef (+1)
145− modifySTRef' inputRowRef (+1)
146
75
147− modifySTRef' offsetC (+ kernelSize)
76+foreign import ccall unsafe
148−
77+ im2col_cpu
149− return dataCol
150−
151−im2colUnsafe :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
152−im2colUnsafe kernelRows kernelColumns striderows stridecols dataIm = U.runSTMatrix $ do
153− let starts = fittingStarts (rows dataIm) kernelRows striderows (cols dataIm) kernelColumns stridecols
154− kernelSize = kernelRows * kernelColumns
155− numberOfPatches = length starts
156−
157− dataCol <- U.newMatrix 0 numberOfPatches kernelSize
158−
159− inputRowRef <- newSTRef 0
160− forM_ starts $ \(startRow, startCol) -> do
161− inputColumnRef <- newSTRef 0
162− inputRow <- readSTRef inputRowRef
163− forM_ [startRow .. startRow + kernelRows -1] $ \kr ->
164− forM_ [startCol .. startCol + kernelColumns -1] $ \kc -> do
165− inputColumn <- readSTRef inputColumnRef
166− unsafeModifyMatrix dataCol inputRow inputColumn (+ U.atM' dataIm kr kc)
167− modifySTRef' inputColumnRef (+1)
168− modifySTRef' inputRowRef (+1)
169−
170− return dataCol
171−
172−unsafeModifyMatrix :: (Storable t) => U.STMatrix s t -> Int -> Int -> (t -> t) -> ST s ()
173−unsafeModifyMatrix x r c f = U.unsafeReadMatrix x r c >>= U.unsafeWriteMatrix x r c . f
174−{-# INLINE unsafeModifyMatrix #-}
175−
176−
177−-- | Returns the starting sub matrix locations which fit inside the larger matrix for the
178−-- convolution. Takes into account the stride and kernel size.
179−fittingStarts :: Int -> Int -> Int -> Int -> Int -> Int -> [(Int,Int)]
78+ :: Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
180−fittingStarts nrows kernelrows steprows ncols kernelcols stepcolsh =
181− let rs = fittingStart nrows kernelrows steprows
182− cs = fittingStart ncols kernelcols stepcolsh
183− in concatMap ( \r -> fmap (\c -> (r , c)) cs ) rs
184−
185−-- | Returns the starting sub vector which fit inside the larger vector for the
186−-- convolution. Takes into account the stride and kernel size.
187−fittingStart :: Int -> Int -> Int -> [Int]
188−fittingStart width kernel steps =
189− let go left | left + kernel < width
190− = left : go (left + steps)
191− | left + kernel == width
192− = [left]
193− | otherwise
194− = []
195− in go 0
src/Grenade/Layers/Internal/Pooling.hs+47−61
@@ -1,69 +1,55 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
1module Grenade.Layers.Internal.Pooling (
2module Grenade.Layers.Internal.Pooling (
2 poolForward
3 poolForward
3 , poolBackward
4 , poolBackward
4− , poolForwardList
5− , poolBackwardList
6 ) where
5 ) where
7
6
8−import Data.Foldable ( forM_ )
7+import Foreign ( mallocForeignPtrArray0, withForeignPtr )
9−import Data.Function ( on )
8+import Foreign.Ptr ( Ptr )
10−import Data.List ( maximumBy )
11
9
12−import Numeric.LinearAlgebra hiding ( uniformSample, konst )
10+import Numeric.LinearAlgebra ( Matrix , flatten )
13−import qualified Numeric.LinearAlgebra as LA
14import qualified Numeric.LinearAlgebra.Devel as U
11import qualified Numeric.LinearAlgebra.Devel as U
15
12
16−import Grenade.Layers.Internal.Convolution
13+import System.IO.Unsafe ( unsafePerformIO )
17−
14+
18−poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
15+poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
19−poolForward nrows ncols srows scols outputRows outputCols m =
16+poolForward channels height width kernelRows kernelColumns strideRows strideColumns dataIm =
20− let starts = fittingStarts (rows m) nrows srows (cols m) ncols scols
17+ let vec = flatten dataIm
21− in poolForwardFit starts nrows ncols outputRows outputCols m
18+ rowOut = (height - kernelRows) `div` strideRows + 1
22−
19+ colOut = (width - kernelColumns) `div` strideColumns + 1
23−poolForwardList :: Functor f => Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> f (Matrix Double) -> f (Matrix Double)
20+ numberOfPatches = rowOut * colOut
24−poolForwardList nrows ncols srows scols inRows inCols outputRows outputCols ms =
21+ in unsafePerformIO $ do
25− let starts = fittingStarts inRows nrows srows inCols ncols scols
22+ outPtr <- mallocForeignPtrArray0 (numberOfPatches * channels)
26− in poolForwardFit starts nrows ncols outputRows outputCols <$> ms
23+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
27−
24+
28−poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
25+ withForeignPtr inPtr $ \inPtr' ->
29−poolForwardFit starts nrows ncols _ outputCols m =
26+ withForeignPtr outPtr $ \outPtr' ->
30− let els = fmap (\start -> unsafeMaxElementSubmatrix start (nrows, ncols) m) starts
27+ pool_forwards_cpu inPtr' inOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
31− in LA.matrix outputCols els
28+
32−
29+ let matVec = U.unsafeFromForeignPtr outPtr 0 (numberOfPatches * channels)
30+ return $ U.matrixFromVector U.RowMajor (rowOut * channels) colOut matVec
31+
32+foreign import ccall unsafe
33+ pool_forwards_cpu
34+ :: Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
35+
33−poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
36+poolBackward :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
34−poolBackward krows kcols srows scols inputMatrix gradientMatrix =
37+poolBackward channels height width kernelRows kernelColumns strideRows strideColumns dataCol dataGrad =
35− let inRows = rows inputMatrix
38+ let vecIm = flatten dataCol
36− inCols = cols inputMatrix
39+ vecGrad = flatten dataGrad
37− starts = fittingStarts inRows krows srows inCols kcols scols
40+ in unsafePerformIO $ do
38− in poolBackwardFit starts krows kcols inputMatrix gradientMatrix
41+ outPtr <- mallocForeignPtrArray0 (height * width * channels)
39−
42+ let (imPtr, imOffset, _) = U.unsafeToForeignPtr vecIm
40−poolBackwardList :: Functor f => Int -> Int -> Int -> Int -> Int -> Int -> f (Matrix Double, Matrix Double) -> f (Matrix Double)
43+ let (gradPtr, gradOffset, _) = U.unsafeToForeignPtr vecGrad
41−poolBackwardList krows kcols srows scols inRows inCols inputMatrices =
44+
42− let starts = fittingStarts inRows krows srows inCols kcols scols
45+ withForeignPtr imPtr $ \imPtr' ->
43− in uncurry (poolBackwardFit starts krows kcols) <$> inputMatrices
46+ withForeignPtr gradPtr $ \gradPtr' ->
44−
47+ withForeignPtr outPtr $ \outPtr' ->
45−poolBackwardFit :: [(Int,Int)] -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
48+ pool_backwards_cpu imPtr' imOffset gradPtr' gradOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
46−poolBackwardFit starts krows kcols inputMatrix gradientMatrix = U.runSTMatrix $ do
49+
47− let inRows = rows inputMatrix
50+ let matVec = U.unsafeFromForeignPtr outPtr 0 (height * width * channels)
48− inCols = cols inputMatrix
51+ return $ U.matrixFromVector U.RowMajor (height * channels) width matVec
49− gradCol = cols gradientMatrix
52+
50− extent = (krows, kcols)
53+foreign import ccall unsafe
51−
54+ pool_backwards_cpu
52− retM <- U.newMatrix 0 inRows inCols
55+ :: Ptr Double -> Int -> Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
53−
54− forM_ (zip [0..] starts) $ \(ix, start) -> do
55− let loc = unsafeMaxIndexSubMatrix start extent inputMatrix
56− uncurry (unsafeModifyMatrix retM) loc ((+) $ uncurry (U.atM' gradientMatrix) $ divMod ix gradCol)
57−
58− return retM
59−
60−unsafeMaxElementSubmatrix :: (Int,Int) -> (Int,Int) -> Matrix Double -> Double
61−unsafeMaxElementSubmatrix starts extent m = uncurry (U.atM' m) $ unsafeMaxIndexSubMatrix starts extent m
62−
63−unsafeMaxIndexSubMatrix :: (Int,Int) -> (Int,Int) -> Matrix Double -> (Int, Int)
64−unsafeMaxIndexSubMatrix (startRow, startCol) (extentRow, extentCold) m =
65− let mrows = [startRow .. startRow + extentRow - 1]
66− mcols = [startCol .. startCol + extentCold - 1]
67− pairs = concatMap ( \r -> fmap (\c -> (r , c)) mcols ) mrows
68− in maximumBy (compare `on` uncurry (U.atM' m)) pairs
69−
src/Grenade/Layers/Logit.hs+2−3
@@ -12,7 +12,6 @@ module Grenade.Layers.Logit (
12
12
13import Data.Singletons.TypeLits
13import Data.Singletons.TypeLits
14import Grenade.Core.Network
14import Grenade.Core.Network
15−import Grenade.Core.Vector
16import Grenade.Core.Shape
15import Grenade.Core.Shape
17
16
18-- | A Logit layer.
17-- | A Logit layer.
@@ -36,8 +35,8 @@ instance (KnownNat i, KnownNat j) => Layer Logit ('D2 i j) ('D2 i j) where
36 runBackwards _ (S2D' y) (S2D' dEdy) = ((), S2D' (logistic' y * dEdy))
35 runBackwards _ (S2D' y) (S2D' dEdy) = ((), S2D' (logistic' y * dEdy))
37
36
38instance (KnownNat i, KnownNat j, KnownNat k) => Layer Logit ('D3 i j k) ('D3 i j k) where
37instance (KnownNat i, KnownNat j, KnownNat k) => Layer Logit ('D3 i j k) ('D3 i j k) where
39− runForwards _ (S3D' y) = S3D' (fmap logistic y)
38+ runForwards _ (S3D' y) = S3D' (logistic y)
40− runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (vectorZip (\y' dEdy' -> logistic' y' * dEdy') y dEdy))
39+ runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (logistic' y * dEdy))
41
40
42
41
43logistic :: Floating a => a -> a
42logistic :: Floating a => a -> a
src/Grenade/Layers/Pooling.hs+19−17
@@ -21,7 +21,6 @@ import GHC.TypeLits
21
21
22import Grenade.Core.Network
22import Grenade.Core.Network
23import Grenade.Core.Shape
23import Grenade.Core.Shape
24−import Grenade.Core.Vector
25import Grenade.Layers.Internal.Pooling
24import Grenade.Layers.Internal.Pooling
26
25
27import Numeric.LinearAlgebra.Static as LAS hiding ((|||), build, toRows)
26import Numeric.LinearAlgebra.Static as LAS hiding ((|||), build, toRows)
@@ -57,24 +56,26 @@ instance ( KnownNat kernelRows
57 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)
56 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)
58 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) where
57 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) where
59 runForwards Pooling (S2D' input) =
58 runForwards Pooling (S2D' input) =
59+ let height = fromIntegral $ natVal (Proxy :: Proxy inputRows)
60+ width = fromIntegral $ natVal (Proxy :: Proxy inputColumns)
60− let kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
61+ kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
61 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
62 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
62 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
63 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
63 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
64 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
64− ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
65− oy = fromIntegral $ natVal (Proxy :: Proxy outputColumns)
66 ex = extract input
65 ex = extract input
67− r = poolForward kx ky sx sy ox oy $ ex
66+ r = poolForward 1 height width kx ky sx sy ex
68 rs = fromJust . create $ r
67 rs = fromJust . create $ r
69 in S2D' $ rs
68 in S2D' $ rs
70 runBackwards Pooling (S2D' input) (S2D' dEdy) =
69 runBackwards Pooling (S2D' input) (S2D' dEdy) =
70+ let height = fromIntegral $ natVal (Proxy :: Proxy inputRows)
71+ width = fromIntegral $ natVal (Proxy :: Proxy inputColumns)
71− let kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
72+ kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
72 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
73 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
73 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
74 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
74 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
75 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
75 ex = extract input
76 ex = extract input
76 eo = extract dEdy
77 eo = extract dEdy
77− vs = poolBackward kx ky sx sy ex eo
78+ vs = poolBackward 1 height width kx ky sx sy ex eo
78 in ((), S2D' . fromJust . create $ vs)
79 in ((), S2D' . fromJust . create $ vs)
79
80
80
81
@@ -87,6 +88,8 @@ instance ( KnownNat kernelRows
87 , KnownNat inputColumns
88 , KnownNat inputColumns
88 , KnownNat outputRows
89 , KnownNat outputRows
89 , KnownNat outputColumns
90 , KnownNat outputColumns
91+ , KnownNat channels
92+ , KnownNat (outputRows * channels)
90 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
93 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
91 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)
94 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)
92 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D3 inputRows inputColumns channels) ('D3 outputRows outputColumns channels) where
95 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D3 inputRows inputColumns channels) ('D3 outputRows outputColumns channels) where
@@ -97,11 +100,10 @@ instance ( KnownNat kernelRows
97 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
100 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
98 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
101 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
99 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
102 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
100− ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
101− oy = fromIntegral $ natVal (Proxy :: Proxy outputColumns)
103+ ch = fromIntegral $ natVal (Proxy :: Proxy channels)
102− ex = fmap extract input
104+ ex = extract input
103− r = poolForwardList kx ky sx sy ix iy ox oy ex
105+ r = poolForward ch ix iy kx ky sx sy ex
104− rs = fmap (fromJust . create) r
106+ rs = fromJust . create $ r
105 in S3D' rs
107 in S3D' rs
106 runBackwards Pooling (S3D' input) (S3D' dEdy) =
108 runBackwards Pooling (S3D' input) (S3D' dEdy) =
107 let ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
109 let ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
@@ -110,8 +112,8 @@ instance ( KnownNat kernelRows
110 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
112 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
111 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
113 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
112 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
114 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
115+ ch = fromIntegral $ natVal (Proxy :: Proxy channels)
113− ex = fmap extract input
116+ ex = extract input
114− eo = fmap extract dEdy
117+ eo = extract dEdy
115− ez = vectorZip (,) ex eo
118+ vs = poolBackward ch ix iy kx ky sx sy ex eo
116− vs = poolBackwardList kx ky sx sy ix iy ez
117− in ((), S3D' . fmap (fromJust . create) $ vs)
119+ in ((), S3D' . fromJust . create $ vs)
src/Grenade/Layers/Relu.hs+2−3
@@ -10,7 +10,6 @@ module Grenade.Layers.Relu (
10 ) where
10 ) where
11
11
12import GHC.TypeLits
12import GHC.TypeLits
13−import Grenade.Core.Vector
14import Grenade.Core.Network
13import Grenade.Core.Network
15import Grenade.Core.Shape
14import Grenade.Core.Shape
16
15
@@ -44,9 +43,9 @@ instance (KnownNat i, KnownNat j) => Layer Relu ('D2 i j) ('D2 i j) where
44 relu' = LAS.dmmap (\a -> if a <= 0 then 0 else 1)
43 relu' = LAS.dmmap (\a -> if a <= 0 then 0 else 1)
45
44
46instance (KnownNat i, KnownNat j, KnownNat k) => Layer Relu ('D3 i j k) ('D3 i j k) where
45instance (KnownNat i, KnownNat j, KnownNat k) => Layer Relu ('D3 i j k) ('D3 i j k) where
47− runForwards _ (S3D' y) = S3D' (fmap relu y)
46+ runForwards _ (S3D' y) = S3D' (relu y)
48 where
47 where
49 relu = LAS.dmmap (\a -> if a <= 0 then 0 else a)
48 relu = LAS.dmmap (\a -> if a <= 0 then 0 else a)
50− runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (vectorZip (\y' dEdy' -> relu' y' * dEdy') y dEdy))
49+ runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (relu' y * dEdy))
51 where
50 where
52 relu' = LAS.dmmap (\a -> if a <= 0 then 0 else 1)
51 relu' = LAS.dmmap (\a -> if a <= 0 then 0 else 1)
src/Grenade/Layers/Tanh.hs+2−3
@@ -10,7 +10,6 @@ module Grenade.Layers.Tanh (
10 ) where
10 ) where
11
11
12import GHC.TypeLits
12import GHC.TypeLits
13−import Grenade.Core.Vector
14import Grenade.Core.Network
13import Grenade.Core.Network
15import Grenade.Core.Shape
14import Grenade.Core.Shape
16
15
@@ -33,8 +32,8 @@ instance (KnownNat i, KnownNat j) => Layer Tanh ('D2 i j) ('D2 i j) where
33 runBackwards _ (S2D' y) (S2D' dEdy) = ((), S2D' (tanh' y * dEdy))
32 runBackwards _ (S2D' y) (S2D' dEdy) = ((), S2D' (tanh' y * dEdy))
34
33
35instance (KnownNat i, KnownNat j, KnownNat k) => Layer Tanh ('D3 i j k) ('D3 i j k) where
34instance (KnownNat i, KnownNat j, KnownNat k) => Layer Tanh ('D3 i j k) ('D3 i j k) where
36− runForwards _ (S3D' y) = S3D' (fmap tanh y)
35+ runForwards _ (S3D' y) = S3D' (tanh y)
37− runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (vectorZip (\y' dEdy' -> tanh' y' * dEdy') y dEdy))
36+ runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (tanh' y * dEdy))
38
37
39tanh' :: (Floating a) => a -> a
38tanh' :: (Floating a) => a -> a
40tanh' t = 1 - s ^ (2 :: Int) where s = tanh t
39tanh' t = 1 - s ^ (2 :: Int) where s = tanh t
test/Test/Grenade/Layers/Convolution.hs+50−76
@@ -5,7 +5,6 @@
5module Test.Grenade.Layers.Convolution where
5module Test.Grenade.Layers.Convolution where
6
6
7import Grenade.Core.Shape
7import Grenade.Core.Shape
8−import Grenade.Core.Vector as Grenade
9import Grenade.Core.Network
8import Grenade.Core.Network
10import Grenade.Layers.Convolution
9import Grenade.Layers.Convolution
11import Grenade.Layers.Internal.Convolution
10import Grenade.Layers.Internal.Convolution
@@ -27,7 +26,7 @@ prop_im2col_no_stride = once $
27 , 5.0, 6.0, 9.0, 10.0
26 , 5.0, 6.0, 9.0, 10.0
28 , 6.0, 7.0, 10.0, 11.0
27 , 6.0, 7.0, 10.0, 11.0
29 , 7.0, 8.0, 11.0, 12.0 ]
28 , 7.0, 8.0, 11.0, 12.0 ]
30− out = im2colUnsafe 2 2 1 1 input
29+ out = im2col 2 2 1 1 input
31 in expected === out
30 in expected === out
32
31
33prop_im2col_stride = once $
32prop_im2col_stride = once $
@@ -40,7 +39,7 @@ prop_im2col_stride = once $
40 , 3.0, 4.0, 7.0, 8.0
39 , 3.0, 4.0, 7.0, 8.0
41 , 5.0, 6.0, 9.0, 10.0
40 , 5.0, 6.0, 9.0, 10.0
42 , 7.0, 8.0, 11.0, 12.0 ]
41 , 7.0, 8.0, 11.0, 12.0 ]
43− out = im2colUnsafe 2 2 1 2 input
42+ out = im2col 2 2 1 2 input
44 in expected === out
43 in expected === out
45
44
46prop_im2col_other = once $
45prop_im2col_other = once $
@@ -51,7 +50,7 @@ prop_im2col_other = once $
51 expected = (2><6)
50 expected = (2><6)
52 [ 1.0, 2.0, 5.0, 6.0 , 9.0, 10.0
51 [ 1.0, 2.0, 5.0, 6.0 , 9.0, 10.0
53 , 3.0, 4.0, 7.0, 8.0 , 11.0 ,12.0 ]
52 , 3.0, 4.0, 7.0, 8.0 , 11.0 ,12.0 ]
54− out = im2colUnsafe 3 2 1 2 input
53+ out = im2col 3 2 1 2 input
55 in expected === out
54 in expected === out
56
55
57-- If there's no overlap (stride is the same size as the kernel)
56-- If there's no overlap (stride is the same size as the kernel)
@@ -61,20 +60,9 @@ prop_im2col_sym_on_same_stride = once $
61 [ 1.0, 2.0, 3.0, 4.0
60 [ 1.0, 2.0, 3.0, 4.0
62 , 5.0, 6.0, 7.0, 8.0
61 , 5.0, 6.0, 7.0, 8.0
63 , 9.0, 10.0, 11.0, 12.0 ]
62 , 9.0, 10.0, 11.0, 12.0 ]
64− out = col2imUnsafe 3 2 3 2 3 4 . im2colUnsafe 3 2 3 2 $ input
63+ out = col2im 3 2 3 2 3 4 . im2col 3 2 3 2 $ input
65 in input === out
64 in input === out
66
65
67−-- If there's no overlap (stride is the same size as the kernel)
68−-- then col2im . im2col should be symmetric.
69−prop_im2colunsafe_sym_on_same_stride = once $
70− let input = (3><4)
71− [ 1.0, 2.0, 3.0, 4.0
72− , 5.0, 6.0, 7.0, 8.0
73− , 9.0, 10.0, 11.0, 12.0 ]
74− out = col2imUnsafe 3 2 3 2 3 4 . im2colUnsafe 3 2 3 2 $ input
75− in input === out
76−
77−
78-- If there is an overlap, then the gradient passed back should be
66-- If there is an overlap, then the gradient passed back should be
79-- the sum of the gradients across the filters.
67-- the sum of the gradients across the filters.
80prop_im2col_col2im_additive = once $
68prop_im2col_col2im_additive = once $
@@ -86,7 +74,7 @@ prop_im2col_col2im_additive = once $
86 [ 1.0, 2.0, 2.0, 1.0
74 [ 1.0, 2.0, 2.0, 1.0
87 , 2.0, 4.0, 4.0, 2.0
75 , 2.0, 4.0, 4.0, 2.0
88 , 1.0, 2.0, 2.0, 1.0 ]
76 , 1.0, 2.0, 2.0, 1.0 ]
89− out = col2imUnsafe 2 2 1 1 3 4 . im2colUnsafe 2 2 1 1 $ input
77+ out = col2im 2 2 1 1 3 4 . im2col 2 2 1 1 $ input
90 in expected === out
78 in expected === out
91
79
92prop_simple_conv_forwards = once $
80prop_simple_conv_forwards = once $
@@ -116,25 +104,18 @@ prop_simple_conv_forwards = once $
116 [ 1.0, 2.0, 5.0
104 [ 1.0, 2.0, 5.0
117 , 3.0, 4.0, 6.0] :: HStatic.L 2 3)
105 , 3.0, 4.0, 6.0] :: HStatic.L 2 3)
118
106
119− expect = [ HStatic.matrix
107+ expect = HStatic.matrix
120− [ -3.0 , -4.0 ] :: HStatic.L 1 2
108+ [ -3.0 , -4.0
121− , HStatic.matrix
122− [ -1.0 , 1.0 ] :: HStatic.L 1 2
109+ , -1.0 , 1.0
123− , HStatic.matrix
124− [ 5.0 , 9.0 ] :: HStatic.L 1 2
110+ , 5.0 , 9.0
125− , HStatic.matrix
126− [ -7.0 , -10.0 ] :: HStatic.L 1 2] :: [HStatic.L 1 2]
111+ , -7.0 , -10.0 ] :: HStatic.L 4 2
127 out = runForwards convLayer input :: S' ('D3 1 2 4)
112 out = runForwards convLayer input :: S' ('D3 1 2 4)
128
113
129− grad = S3D' ( mkVector
130− [ HStatic.matrix
114+ grad = S3D' ( HStatic.matrix
131− [ 1 , 0 ] :: HStatic.L 1 2
115+ [ 1 , 0
132− , HStatic.matrix
116+ , 0 , 0
133− [ 0 , 0 ] :: HStatic.L 1 2
117+ , 0 , 0
134− , HStatic.matrix
135− [ 0 , 0 ] :: HStatic.L 1 2
136− , HStatic.matrix
137− [ 0 , 1 ] :: HStatic.L 1 2] ) :: S' ('D3 1 2 4)
118+ , 0 , 1 ] :: HStatic.L 4 2 ) :: S' ('D3 1 2 4)
138
119
139 expectBack = (HStatic.matrix
120 expectBack = (HStatic.matrix
140 [ 1.0, 0.0, 0.0
121 [ 1.0, 0.0, 0.0
@@ -143,19 +124,19 @@ prop_simple_conv_forwards = once $
143
124
144 in case (out, inX, nc) of
125 in case (out, inX, nc) of
145 (S3D' out' , S2D' inX', Convolution' backGrad)
126 (S3D' out' , S2D' inX', Convolution' backGrad)
146− -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
127+ -> (HStatic.extract expect === HStatic.extract out')
147 .&&. (HStatic.extract expectBack === HStatic.extract inX')
128 .&&. (HStatic.extract expectBack === HStatic.extract inX')
148 .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
129 .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
149
130
150prop_vid2col_no_stride = once $
131prop_vid2col_no_stride = once $
151− let input = [(3><4)
132+ let input = (6><4)
152 [ 1.0, 2.0, 3.0, 4.0
133 [ 1.0, 2.0, 3.0, 4.0
153 , 5.0, 6.0, 7.0, 8.0
134 , 5.0, 6.0, 7.0, 8.0
154− , 9.0, 10.0, 11.0, 12.0 ]
135+ , 9.0, 10.0, 11.0, 12.0
155− , (3><4)
136+ -- -- --
156− [ 21.0, 22.0, 23.0, 24.0
137+ , 21.0, 22.0, 23.0, 24.0
157 , 25.0, 26.0, 27.0, 28.0
138 , 25.0, 26.0, 27.0, 28.0
158− , 29.0, 30.0, 31.0, 32.0 ] ]
139+ , 29.0, 30.0, 31.0, 32.0 ]
159 expected = (6><8)
140 expected = (6><8)
160 [ 1.0, 2.0, 5.0, 6.0 , 21.0, 22.0, 25.0, 26.0
141 [ 1.0, 2.0, 5.0, 6.0 , 21.0, 22.0, 25.0, 26.0
161 , 2.0, 3.0, 6.0, 7.0 , 22.0, 23.0, 26.0, 27.0
142 , 2.0, 3.0, 6.0, 7.0 , 22.0, 23.0, 26.0, 27.0
@@ -163,36 +144,36 @@ prop_vid2col_no_stride = once $
163 , 5.0, 6.0, 9.0, 10.0 , 25.0, 26.0, 29.0, 30.0
144 , 5.0, 6.0, 9.0, 10.0 , 25.0, 26.0, 29.0, 30.0
164 , 6.0, 7.0, 10.0, 11.0 , 26.0, 27.0, 30.0, 31.0
145 , 6.0, 7.0, 10.0, 11.0 , 26.0, 27.0, 30.0, 31.0
165 , 7.0, 8.0, 11.0, 12.0 , 27.0, 28.0, 31.0, 32.0 ]
146 , 7.0, 8.0, 11.0, 12.0 , 27.0, 28.0, 31.0, 32.0 ]
166− out = vid2colUnsafe 2 2 1 1 3 4 input
147+ out_c = vid2col 2 2 1 1 3 4 input
167− in expected === out
148+ in expected === out_c
168
149
169prop_vid2col_stride = once $
150prop_vid2col_stride = once $
170− let input = [(3><4)
151+ let input = (6><4)
171 [ 1.0, 2.0, 3.0, 4.0
152 [ 1.0, 2.0, 3.0, 4.0
172 , 5.0, 6.0, 7.0, 8.0
153 , 5.0, 6.0, 7.0, 8.0
173− , 9.0, 10.0, 11.0, 12.0 ]
154+ , 9.0, 10.0, 11.0, 12.0
174− , (3><4)
155+ -- -- -- -- --
175− [ 21.0, 22.0, 23.0, 24.0
156+ , 21.0, 22.0, 23.0, 24.0
176 , 25.0, 26.0, 27.0, 28.0
157 , 25.0, 26.0, 27.0, 28.0
177− , 29.0, 30.0, 31.0, 32.0 ] ]
158+ , 29.0, 30.0, 31.0, 32.0 ]
178 expected = (4><8)
159 expected = (4><8)
179 [ 1.0, 2.0, 5.0, 6.0 , 21.0, 22.0, 25.0, 26.0
160 [ 1.0, 2.0, 5.0, 6.0 , 21.0, 22.0, 25.0, 26.0
180 , 3.0, 4.0, 7.0, 8.0 , 23.0, 24.0, 27.0, 28.0
161 , 3.0, 4.0, 7.0, 8.0 , 23.0, 24.0, 27.0, 28.0
181 , 5.0, 6.0, 9.0, 10.0 , 25.0, 26.0, 29.0, 30.0
162 , 5.0, 6.0, 9.0, 10.0 , 25.0, 26.0, 29.0, 30.0
182 , 7.0, 8.0, 11.0, 12.0 , 27.0, 28.0, 31.0, 32.0 ]
163 , 7.0, 8.0, 11.0, 12.0 , 27.0, 28.0, 31.0, 32.0 ]
183− out = vid2colUnsafe 2 2 1 2 3 4 input
164+ out_c = vid2col 2 2 1 2 3 4 input
184− in expected === out
165+ in expected === out_c
185
166
186prop_vid2col_invert = once $
167prop_vid2col_invert = once $
187− let input = [(3><4)
168+ let input = (6><4)
188 [ 1.0, 2.0, 3.0, 4.0
169 [ 1.0, 2.0, 3.0, 4.0
189 , 5.0, 6.0, 7.0, 8.0
170 , 5.0, 6.0, 7.0, 8.0
190− , 9.0, 10.0, 11.0, 12.0 ]
171+ , 9.0, 10.0, 11.0, 12.0
191− , (3><4)
172+ -- -- -- -- --
192− [ 21.0, 22.0, 23.0, 24.0
173+ , 21.0, 22.0, 23.0, 24.0
193 , 25.0, 26.0, 27.0, 28.0
174 , 25.0, 26.0, 27.0, 28.0
194− , 29.0, 30.0, 31.0, 32.0 ] ]
175+ , 29.0, 30.0, 31.0, 32.0 ]
195− out = col2vidUnsafe 3 2 3 2 3 4 . vid2colUnsafe 3 2 3 2 3 4 $ input
176+ out = col2vid 3 2 3 2 3 4 . vid2col 3 2 3 2 3 4 $ input
196 in input === out
177 in input === out
197
178
198
179
@@ -221,29 +202,22 @@ prop_single_conv_forwards = once $
221
202
222 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
203 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
223
204
224− input = S3D' ( mkVector [HStatic.matrix
205+ input = S3D' ( HStatic.matrix
225 [ 1.0, 2.0, 5.0
206 [ 1.0, 2.0, 5.0
226− , 3.0, 4.0, 6.0] :: HStatic.L 2 3] ) :: S' ('D3 2 3 1)
207+ , 3.0, 4.0, 6.0] :: HStatic.L 2 3 ) :: S' ('D3 2 3 1)
227
208
228− expect = [HStatic.matrix
209+ expect = HStatic.matrix
229− [ -3.0 , -4.0 ] :: HStatic.L 1 2
210+ [ -3.0 , -4.0
230− ,HStatic.matrix
231− [ -1.0 , 1.0 ] :: HStatic.L 1 2
211+ , -1.0 , 1.0
232− ,HStatic.matrix
233− [ 5.0 , 9.0 ] :: HStatic.L 1 2
212+ , 5.0 , 9.0
234− ,HStatic.matrix
235− [ -7.0 , -10.0 ] :: HStatic.L 1 2] :: [HStatic.L 1 2]
213+ , -7.0 , -10.0 ] :: HStatic.L 4 2
236 out = runForwards convLayer input :: S' ('D3 1 2 4)
214 out = runForwards convLayer input :: S' ('D3 1 2 4)
237
215
238− grad = S3D' ( mkVector
239− [HStatic.matrix
216+ grad = S3D' (HStatic.matrix
240− [ 1 , 0 ] :: HStatic.L 1 2
217+ [ 1 , 0
241− ,HStatic.matrix
218+ , 0 , 0
242− [ 0 , 0 ] :: HStatic.L 1 2
219+ , 0 , 0
243− ,HStatic.matrix
244− [ 0 , 0 ] :: HStatic.L 1 2
245− ,HStatic.matrix
246− [ 0 , 1 ] :: HStatic.L 1 2] ) :: S' ('D3 1 2 4)
220+ , 0 , 1 ] :: HStatic.L 4 2 ) :: S' ('D3 1 2 4)
247
221
248 expectBack = (HStatic.matrix
222 expectBack = (HStatic.matrix
249 [ 1.0, 0.0, 0.0
223 [ 1.0, 0.0, 0.0
@@ -252,8 +226,8 @@ prop_single_conv_forwards = once $
252
226
253 in case (out, inX, nc) of
227 in case (out, inX, nc) of
254 (S3D' out' , S3D' inX', Convolution' backGrad)
228 (S3D' out' , S3D' inX', Convolution' backGrad)
255− -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
229+ -> (HStatic.extract expect === HStatic.extract out')
256− .&&. ([HStatic.extract expectBack] === (HStatic.extract <$> vecToList inX'))
230+ .&&. (HStatic.extract expectBack === HStatic.extract inX')
257 .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
231 .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
258
232
259return []
233return []
test/Test/Grenade/Layers/Pooling.hs+20−4
@@ -18,7 +18,7 @@ prop_pool = once $
18 expected = (2><3)
18 expected = (2><3)
19 [ 14.0, 14.0, 8.0
19 [ 14.0, 14.0, 8.0
20 , 10.0, 11.0, 12.0 ]
20 , 10.0, 11.0, 12.0 ]
21− out = poolForward 2 2 1 1 2 3 input
21+ out = poolForward 1 3 4 2 2 1 1 input
22 in expected === out
22 in expected === out
23
23
24prop_pool_rectangular = once $
24prop_pool_rectangular = once $
@@ -29,7 +29,23 @@ prop_pool_rectangular = once $
29 expected = (2><2)
29 expected = (2><2)
30 [ 14.0, 14.0
30 [ 14.0, 14.0
31 , 11.0, 12.0 ]
31 , 11.0, 12.0 ]
32− out = poolForward 2 3 1 1 2 2 input
32+ out = poolForward 1 3 4 2 3 1 1 input
33+ in expected === out
34+
35+prop_pool_channels = once $
36+ let input = (6><4)
37+ [ 1.0, 14.0, 3.0, 4.0
38+ , 5.0, 6.0, 7.0, 8.0
39+ , 9.0, 10.0, 11.0, 12.0
40+ , 1.0, 2.0, 3.0, 4.0
41+ , 5.0, 6.0, 7.0, 8.0
42+ , 9.0, 10.0, 11.0, 12.0 ]
43+ expected = (4><2)
44+ [ 14.0, 14.0
45+ , 11.0, 12.0
46+ , 7.0, 8.0
47+ , 11.0, 12.0 ]
48+ out = poolForward 2 3 4 2 3 1 1 input
33 in expected === out
49 in expected === out
34
50
35prop_pool_backwards = once $
51prop_pool_backwards = once $
@@ -44,7 +60,7 @@ prop_pool_backwards = once $
44 [ 0.0, 0.0, 0.0, 0.0
60 [ 0.0, 0.0, 0.0, 0.0
45 , 0.0, -6.0, -7.0, -8.0
61 , 0.0, -6.0, -7.0, -8.0
46 , 0.0,-10.0,-11.0,-12.0 ]
62 , 0.0,-10.0,-11.0,-12.0 ]
47− out = poolBackward 2 2 1 1 input grads
63+ out = poolBackward 1 3 4 2 2 1 1 input grads
48 in expected === out
64 in expected === out
49
65
50prop_pool_backwards_additive = once $
66prop_pool_backwards_additive = once $
@@ -59,7 +75,7 @@ prop_pool_backwards_additive = once $
59 [-6.0, 0.0, 0.0, 0.0
75 [-6.0, 0.0, 0.0, 0.0
60 , 0.0, 0.0,-18.0,-20.0
76 , 0.0, 0.0,-18.0,-20.0
61 ,-10.0, 0.0, 0.0, 0.0 ]
77 ,-10.0, 0.0, 0.0, 0.0 ]
62− out = poolBackward 2 2 1 1 input grads
78+ out = poolBackward 1 3 4 2 2 1 1 input grads
63 in expected === out
79 in expected === out
64
80
65return []
81return []