git.iko.soy/grenade
on master help sign in
Merge pull request #16 from HuwCampbell/topic/performance

Topic/performance

commitfc958630c4a18508c9b093e4d0e1fa2ff73c6e77 authorHuw Campbell <huw.campbell@gmail.com> dateTue 13 Dec 2016, 11:01 (10 years ago) parentc0bb69dbacfa81
20 files changed+490−476
compare with master
unifiedsplit
README.md+21−16 bench/bench.hs+26 cbits/im2col.c+134 cbits/im2col.h+24 grenade.cabal+26−1 main/feedforward.hs+4−3 main/mnist.hs+4−3 src/Grenade.hs−1 src/Grenade/Core/Shape.hs+14−9 src/Grenade/Core/Vector.hs−53 src/Grenade/Layers/Convolution.hs+21−20 src/Grenade/Layers/Flatten.hs+6−18 src/Grenade/Layers/Internal/Convolution.hs+68−185 src/Grenade/Layers/Internal/Pooling.hs+47−61 src/Grenade/Layers/Logit.hs+2−3 src/Grenade/Layers/Pooling.hs+19−17 src/Grenade/Layers/Relu.hs+2−3 src/Grenade/Layers/Tanh.hs+2−3 test/Test/Grenade/Layers/Convolution.hs+50−76 test/Test/Grenade/Layers/Pooling.hs+20−4
README.md+21−16
@@ -10,21 +10,22 @@ Five is right out.
1010
1111💣 Machine learning which might blow up in your face 💣
1212
13−Grenade is a dependently typed, practical, and pretty quick neural network
14−library for concise and precise specifications of complex networks in Haskell.
13+Grenade is a dependently typed, practical, and fast neural network library for
14+concise and precise specifications of complex networks in Haskell.
1515
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
1717specified and initialised with random weights in a few lines of code with
1818```haskell
19−randomMnist :: MonadRandom m
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])
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+
22+randomMnist :: MonadRandom m => m MNIST
2223randomMnist = randomNetwork
2324```
2425
25−And that's it. Because the types contain all the information we need, there's
26−no specific term level code required; although it is of course possible and
27−easy to build one oneself.
26+And that's it. Because the types are rich, there's no specific term level code
27+required; although it is of course possible and easy to construct one explicitly
28+oneself.
2829
2930The network can be thought of as a heterogeneous list of layers, where its type
3031includes not only the layers of the network, but also the shapes of data that
@@ -36,6 +37,9 @@ data Network :: [*] -> [Shape] -> * where
3637 (:~>) :: Layer x i h => !x -> !(Network xs (h ': hs)) -> Network (x ': xs) (i ': h ': hs)
3738```
3839
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+
3943In the above example, the input layer can be seen to be a two dimensional (`D2`),
4044image with 28 by 28 pixels. When the first *Convolution* layer runs, it outputs
4145a 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.
96100
97101Performance
98102-----------
99−Grenade is backed by hmatrix and blas, and uses a pretty clever convolution
100−trick popularised by Caffe, which is surprisingly effective and fast. So for many
101−small scale problems it should be sufficient.
103+Grenade is backed by hmatrix, BLAS, and LAPACK, with critical functions optimised
104+in C. Using the im2col trick popularised by Caffe, it should be sufficient for
105+many problems.
102106
103−Being purely functional, it's probably pretty easy to parallelise and batch up.
104−My current examples however are single threaded.
107+Being purely functional, it should also be easy to run batches in parallel, which
108+would be appropriate for larger networks, my current examples however are single
109+threaded.
105110
106−Training 15 generations over Kaggle's 42000 sample MNIST training set took under
107−an hour, achieving 0.5% error rate on a 1000 sample holdout set.
111+Training 15 generations over Kaggle's 41000 sample MNIST training set on a single
112+core took around 12 minutes, achieving 1.5% error rate on a 1000 sample holdout set.
108113
109114Contributing
110115------------
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
1010build-type: Simple
1111description: grenade.
1212
13+extra-source-files:
14+ cbits/im2col.h
15+ cbits/im2col.c
16+
1317library
1418 build-depends:
1519 base >= 4.8 && < 5
@@ -35,7 +39,6 @@ library
3539 exposed-modules:
3640 Grenade
3741 Grenade.Core.Network
38− Grenade.Core.Vector
3942 Grenade.Core.Runner
4043 Grenade.Core.Shape
4144 Grenade.Layers.Crop
@@ -53,6 +56,10 @@ library
5356 Grenade.Layers.Internal.Convolution
5457 Grenade.Layers.Internal.Pooling
5558
59+ includes: cbits/im2col.h
60+ c-sources: cbits/im2col.c
61+
62+ cc-options: -std=c99 -O3 -msse4.2 -Wall -Werror -DCABAL=1
5663
5764executable feedforward
5865 ghc-options: -Wall -threaded -O2
@@ -104,3 +111,21 @@ test-suite test
104111 , text == 1.2.*
105112 , QuickCheck >= 2.7 && < 2.9
106113 , 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
2424-- between the shapes, so inference can't do it all for us.
2525
2626-- 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 ]
29− '[ 'D1 2, 'D1 40, 'D1 40, 'D1 10, 'D1 10, 'D1 1, 'D1 1])
27+type FFNet = Network '[ FullyConnected 2 40, Tanh, FullyConnected 40 10, Relu, FullyConnected 10 1, Logit ]
28+ '[ 'D1 2, 'D1 40, 'D1 40, 'D1 10, 'D1 10, 'D1 1, 'D1 1]
29+
30+randomNet :: MonadRandom m => m FFNet
3031randomNet = randomNetwork
3132
3233netTest :: MonadRandom m => LearningParameters -> Int -> m String
main/mnist.hs+4−3
@@ -32,9 +32,10 @@ import Grenade
3232
3333-- With the mnist data from Kaggle normalised to doubles between 0 and 1, learning rate of 0.01 and 15 iterations,
3434-- this network should get down to about a 1.3% error rate.
35−randomMnist :: MonadRandom m
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])
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+
38+randomMnist :: MonadRandom m => m MNIST
3839randomMnist = randomNetwork
3940
4041convTest :: Int -> FilePath -> FilePath -> LearningParameters -> ExceptT String IO ()
src/Grenade.hs−1
@@ -2,7 +2,6 @@ module Grenade (
22 module X
33 ) where
44
5−import Grenade.Core.Vector as X
65import Grenade.Core.Network as X
76import Grenade.Core.Runner as X
87import Grenade.Core.Shape as X
src/Grenade/Core/Shape.hs+14−9
@@ -19,10 +19,10 @@ module Grenade.Core.Shape (
1919 ) where
2020
2121import Data.Singletons.TypeLits
22+import GHC.TypeLits
2223
2324import Numeric.LinearAlgebra.Static
2425
25−import Grenade.Core.Vector
2626
2727-- | The current shapes we accept.
2828-- at the moment this is just one, two, and three dimensional
@@ -35,34 +35,39 @@ data Shape =
3535instance Num (S' x) where
3636 (+) (S1D' x) (S1D' y) = S1D' (x + y)
3737 (+) (S2D' x) (S2D' y) = S2D' (x + y)
38− (+) (S3D' x) (S3D' y) = S3D' (vectorZip (+) x y)
38+ (+) (S3D' x) (S3D' y) = S3D' (x + y)
3939 (+) _ _ = error "Impossible to have different constructors for the same shaped network"
4040
4141 (-) (S1D' x) (S1D' y) = S1D' (x - y)
4242 (-) (S2D' x) (S2D' y) = S2D' (x - y)
43− (-) (S3D' x) (S3D' y) = S3D' (vectorZip (-) x y)
43+ (-) (S3D' x) (S3D' y) = S3D' (x - y)
4444 (-) _ _ = error "Impossible to have different constructors for the same shaped network"
4545
4646 (*) (S1D' x) (S1D' y) = S1D' (x * y)
4747 (*) (S2D' x) (S2D' y) = S2D' (x * y)
48− (*) (S3D' x) (S3D' y) = S3D' (vectorZip (*) x y)
48+ (*) (S3D' x) (S3D' y) = S3D' (x * y)
4949 (*) _ _ = error "Impossible to have different constructors for the same shaped network"
5050
5151 abs (S1D' x) = S1D' (abs x)
5252 abs (S2D' x) = S2D' (abs x)
53− abs (S3D' x) = S3D' (fmap abs x)
53+ abs (S3D' x) = S3D' (abs x)
5454
5555 signum (S1D' x) = S1D' (signum x)
5656 signum (S2D' x) = S2D' (signum x)
57− signum (S3D' x) = S3D' (fmap signum x)
57+ signum (S3D' x) = S3D' (signum x)
5858
5959 fromInteger _ = error "Unimplemented: fromInteger on Shape"
6060
6161-- | 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.
6264data S' (n :: Shape) where
63− S1D' :: (KnownNat o) => R o -> S' ('D1 o)
64− S2D' :: (KnownNat rows, KnownNat columns) => L rows columns -> S' ('D2 rows columns)
65− S3D' :: (KnownNat rows, KnownNat columns, KnownNat depth) => Vector depth (L rows columns) -> S' ('D3 rows columns depth)
65+ S1D' :: ( KnownNat o ) => R o -> S' ('D1 o)
66+ S2D' :: ( KnownNat rows, KnownNat columns ) => L rows columns -> S' ('D2 rows columns)
67+ S3D' :: ( KnownNat rows
68+ , KnownNat columns
69+ , KnownNat depth
70+ , KnownNat (rows * depth)) => L (rows * depth) columns -> S' ('D3 rows columns depth)
6671
6772instance Show (S' n) where
6873 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)
3030
3131import Grenade.Core.Network
3232import Grenade.Core.Shape
33−import Grenade.Core.Vector
3433import Grenade.Layers.Internal.Convolution
3534
3635-- | A convolution layer for a neural network.
@@ -145,6 +144,7 @@ instance ( KnownNat kernelRows
145144 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
146145 , ((outputCols - 1) * strideCols) ~ (inputCols - kernelCols)
147146 , KnownNat (kernelRows * kernelCols * 1)
147+ , KnownNat (outputRows * filters)
148148 ) => Layer (Convolution 1 filters kernelRows kernelCols strideRows strideCols) ('D2 inputRows inputCols) ('D3 outputRows outputCols filters) where
149149 runForwards (Convolution kernel _) (S2D' input) =
150150 let ex = extract input
@@ -155,11 +155,11 @@ instance ( KnownNat kernelRows
155155 sy = fromIntegral $ natVal (Proxy :: Proxy strideCols)
156156 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
157157 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
158− c = im2colUnsafe kx ky sx sy ex
158+ c = im2col kx ky sx sy ex
159159 mt = c LA.<> ek
160− r = col2vidUnsafe 1 1 1 1 ox oy mt
161− rs = fmap (fromJust . create) r
162− in S3D' $ mkVector rs
160+ r = col2vid 1 1 1 1 ox oy mt
161+ rs = fromJust . create $ r
162+ in S3D' rs
163163
164164 runBackwards (Convolution kernel _) (S2D' input) (S3D' dEdy) =
165165 let ex = extract input
@@ -172,17 +172,17 @@ instance ( KnownNat kernelRows
172172 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
173173 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
174174
175− c = im2colUnsafe kx ky sx sy ex
175+ c = im2col kx ky sx sy ex
176176
177− eo = vecToList $ fmap extract dEdy
177+ eo = extract dEdy
178178 ek = extract kernel
179179
180− vs = vid2colUnsafe 1 1 1 1 ox oy eo
180+ vs = vid2col 1 1 1 1 ox oy eo
181181
182182 kN = fromJust . create $ tr c LA.<> vs
183183 dW = vs LA.<> tr ek
184184
185− xW = col2imUnsafe kx ky sx sy ix iy dW
185+ xW = col2im kx ky sx sy ix iy dW
186186 in (Convolution' kN, S2D' . fromJust . create $ xW)
187187
188188
@@ -201,9 +201,10 @@ instance ( KnownNat kernelRows
201201 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
202202 , ((outputCols - 1) * strideCols) ~ (inputCols - kernelCols)
203203 , KnownNat (kernelRows * kernelCols * channels)
204+ , KnownNat (outputRows * filters)
204205 ) => Layer (Convolution channels filters kernelRows kernelCols strideRows strideCols) ('D3 inputRows inputCols channels) ('D3 outputRows outputCols filters) where
205206 runForwards (Convolution kernel _) (S3D' input) =
206− let ex = vecToList $ fmap extract input
207+ let ex = extract input
207208 ek = extract kernel
208209 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
209210 iy = fromIntegral $ natVal (Proxy :: Proxy inputCols)
@@ -214,13 +215,13 @@ instance ( KnownNat kernelRows
214215 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
215216 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
216217
217− c = vid2colUnsafe kx ky sx sy ix iy ex
218+ c = vid2col kx ky sx sy ix iy ex
218219 mt = c LA.<> ek
219− r = col2vidUnsafe 1 1 1 1 ox oy mt
220− rs = fmap (fromJust . create) r
221− in S3D' $ mkVector rs
220+ r = col2vid 1 1 1 1 ox oy mt
221+ rs = fromJust . create $ r
222+ in S3D' rs
222223 runBackwards (Convolution kernel _) (S3D' input) (S3D' dEdy) =
223− let ex = vecToList $ fmap extract input
224+ let ex = extract input
224225 ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
225226 iy = fromIntegral $ natVal (Proxy :: Proxy inputCols)
226227 kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
@@ -230,16 +231,16 @@ instance ( KnownNat kernelRows
230231 ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
231232 oy = fromIntegral $ natVal (Proxy :: Proxy outputCols)
232233
233− c = vid2colUnsafe kx ky sx sy ix iy ex
234+ c = vid2col kx ky sx sy ix iy ex
234235
235− eo = vecToList $ fmap extract dEdy
236+ eo = extract dEdy
236237 ek = extract kernel
237238
238− vs = vid2colUnsafe 1 1 1 1 ox oy eo
239+ vs = vid2col 1 1 1 1 ox oy eo
239240
240241 kN = fromJust . create $ tr c LA.<> vs
241242
242243 dW = vs LA.<> tr ek
243244
244− xW = col2vidUnsafe kx ky sx sy ix iy dW
245− in (Convolution' kN, S3D' . mkVector . fmap (fromJust . create) $ xW)
245+ xW = col2vid kx ky sx sy ix iy dW
246+ in (Convolution' kN, S3D' . fromJust . create $ xW)
src/Grenade/Layers/Flatten.hs+6−18
@@ -5,20 +5,19 @@
55{-# LANGUAGE TypeOperators #-}
66{-# LANGUAGE TypeFamilies #-}
77{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE FlexibleContexts #-}
89{-# LANGUAGE FlexibleInstances #-}
910
1011module Grenade.Layers.Flatten (
1112 FlattenLayer (..)
1213 ) where
1314
14−import Data.Proxy
1515import Data.Singletons.TypeLits
1616import GHC.TypeLits
1717
1818import Numeric.LinearAlgebra.Static
19−import Numeric.LinearAlgebra.Data as LA (flatten, toList, takesV, reshape, vjoin)
19+import Numeric.LinearAlgebra.Data as LA (flatten, toList)
2020
21−import Grenade.Core.Vector
2221import Grenade.Core.Shape
2322import Grenade.Core.Network
2423
@@ -31,21 +30,10 @@ instance UpdateLayer FlattenLayer where
3130 createRandom = return FlattenLayer
3231
3332
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
3534 runForwards _ (S2D' y) = S1D' . fromList . toList . flatten . extract $ y
3635 runBackwards _ _ (S1D' y) = ((), S2D' . fromList . toList . unwrap $ y)
3736
38−instance (KnownNat a, KnownNat x, KnownNat y, 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
40− runBackwards _ _ (S1D' o) =
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"
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
38+ runForwards _ (S3D' y) = S1D' . fromList . toList . flatten . extract $ y
39+ runBackwards _ _ (S1D' y) = ((), S3D' . fromList . toList . unwrap $ y)
src/Grenade/Layers/Internal/Convolution.hs+68−185
@@ -1,195 +1,78 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
12module Grenade.Layers.Internal.Convolution (
2− col2vidUnsafe
3− , col2imUnsafe
4− , vid2colUnsafe
5− , im2colUnsafe
6− , fittingStarts
7− , unsafeModifyMatrix
3+ im2col
4+ , col2im
5+ , col2vid
6+ , vid2col
87 ) where
98
10−import Control.Monad.ST ( ST, runST )
9+import Foreign ( mallocForeignPtrArray0, withForeignPtr )
10+import Foreign.Ptr ( Ptr )
1111
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 )
1913import qualified Numeric.LinearAlgebra.Devel as U
2014
21−-- This module provides provides im2col function and friends, ala caffe.
22−--
23−-- /* From Caffe */
24−-- @
25−-- void col2im_cpu(const Dtype* data_col, const int channels,
26−-- const int height, const int width, const int kernel_h, const int kernel_w,
27−-- const int pad_h, const int pad_w,
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
69−col2imUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows destinationCols columnMatrix = U.runSTMatrix $ do
70− let columnMatrixRows = rows columnMatrix
71−
72− dataIm <- U.newMatrix 0 destinationRows destinationCols
73− offsetR <- newSTRef 0
74− offsetC <- newSTRef 0
75−
76− forM_ [0 .. columnMatrixRows - 1] $ \inputRow -> do
77− inputColumnRef <- newSTRef 0
78− offsetR' <- readSTRef offsetR
79− offsetC' <- readSTRef offsetC
80− forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
81− forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
82− inputColumn <- readSTRef inputColumnRef
83− unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix inputRow inputColumn)
84− modifySTRef' inputColumnRef (+1)
85−
86− if offsetC' + kernelColumns < destinationCols
87− then modifySTRef' offsetC (+ strideColumns)
88− else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
89−
90− return dataIm
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]
98−col2vidUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows destinationCols columnMatrix = runST $ do
99− let columnMatrixRows = rows columnMatrix
100− let filters = cols columnMatrix `div` (kernelRows * kernelColumns)
101−
102− forM [0 .. filters - 1] $ \iter -> do
103− let offsetM = iter * (kernelRows * kernelColumns)
104− dataIm <- U.newMatrix 0 destinationRows destinationCols
105− offsetR <- newSTRef 0
106− offsetC <- newSTRef 0
107− forM_ [0 .. columnMatrixRows - 1] $ \ir -> do
108− inputColumn <- newSTRef 0
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
124−vid2colUnsafe kernelRows kernelColumns striderows stridecols vidrows vidcols dataVid = U.runSTMatrix $ do
125− let starts = fittingStarts vidrows kernelRows striderows vidcols kernelColumns stridecols
15+import System.IO.Unsafe ( unsafePerformIO )
16+
17+col2vid :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
18+col2vid kernelRows kernelColumns strideRows strideColumns height width dataCol =
19+ let channels = cols dataCol `div` (kernelRows * kernelColumns)
20+ in col2im_c channels height width kernelRows kernelColumns strideRows strideColumns dataCol
21+
22+col2im :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
23+col2im kernelRows kernelColumns strideRows strideColumns height width dataCol =
24+ let channels = 1
25+ in col2im_c channels height width kernelRows kernelColumns strideRows strideColumns dataCol
26+
27+col2im_c :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
28+col2im_c channels height width kernelRows kernelColumns strideRows strideColumns dataCol =
29+ let vec = flatten dataCol
30+ in unsafePerformIO $ do
31+ outPtr <- mallocForeignPtrArray0 (height * width * channels)
32+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
33+
34+ withForeignPtr inPtr $ \inPtr' ->
35+ withForeignPtr outPtr $ \outPtr' ->
36+ col2im_cpu inPtr' inOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
37+
38+ let matVec = U.unsafeFromForeignPtr outPtr 0 (height * width * channels)
39+ return $ U.matrixFromVector U.RowMajor (height * channels) width matVec
40+
41+foreign import ccall unsafe
42+ col2im_cpu
43+ :: Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
44+
45+vid2col :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
46+vid2col kernelRows kernelColumns strideRows strideColumns height width dataVid =
47+ let channels = rows dataVid `div` height
48+ in im2col_c channels height width kernelRows kernelColumns strideRows strideColumns dataVid
49+
50+
51+im2col :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
52+im2col kernelRows kernelColumns strideRows strideColumns dataIm =
53+ let channels = 1
54+ height = rows dataIm
55+ width = cols dataIm
56+ in im2col_c channels height width kernelRows kernelColumns strideRows strideColumns dataIm
57+
58+im2col_c :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
59+im2col_c channels height width kernelRows kernelColumns strideRows strideColumns dataIm =
60+ let vec = flatten dataIm
61+ rowOut = (height - kernelRows) `div` strideRows + 1
62+ colOut = (width - kernelColumns) `div` strideColumns + 1
12663 kernelSize = kernelRows * kernelColumns
127− numberOfPatches = length starts
128− channels = length dataVid
129−
130− dataCol <- U.newMatrix 0 numberOfPatches (channels * kernelSize)
64+ numberOfPatches = rowOut * colOut
65+ in unsafePerformIO $ do
66+ outPtr <- mallocForeignPtrArray0 (numberOfPatches * kernelSize * channels)
67+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
13168
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'
13372
134− forM_ dataVid $ \dataIm -> do
135− inputRowRef <- newSTRef 0
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)
73+ let matVec = U.unsafeFromForeignPtr outPtr 0 (numberOfPatches * kernelSize * channels)
74+ return $ U.matrixFromVector U.RowMajor numberOfPatches (kernelSize * channels) matVec
14675
147− modifySTRef' offsetC (+ kernelSize)
148−
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)]
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
76+foreign import ccall unsafe
77+ im2col_cpu
78+ :: Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
src/Grenade/Layers/Internal/Pooling.hs+47−61
@@ -1,69 +1,55 @@
1+{-# LANGUAGE ForeignFunctionInterface #-}
12module Grenade.Layers.Internal.Pooling (
23 poolForward
34 , poolBackward
4− , poolForwardList
5− , poolBackwardList
65 ) where
76
8−import Data.Foldable ( forM_ )
9−import Data.Function ( on )
10−import Data.List ( maximumBy )
7+import Foreign ( mallocForeignPtrArray0, withForeignPtr )
8+import Foreign.Ptr ( Ptr )
119
12−import Numeric.LinearAlgebra hiding ( uniformSample, konst )
13−import qualified Numeric.LinearAlgebra as LA
10+import Numeric.LinearAlgebra ( Matrix , flatten )
1411import qualified Numeric.LinearAlgebra.Devel as U
1512
16−import Grenade.Layers.Internal.Convolution
17−
18−poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
19−poolForward nrows ncols srows scols outputRows outputCols m =
20− let starts = fittingStarts (rows m) nrows srows (cols m) ncols scols
21− in poolForwardFit starts nrows ncols outputRows outputCols m
22−
23−poolForwardList :: Functor f => Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> f (Matrix Double) -> f (Matrix Double)
24−poolForwardList nrows ncols srows scols inRows inCols outputRows outputCols ms =
25− let starts = fittingStarts inRows nrows srows inCols ncols scols
26− in poolForwardFit starts nrows ncols outputRows outputCols <$> ms
27−
28−poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
29−poolForwardFit starts nrows ncols _ outputCols m =
30− let els = fmap (\start -> unsafeMaxElementSubmatrix start (nrows, ncols) m) starts
31− in LA.matrix outputCols els
32−
33−poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
34−poolBackward krows kcols srows scols inputMatrix gradientMatrix =
35− let inRows = rows inputMatrix
36− inCols = cols inputMatrix
37− starts = fittingStarts inRows krows srows inCols kcols scols
38− in poolBackwardFit starts krows kcols inputMatrix gradientMatrix
39−
40−poolBackwardList :: Functor f => Int -> Int -> Int -> Int -> Int -> Int -> f (Matrix Double, Matrix Double) -> f (Matrix Double)
41−poolBackwardList krows kcols srows scols inRows inCols inputMatrices =
42− let starts = fittingStarts inRows krows srows inCols kcols scols
43− in uncurry (poolBackwardFit starts krows kcols) <$> inputMatrices
44−
45−poolBackwardFit :: [(Int,Int)] -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
46−poolBackwardFit starts krows kcols inputMatrix gradientMatrix = U.runSTMatrix $ do
47− let inRows = rows inputMatrix
48− inCols = cols inputMatrix
49− gradCol = cols gradientMatrix
50− extent = (krows, kcols)
51−
52− retM <- U.newMatrix 0 inRows inCols
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−
13+import System.IO.Unsafe ( unsafePerformIO )
14+
15+poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
16+poolForward channels height width kernelRows kernelColumns strideRows strideColumns dataIm =
17+ let vec = flatten dataIm
18+ rowOut = (height - kernelRows) `div` strideRows + 1
19+ colOut = (width - kernelColumns) `div` strideColumns + 1
20+ numberOfPatches = rowOut * colOut
21+ in unsafePerformIO $ do
22+ outPtr <- mallocForeignPtrArray0 (numberOfPatches * channels)
23+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
24+
25+ withForeignPtr inPtr $ \inPtr' ->
26+ withForeignPtr outPtr $ \outPtr' ->
27+ pool_forwards_cpu inPtr' inOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
28+
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+
36+poolBackward :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
37+poolBackward channels height width kernelRows kernelColumns strideRows strideColumns dataCol dataGrad =
38+ let vecIm = flatten dataCol
39+ vecGrad = flatten dataGrad
40+ in unsafePerformIO $ do
41+ outPtr <- mallocForeignPtrArray0 (height * width * channels)
42+ let (imPtr, imOffset, _) = U.unsafeToForeignPtr vecIm
43+ let (gradPtr, gradOffset, _) = U.unsafeToForeignPtr vecGrad
44+
45+ withForeignPtr imPtr $ \imPtr' ->
46+ withForeignPtr gradPtr $ \gradPtr' ->
47+ withForeignPtr outPtr $ \outPtr' ->
48+ pool_backwards_cpu imPtr' imOffset gradPtr' gradOffset channels height width kernelRows kernelColumns strideRows strideColumns outPtr'
49+
50+ let matVec = U.unsafeFromForeignPtr outPtr 0 (height * width * channels)
51+ return $ U.matrixFromVector U.RowMajor (height * channels) width matVec
52+
53+foreign import ccall unsafe
54+ pool_backwards_cpu
55+ :: Ptr Double -> Int -> Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
src/Grenade/Layers/Logit.hs+2−3
@@ -12,7 +12,6 @@ module Grenade.Layers.Logit (
1212
1313import Data.Singletons.TypeLits
1414import Grenade.Core.Network
15−import Grenade.Core.Vector
1615import Grenade.Core.Shape
1716
1817-- | A Logit layer.
@@ -36,8 +35,8 @@ instance (KnownNat i, KnownNat j) => Layer Logit ('D2 i j) ('D2 i j) where
3635 runBackwards _ (S2D' y) (S2D' dEdy) = ((), S2D' (logistic' y * dEdy))
3736
3837instance (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)
40− runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (vectorZip (\y' dEdy' -> logistic' y' * dEdy') y dEdy))
38+ runForwards _ (S3D' y) = S3D' (logistic y)
39+ runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (logistic' y * dEdy))
4140
4241
4342logistic :: Floating a => a -> a
src/Grenade/Layers/Pooling.hs+19−17
@@ -21,7 +21,6 @@ import GHC.TypeLits
2121
2222import Grenade.Core.Network
2323import Grenade.Core.Shape
24−import Grenade.Core.Vector
2524import Grenade.Layers.Internal.Pooling
2625
2726import Numeric.LinearAlgebra.Static as LAS hiding ((|||), build, toRows)
@@ -57,24 +56,26 @@ instance ( KnownNat kernelRows
5756 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)
5857 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D2 inputRows inputColumns) ('D2 outputRows outputColumns) where
5958 runForwards Pooling (S2D' input) =
60− let kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
59+ let height = fromIntegral $ natVal (Proxy :: Proxy inputRows)
60+ width = fromIntegral $ natVal (Proxy :: Proxy inputColumns)
61+ kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
6162 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
6263 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
6364 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
64− ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
65− oy = fromIntegral $ natVal (Proxy :: Proxy outputColumns)
6665 ex = extract input
67− r = poolForward kx ky sx sy ox oy $ ex
66+ r = poolForward 1 height width kx ky sx sy ex
6867 rs = fromJust . create $ r
6968 in S2D' $ rs
7069 runBackwards Pooling (S2D' input) (S2D' dEdy) =
71− let kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
70+ let height = fromIntegral $ natVal (Proxy :: Proxy inputRows)
71+ width = fromIntegral $ natVal (Proxy :: Proxy inputColumns)
72+ kx = fromIntegral $ natVal (Proxy :: Proxy kernelRows)
7273 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
7374 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
7475 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
7576 ex = extract input
7677 eo = extract dEdy
77− vs = poolBackward kx ky sx sy ex eo
78+ vs = poolBackward 1 height width kx ky sx sy ex eo
7879 in ((), S2D' . fromJust . create $ vs)
7980
8081
@@ -87,6 +88,8 @@ instance ( KnownNat kernelRows
8788 , KnownNat inputColumns
8889 , KnownNat outputRows
8990 , KnownNat outputColumns
91+ , KnownNat channels
92+ , KnownNat (outputRows * channels)
9093 , ((outputRows - 1) * strideRows) ~ (inputRows - kernelRows)
9194 , ((outputColumns - 1) * strideColumns) ~ (inputColumns - kernelColumns)
9295 ) => Layer (Pooling kernelRows kernelColumns strideRows strideColumns) ('D3 inputRows inputColumns channels) ('D3 outputRows outputColumns channels) where
@@ -97,11 +100,10 @@ instance ( KnownNat kernelRows
97100 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
98101 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
99102 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
100− ox = fromIntegral $ natVal (Proxy :: Proxy outputRows)
101− oy = fromIntegral $ natVal (Proxy :: Proxy outputColumns)
102− ex = fmap extract input
103− r = poolForwardList kx ky sx sy ix iy ox oy ex
104− rs = fmap (fromJust . create) r
103+ ch = fromIntegral $ natVal (Proxy :: Proxy channels)
104+ ex = extract input
105+ r = poolForward ch ix iy kx ky sx sy ex
106+ rs = fromJust . create $ r
105107 in S3D' rs
106108 runBackwards Pooling (S3D' input) (S3D' dEdy) =
107109 let ix = fromIntegral $ natVal (Proxy :: Proxy inputRows)
@@ -110,8 +112,8 @@ instance ( KnownNat kernelRows
110112 ky = fromIntegral $ natVal (Proxy :: Proxy kernelColumns)
111113 sx = fromIntegral $ natVal (Proxy :: Proxy strideRows)
112114 sy = fromIntegral $ natVal (Proxy :: Proxy strideColumns)
113− ex = fmap extract input
114− eo = fmap extract dEdy
115− ez = vectorZip (,) ex eo
116− vs = poolBackwardList kx ky sx sy ix iy ez
117− in ((), S3D' . fmap (fromJust . create) $ vs)
115+ ch = fromIntegral $ natVal (Proxy :: Proxy channels)
116+ ex = extract input
117+ eo = extract dEdy
118+ vs = poolBackward ch ix iy kx ky sx sy ex eo
119+ in ((), S3D' . fromJust . create $ vs)
src/Grenade/Layers/Relu.hs+2−3
@@ -10,7 +10,6 @@ module Grenade.Layers.Relu (
1010 ) where
1111
1212import GHC.TypeLits
13−import Grenade.Core.Vector
1413import Grenade.Core.Network
1514import Grenade.Core.Shape
1615
@@ -44,9 +43,9 @@ instance (KnownNat i, KnownNat j) => Layer Relu ('D2 i j) ('D2 i j) where
4443 relu' = LAS.dmmap (\a -> if a <= 0 then 0 else 1)
4544
4645instance (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)
4847 where
4948 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))
5150 where
5251 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 (
1010 ) where
1111
1212import GHC.TypeLits
13−import Grenade.Core.Vector
1413import Grenade.Core.Network
1514import Grenade.Core.Shape
1615
@@ -33,8 +32,8 @@ instance (KnownNat i, KnownNat j) => Layer Tanh ('D2 i j) ('D2 i j) where
3332 runBackwards _ (S2D' y) (S2D' dEdy) = ((), S2D' (tanh' y * dEdy))
3433
3534instance (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)
37− runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (vectorZip (\y' dEdy' -> tanh' y' * dEdy') y dEdy))
35+ runForwards _ (S3D' y) = S3D' (tanh y)
36+ runBackwards _ (S3D' y) (S3D' dEdy) = ((), S3D' (tanh' y * dEdy))
3837
3938tanh' :: (Floating a) => a -> a
4039tanh' t = 1 - s ^ (2 :: Int) where s = tanh t
test/Test/Grenade/Layers/Convolution.hs+50−76
@@ -5,7 +5,6 @@
55module Test.Grenade.Layers.Convolution where
66
77import Grenade.Core.Shape
8−import Grenade.Core.Vector as Grenade
98import Grenade.Core.Network
109import Grenade.Layers.Convolution
1110import Grenade.Layers.Internal.Convolution
@@ -27,7 +26,7 @@ prop_im2col_no_stride = once $
2726 , 5.0, 6.0, 9.0, 10.0
2827 , 6.0, 7.0, 10.0, 11.0
2928 , 7.0, 8.0, 11.0, 12.0 ]
30− out = im2colUnsafe 2 2 1 1 input
29+ out = im2col 2 2 1 1 input
3130 in expected === out
3231
3332prop_im2col_stride = once $
@@ -40,7 +39,7 @@ prop_im2col_stride = once $
4039 , 3.0, 4.0, 7.0, 8.0
4140 , 5.0, 6.0, 9.0, 10.0
4241 , 7.0, 8.0, 11.0, 12.0 ]
43− out = im2colUnsafe 2 2 1 2 input
42+ out = im2col 2 2 1 2 input
4443 in expected === out
4544
4645prop_im2col_other = once $
@@ -51,7 +50,7 @@ prop_im2col_other = once $
5150 expected = (2><6)
5251 [ 1.0, 2.0, 5.0, 6.0 , 9.0, 10.0
5352 , 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
5554 in expected === out
5655
5756-- If there's no overlap (stride is the same size as the kernel)
@@ -61,20 +60,9 @@ prop_im2col_sym_on_same_stride = once $
6160 [ 1.0, 2.0, 3.0, 4.0
6261 , 5.0, 6.0, 7.0, 8.0
6362 , 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
6564 in input === out
6665
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−
7866-- If there is an overlap, then the gradient passed back should be
7967-- the sum of the gradients across the filters.
8068prop_im2col_col2im_additive = once $
@@ -86,7 +74,7 @@ prop_im2col_col2im_additive = once $
8674 [ 1.0, 2.0, 2.0, 1.0
8775 , 2.0, 4.0, 4.0, 2.0
8876 , 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
9078 in expected === out
9179
9280prop_simple_conv_forwards = once $
@@ -116,25 +104,18 @@ prop_simple_conv_forwards = once $
116104 [ 1.0, 2.0, 5.0
117105 , 3.0, 4.0, 6.0] :: HStatic.L 2 3)
118106
119− expect = [ HStatic.matrix
120− [ -3.0 , -4.0 ] :: HStatic.L 1 2
121− , HStatic.matrix
122− [ -1.0 , 1.0 ] :: HStatic.L 1 2
123− , HStatic.matrix
124− [ 5.0 , 9.0 ] :: HStatic.L 1 2
125− , HStatic.matrix
126− [ -7.0 , -10.0 ] :: HStatic.L 1 2] :: [HStatic.L 1 2]
107+ expect = HStatic.matrix
108+ [ -3.0 , -4.0
109+ , -1.0 , 1.0
110+ , 5.0 , 9.0
111+ , -7.0 , -10.0 ] :: HStatic.L 4 2
127112 out = runForwards convLayer input :: S' ('D3 1 2 4)
128113
129− grad = S3D' ( mkVector
130− [ HStatic.matrix
131− [ 1 , 0 ] :: HStatic.L 1 2
132− , HStatic.matrix
133− [ 0 , 0 ] :: HStatic.L 1 2
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)
114+ grad = S3D' ( HStatic.matrix
115+ [ 1 , 0
116+ , 0 , 0
117+ , 0 , 0
118+ , 0 , 1 ] :: HStatic.L 4 2 ) :: S' ('D3 1 2 4)
138119
139120 expectBack = (HStatic.matrix
140121 [ 1.0, 0.0, 0.0
@@ -143,19 +124,19 @@ prop_simple_conv_forwards = once $
143124
144125 in case (out, inX, nc) of
145126 (S3D' out' , S2D' inX', Convolution' backGrad)
146− -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
127+ -> (HStatic.extract expect === HStatic.extract out')
147128 .&&. (HStatic.extract expectBack === HStatic.extract inX')
148129 .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
149130
150131prop_vid2col_no_stride = once $
151− let input = [(3><4)
132+ let input = (6><4)
152133 [ 1.0, 2.0, 3.0, 4.0
153134 , 5.0, 6.0, 7.0, 8.0
154− , 9.0, 10.0, 11.0, 12.0 ]
155− , (3><4)
156− [ 21.0, 22.0, 23.0, 24.0
135+ , 9.0, 10.0, 11.0, 12.0
136+ -- -- --
137+ , 21.0, 22.0, 23.0, 24.0
157138 , 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 ]
159140 expected = (6><8)
160141 [ 1.0, 2.0, 5.0, 6.0 , 21.0, 22.0, 25.0, 26.0
161142 , 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 $
163144 , 5.0, 6.0, 9.0, 10.0 , 25.0, 26.0, 29.0, 30.0
164145 , 6.0, 7.0, 10.0, 11.0 , 26.0, 27.0, 30.0, 31.0
165146 , 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
167− in expected === out
147+ out_c = vid2col 2 2 1 1 3 4 input
148+ in expected === out_c
168149
169150prop_vid2col_stride = once $
170− let input = [(3><4)
151+ let input = (6><4)
171152 [ 1.0, 2.0, 3.0, 4.0
172153 , 5.0, 6.0, 7.0, 8.0
173− , 9.0, 10.0, 11.0, 12.0 ]
174− , (3><4)
175− [ 21.0, 22.0, 23.0, 24.0
154+ , 9.0, 10.0, 11.0, 12.0
155+ -- -- -- -- --
156+ , 21.0, 22.0, 23.0, 24.0
176157 , 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 ]
178159 expected = (4><8)
179160 [ 1.0, 2.0, 5.0, 6.0 , 21.0, 22.0, 25.0, 26.0
180161 , 3.0, 4.0, 7.0, 8.0 , 23.0, 24.0, 27.0, 28.0
181162 , 5.0, 6.0, 9.0, 10.0 , 25.0, 26.0, 29.0, 30.0
182163 , 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
184− in expected === out
164+ out_c = vid2col 2 2 1 2 3 4 input
165+ in expected === out_c
185166
186167prop_vid2col_invert = once $
187− let input = [(3><4)
168+ let input = (6><4)
188169 [ 1.0, 2.0, 3.0, 4.0
189170 , 5.0, 6.0, 7.0, 8.0
190− , 9.0, 10.0, 11.0, 12.0 ]
191− , (3><4)
192− [ 21.0, 22.0, 23.0, 24.0
171+ , 9.0, 10.0, 11.0, 12.0
172+ -- -- -- -- --
173+ , 21.0, 22.0, 23.0, 24.0
193174 , 25.0, 26.0, 27.0, 28.0
194− , 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
175+ , 29.0, 30.0, 31.0, 32.0 ]
176+ out = col2vid 3 2 3 2 3 4 . vid2col 3 2 3 2 3 4 $ input
196177 in input === out
197178
198179
@@ -221,29 +202,22 @@ prop_single_conv_forwards = once $
221202
222203 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
223204
224− input = S3D' ( mkVector [HStatic.matrix
205+ input = S3D' ( HStatic.matrix
225206 [ 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)
227208
228− expect = [HStatic.matrix
229− [ -3.0 , -4.0 ] :: HStatic.L 1 2
230− ,HStatic.matrix
231− [ -1.0 , 1.0 ] :: HStatic.L 1 2
232− ,HStatic.matrix
233− [ 5.0 , 9.0 ] :: HStatic.L 1 2
234− ,HStatic.matrix
235− [ -7.0 , -10.0 ] :: HStatic.L 1 2] :: [HStatic.L 1 2]
209+ expect = HStatic.matrix
210+ [ -3.0 , -4.0
211+ , -1.0 , 1.0
212+ , 5.0 , 9.0
213+ , -7.0 , -10.0 ] :: HStatic.L 4 2
236214 out = runForwards convLayer input :: S' ('D3 1 2 4)
237215
238− grad = S3D' ( mkVector
239− [HStatic.matrix
240− [ 1 , 0 ] :: HStatic.L 1 2
241− ,HStatic.matrix
242− [ 0 , 0 ] :: HStatic.L 1 2
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)
216+ grad = S3D' (HStatic.matrix
217+ [ 1 , 0
218+ , 0 , 0
219+ , 0 , 0
220+ , 0 , 1 ] :: HStatic.L 4 2 ) :: S' ('D3 1 2 4)
247221
248222 expectBack = (HStatic.matrix
249223 [ 1.0, 0.0, 0.0
@@ -252,8 +226,8 @@ prop_single_conv_forwards = once $
252226
253227 in case (out, inX, nc) of
254228 (S3D' out' , S3D' inX', Convolution' backGrad)
255− -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
256− .&&. ([HStatic.extract expectBack] === (HStatic.extract <$> vecToList inX'))
229+ -> (HStatic.extract expect === HStatic.extract out')
230+ .&&. (HStatic.extract expectBack === HStatic.extract inX')
257231 .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
258232
259233return []
test/Test/Grenade/Layers/Pooling.hs+20−4
@@ -18,7 +18,7 @@ prop_pool = once $
1818 expected = (2><3)
1919 [ 14.0, 14.0, 8.0
2020 , 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
2222 in expected === out
2323
2424prop_pool_rectangular = once $
@@ -29,7 +29,23 @@ prop_pool_rectangular = once $
2929 expected = (2><2)
3030 [ 14.0, 14.0
3131 , 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
3349 in expected === out
3450
3551prop_pool_backwards = once $
@@ -44,7 +60,7 @@ prop_pool_backwards = once $
4460 [ 0.0, 0.0, 0.0, 0.0
4561 , 0.0, -6.0, -7.0, -8.0
4662 , 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
4864 in expected === out
4965
5066prop_pool_backwards_additive = once $
@@ -59,7 +75,7 @@ prop_pool_backwards_additive = once $
5975 [-6.0, 0.0, 0.0, 0.0
6076 , 0.0, 0.0,-18.0,-20.0
6177 ,-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
6379 in expected === out
6480
6581return []