on master help sign in
Add faster maxIndex and maxElement for matrices
24289dbHuw Campbell
src/Grenade/Layers/Internal/Pooling.hs+17−2
@@ -5,8 +5,13 @@ module Grenade.Layers.Internal.Pooling (
5 , poolBackwardList
5 , poolBackwardList
6 ) where
6 ) where
7
7
8+import Data.Function ( on )
9+import Data.List ( maximumBy )
10+
8import Numeric.LinearAlgebra hiding ( uniformSample, konst )
11import Numeric.LinearAlgebra hiding ( uniformSample, konst )
9import qualified Numeric.LinearAlgebra as LA
12import qualified Numeric.LinearAlgebra as LA
13+import qualified Numeric.LinearAlgebra.Devel as U
14+
10
15
11import Grenade.Layers.Internal.Convolution
16import Grenade.Layers.Internal.Convolution
12
17
@@ -22,7 +27,7 @@ poolForwardList nrows ncols srows scols inRows inCols outputRows outputCols ms =
22
27
23poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
28poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
24poolForwardFit starts nrows ncols _ outputCols m =
29poolForwardFit starts nrows ncols _ outputCols m =
25− let els = fmap (\start -> maxElement $ subMatrix start (nrows, ncols) m) starts
30+ let els = fmap (\start -> unsafeMaxElement $ subMatrix start (nrows, ncols) m) starts
26 in LA.matrix outputCols els
31 in LA.matrix outputCols els
27
32
28poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
33poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
@@ -41,8 +46,18 @@ poolBackwardFit :: [(Int,Int)] -> Int -> Int -> Matrix Double -> Matrix Double -
41poolBackwardFit starts krows kcols inputMatrix gradientMatrix =
46poolBackwardFit starts krows kcols inputMatrix gradientMatrix =
42 let inRows = rows inputMatrix
47 let inRows = rows inputMatrix
43 inCols = cols inputMatrix
48 inCols = cols inputMatrix
44− inds = fmap (\start -> maxIndex $ subMatrix start (krows, kcols) inputMatrix) starts
49+ inds = fmap (\start -> unsafeMaxIndex $ subMatrix start (krows, kcols) inputMatrix) starts
45 grads = toList $ flatten gradientMatrix
50 grads = toList $ flatten gradientMatrix
46 grads' = zip3 starts grads inds
51 grads' = zip3 starts grads inds
47 accums = fmap (\((stx',sty'),grad,(inx, iny)) -> ((stx' + inx, sty' + iny), grad)) grads'
52 accums = fmap (\((stx',sty'),grad,(inx, iny)) -> ((stx' + inx, sty' + iny), grad)) grads'
48 in accum (LA.konst 0 (inRows, inCols)) (+) accums
53 in accum (LA.konst 0 (inRows, inCols)) (+) accums
54+
55+unsafeMaxElement :: Matrix Double -> Double
56+unsafeMaxElement m = uncurry (U.atM' m) $ unsafeMaxIndex m
57+
58+unsafeMaxIndex :: Matrix Double -> (Int, Int)
59+unsafeMaxIndex m =
60+ let mrows = [0 .. rows m - 1]
61+ mcols = [0 .. cols m - 1]
62+ pairs = concatMap ( \r -> fmap (\c -> (r , c)) mcols ) mrows
63+ in maximumBy (compare `on` uncurry (U.atM' m)) pairs
src/Grenade/Layers/Pooling.hs−2
@@ -12,8 +12,6 @@
12
12
13module Grenade.Layers.Pooling (
13module Grenade.Layers.Pooling (
14 Pooling (..)
14 Pooling (..)
15− , poolForward
16− , poolBackward
17 ) where
15 ) where
18
16
19import Data.Maybe
17import Data.Maybe
test/Test/Grenade/Layers/Convolution.hs+41−44
@@ -93,22 +93,22 @@ prop_simple_conv_forwards = once $
93 -- Create a convolution kernel with 4 filters.
93 -- Create a convolution kernel with 4 filters.
94 -- [ 1, 0 [ 0, 1 [ 0, 1 [ 0, 0
94 -- [ 1, 0 [ 0, 1 [ 0, 1 [ 0, 0
95 -- , 0,-1 ] ,-1, 0 ] , 1, 0 ] ,-1,-1 ]
95 -- , 0,-1 ] ,-1, 0 ] , 1, 0 ] ,-1,-1 ]
96− let myKernel = (HStatic.matrix
96+ let myKernel = HStatic.matrix
97 [ 1.0, 0.0, 0.0, 0.0
97 [ 1.0, 0.0, 0.0, 0.0
98 , 0.0, 1.0, 1.0, 0.0
98 , 0.0, 1.0, 1.0, 0.0
99 , 0.0, -1.0, 1.0, -1.0
99 , 0.0, -1.0, 1.0, -1.0
100− ,-1.0, 0.0, 0.0, -1.0 ] :: HStatic.L 4 4)
100+ ,-1.0, 0.0, 0.0, -1.0 ] :: HStatic.L 4 4
101− zeroKernel = (HStatic.matrix
101+ zeroKernel = HStatic.matrix
102 [ 0.0, 0.0, 0.0, 0.0
102 [ 0.0, 0.0, 0.0, 0.0
103 , 0.0, 0.0, 0.0, 0.0
103 , 0.0, 0.0, 0.0, 0.0
104 , 0.0, 0.0, 0.0, 0.0
104 , 0.0, 0.0, 0.0, 0.0
105− , 0.0, 0.0, 0.0, 0.0 ] :: HStatic.L 4 4)
105+ , 0.0, 0.0, 0.0, 0.0 ] :: HStatic.L 4 4
106
106
107− expectedGradient = (HStatic.matrix
107+ expectedGradient = HStatic.matrix
108 [ 1.0, 0.0, 0.0, 2.0
108 [ 1.0, 0.0, 0.0, 2.0
109 , 2.0, 0.0, 0.0, 5.0
109 , 2.0, 0.0, 0.0, 5.0
110 , 3.0, 0.0, 0.0, 4.0
110 , 3.0, 0.0, 0.0, 4.0
111− , 4.0, 0.0, 0.0, 6.0 ] :: HStatic.L 4 4)
111+ , 4.0, 0.0, 0.0, 6.0 ] :: HStatic.L 4 4
112
112
113 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
113 convLayer = Convolution myKernel zeroKernel :: Convolution 1 4 2 2 1 1
114
114
@@ -116,25 +116,25 @@ prop_simple_conv_forwards = once $
116 [ 1.0, 2.0, 5.0
116 [ 1.0, 2.0, 5.0
117 , 3.0, 4.0, 6.0] :: HStatic.L 2 3)
117 , 3.0, 4.0, 6.0] :: HStatic.L 2 3)
118
118
119− expect = ([(HStatic.matrix
119+ expect = [ HStatic.matrix
120− [ -3.0 , -4.0 ] :: HStatic.L 1 2)
120+ [ -3.0 , -4.0 ] :: HStatic.L 1 2
121− ,(HStatic.matrix
121+ , HStatic.matrix
122− [ -1.0 , 1.0 ] :: HStatic.L 1 2)
122+ [ -1.0 , 1.0 ] :: HStatic.L 1 2
123− ,(HStatic.matrix
123+ , HStatic.matrix
124− [ 5.0 , 9.0 ] :: HStatic.L 1 2)
124+ [ 5.0 , 9.0 ] :: HStatic.L 1 2
125− ,(HStatic.matrix
125+ , HStatic.matrix
126− [ -7.0 , -10.0 ] :: HStatic.L 1 2)]) :: [HStatic.L 1 2]
126+ [ -7.0 , -10.0 ] :: HStatic.L 1 2] :: [HStatic.L 1 2]
127 out = runForwards convLayer input :: S' ('D3 1 2 4)
127 out = runForwards convLayer input :: S' ('D3 1 2 4)
128
128
129 grad = S3D' ( mkVector
129 grad = S3D' ( mkVector
130− [(HStatic.matrix
130+ [ HStatic.matrix
131− [ 1 , 0 ] :: HStatic.L 1 2)
131+ [ 1 , 0 ] :: HStatic.L 1 2
132− ,(HStatic.matrix
132+ , HStatic.matrix
133− [ 0 , 0 ] :: HStatic.L 1 2)
133+ [ 0 , 0 ] :: HStatic.L 1 2
134− ,(HStatic.matrix
134+ , HStatic.matrix
135− [ 0 , 0 ] :: HStatic.L 1 2)
135+ [ 0 , 0 ] :: HStatic.L 1 2
136− ,(HStatic.matrix
136+ , HStatic.matrix
137− [ 0 , 1 ] :: HStatic.L 1 2)] ) :: S' ('D3 1 2 4)
137+ [ 0 , 1 ] :: HStatic.L 1 2] ) :: S' ('D3 1 2 4)
138
138
139 expectBack = (HStatic.matrix
139 expectBack = (HStatic.matrix
140 [ 1.0, 0.0, 0.0
140 [ 1.0, 0.0, 0.0
@@ -144,11 +144,8 @@ prop_simple_conv_forwards = once $
144 in case (out, inX, nc) of
144 in case (out, inX, nc) of
145 (S3D' out' , S2D' inX', Convolution' backGrad)
145 (S3D' out' , S2D' inX', Convolution' backGrad)
146 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
146 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
147− .&&. ((HStatic.extract expectBack) === (HStatic.extract inX'))
147+ .&&. (HStatic.extract expectBack === HStatic.extract inX')
148− .&&. ((HStatic.extract expectedGradient) === (HStatic.extract backGrad))
148+ .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
149− -- Temporarily disabled, as l2 adjustment puts in off 5%
150− -- .&&. HStatic.extract expectedKernel === HStatic.extract kernel'
151−
152
149
153prop_vid2col_no_stride = once $
150prop_vid2col_no_stride = once $
154 let input = [(3><4)
151 let input = [(3><4)
@@ -228,25 +225,25 @@ prop_single_conv_forwards = once $
228 [ 1.0, 2.0, 5.0
225 [ 1.0, 2.0, 5.0
229 , 3.0, 4.0, 6.0] :: HStatic.L 2 3] ) :: S' ('D3 2 3 1)
226 , 3.0, 4.0, 6.0] :: HStatic.L 2 3] ) :: S' ('D3 2 3 1)
230
227
231− expect = ([(HStatic.matrix
228+ expect = [HStatic.matrix
232− [ -3.0 , -4.0 ] :: HStatic.L 1 2)
229+ [ -3.0 , -4.0 ] :: HStatic.L 1 2
233− ,(HStatic.matrix
230+ ,HStatic.matrix
234− [ -1.0 , 1.0 ] :: HStatic.L 1 2)
231+ [ -1.0 , 1.0 ] :: HStatic.L 1 2
235− ,(HStatic.matrix
232+ ,HStatic.matrix
236− [ 5.0 , 9.0 ] :: HStatic.L 1 2)
233+ [ 5.0 , 9.0 ] :: HStatic.L 1 2
237− ,(HStatic.matrix
234+ ,HStatic.matrix
238− [ -7.0 , -10.0 ] :: HStatic.L 1 2)]) :: [HStatic.L 1 2]
235+ [ -7.0 , -10.0 ] :: HStatic.L 1 2] :: [HStatic.L 1 2]
239 out = runForwards convLayer input :: S' ('D3 1 2 4)
236 out = runForwards convLayer input :: S' ('D3 1 2 4)
240
237
241 grad = S3D' ( mkVector
238 grad = S3D' ( mkVector
242− [(HStatic.matrix
239+ [HStatic.matrix
243− [ 1 , 0 ] :: HStatic.L 1 2)
240+ [ 1 , 0 ] :: HStatic.L 1 2
244− ,(HStatic.matrix
241+ ,HStatic.matrix
245− [ 0 , 0 ] :: HStatic.L 1 2)
242+ [ 0 , 0 ] :: HStatic.L 1 2
246− ,(HStatic.matrix
243+ ,HStatic.matrix
247− [ 0 , 0 ] :: HStatic.L 1 2)
244+ [ 0 , 0 ] :: HStatic.L 1 2
248− ,(HStatic.matrix
245+ ,HStatic.matrix
249− [ 0 , 1 ] :: HStatic.L 1 2)] ) :: S' ('D3 1 2 4)
246+ [ 0 , 1 ] :: HStatic.L 1 2] ) :: S' ('D3 1 2 4)
250
247
251 expectBack = (HStatic.matrix
248 expectBack = (HStatic.matrix
252 [ 1.0, 0.0, 0.0
249 [ 1.0, 0.0, 0.0
@@ -257,7 +254,7 @@ prop_single_conv_forwards = once $
257 (S3D' out' , S3D' inX', Convolution' backGrad)
254 (S3D' out' , S3D' inX', Convolution' backGrad)
258 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
255 -> ((HStatic.extract <$> expect) === (HStatic.extract <$> vecToList out'))
259 .&&. ([HStatic.extract expectBack] === (HStatic.extract <$> vecToList inX'))
256 .&&. ([HStatic.extract expectBack] === (HStatic.extract <$> vecToList inX'))
260− .&&. ((HStatic.extract expectedGradient) === (HStatic.extract backGrad))
257+ .&&. (HStatic.extract expectedGradient === HStatic.extract backGrad)
261
258
262return []
259return []
263tests :: IO Bool
260tests :: IO Bool
test/Test/Grenade/Layers/Pooling.hs+3−3
@@ -4,7 +4,7 @@
4{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
4{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
5module Test.Grenade.Layers.Pooling where
5module Test.Grenade.Layers.Pooling where
6
6
7−import Grenade.Layers.Pooling
7+import Grenade.Layers.Internal.Pooling
8
8
9import Numeric.LinearAlgebra hiding (uniformSample, konst, (===))
9import Numeric.LinearAlgebra hiding (uniformSample, konst, (===))
10
10
@@ -12,11 +12,11 @@ import Test.QuickCheck hiding ((><))
12
12
13prop_pool = once $
13prop_pool = once $
14 let input = (3><4)
14 let input = (3><4)
15− [ 1.0, 2.0, 3.0, 4.0
15+ [ 1.0, 14.0, 3.0, 4.0
16 , 5.0, 6.0, 7.0, 8.0
16 , 5.0, 6.0, 7.0, 8.0
17 , 9.0, 10.0, 11.0, 12.0 ]
17 , 9.0, 10.0, 11.0, 12.0 ]
18 expected = (2><3)
18 expected = (2><3)
19− [ 6.0, 7.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 2 2 1 1 2 3 input
22 in expected === out
22 in expected === out