git.iko.soy/grenade
on master help sign in
Merge pull request #14 from HuwCampbell/topic/performance
2cffa4aHuw Campbell
src/Grenade/Layers/Internal/Convolution.hs+36−31
compare with master
unifiedsplit
@@ -4,14 +4,17 @@ module Grenade.Layers.Internal.Convolution (
4 , vid2colUnsafe
4 , vid2colUnsafe
5 , im2colUnsafe
5 , im2colUnsafe
6 , fittingStarts
6 , fittingStarts
7+ , unsafeModifyMatrix
7 ) where
8 ) where
8
9
9−import Control.Monad.ST ( runST )
10+import Control.Monad.ST ( ST, runST )
10
11
11−import Data.STRef ( newSTRef, modifySTRef, writeSTRef, readSTRef )
12+import Data.STRef ( newSTRef, modifySTRef', writeSTRef, readSTRef )
12import Data.Foldable ( forM_ )
13import Data.Foldable ( forM_ )
13import Data.Traversable ( forM )
14import Data.Traversable ( forM )
14
15
16+import Foreign.Storable( Storable )
17+
15import Numeric.LinearAlgebra hiding ( uniformSample, konst )
18import Numeric.LinearAlgebra hiding ( uniformSample, konst )
16import qualified Numeric.LinearAlgebra.Devel as U
19import qualified Numeric.LinearAlgebra.Devel as U
17
20
@@ -72,18 +75,17 @@ col2imUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows d
72
75
73 forM_ [0 .. columnMatrixRows - 1] $ \inputRow -> do
76 forM_ [0 .. columnMatrixRows - 1] $ \inputRow -> do
74 inputColumnRef <- newSTRef 0
77 inputColumnRef <- newSTRef 0
78+ offsetR' <- readSTRef offsetR
79+ offsetC' <- readSTRef offsetC
75− forM_ [0 .. kernelRows -1] $ \kr ->
80+ forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
76− forM_ [0 .. kernelColumns -1] $ \kc -> do
81+ forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
77 inputColumn <- readSTRef inputColumnRef
82 inputColumn <- readSTRef inputColumnRef
78− offsetR' <- readSTRef offsetR
79− offsetC' <- readSTRef offsetC
80− U.modifyMatrix dataIm (kr + offsetR') (kc + offsetC') (+ U.atM' columnMatrix inputRow inputColumn)
83+ unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix inputRow inputColumn)
81− modifySTRef inputColumnRef (+1)
84+ modifySTRef' inputColumnRef (+1)
82
85
83− offsetC' <- readSTRef offsetC
84 if offsetC' + kernelColumns < destinationCols
86 if offsetC' + kernelColumns < destinationCols
85− then modifySTRef offsetC (+ strideColumns)
87+ then modifySTRef' offsetC (+ strideColumns)
86− else writeSTRef offsetC 0 >> modifySTRef offsetR (+ strideRows)
88+ else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
87
89
88 return dataIm
90 return dataIm
89
91
@@ -104,18 +106,17 @@ col2vidUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows
104 offsetC <- newSTRef 0
106 offsetC <- newSTRef 0
105 forM_ [0 .. columnMatrixRows - 1] $ \ir -> do
107 forM_ [0 .. columnMatrixRows - 1] $ \ir -> do
106 inputColumn <- newSTRef 0
108 inputColumn <- newSTRef 0
109+ offsetR' <- readSTRef offsetR
110+ offsetC' <- readSTRef offsetC
107− forM_ [0 .. kernelRows -1] $ \kr ->
111+ forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
108− forM_ [0 .. kernelColumns -1] $ \kc -> do
112+ forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
109 ic <- readSTRef inputColumn
113 ic <- readSTRef inputColumn
110− offsetR' <- readSTRef offsetR
111− offsetC' <- readSTRef offsetC
112− U.modifyMatrix dataIm (kr + offsetR') (kc + offsetC') (+ U.atM' columnMatrix ir (ic + offsetM))
114+ unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix ir (ic + offsetM))
113− modifySTRef inputColumn (+1)
115+ modifySTRef' inputColumn (+1)
114
116
115− offsetC' <- readSTRef offsetC
116 if offsetC' + kernelColumns < destinationCols
117 if offsetC' + kernelColumns < destinationCols
117− then modifySTRef offsetC (+ strideColumns)
118+ then modifySTRef' offsetC (+ strideColumns)
118− else writeSTRef offsetC 0 >> modifySTRef offsetR (+ strideRows)
119+ else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
119
120
120 U.unsafeFreezeMatrix dataIm
121 U.unsafeFreezeMatrix dataIm
121
122
@@ -136,14 +137,14 @@ vid2colUnsafe kernelRows kernelColumns striderows stridecols vidrows vidcols dat
136 forM_ starts $ \(startRow, startCol) -> do
137 forM_ starts $ \(startRow, startCol) -> do
137 inputColumnRef <- newSTRef 0
138 inputColumnRef <- newSTRef 0
138 inputRow <- readSTRef inputRowRef
139 inputRow <- readSTRef inputRowRef
139− forM_ [0 .. kernelRows -1] $ \kr ->
140+ forM_ [startRow .. startRow + kernelRows -1] $ \kr ->
140− forM_ [0 .. kernelColumns -1] $ \kc -> do
141+ forM_ [startCol .. startCol + kernelColumns -1] $ \kc -> do
141 inputColumn <- readSTRef inputColumnRef
142 inputColumn <- readSTRef inputColumnRef
142− U.modifyMatrix dataCol inputRow (inputColumn + offsetC') (+ U.atM' dataIm (kr + startRow) (kc + startCol))
143+ unsafeModifyMatrix dataCol inputRow (inputColumn + offsetC') (+ U.atM' dataIm kr kc)
143− modifySTRef inputColumnRef (+1)
144+ modifySTRef' inputColumnRef (+1)
144− modifySTRef inputRowRef (+1)
145+ modifySTRef' inputRowRef (+1)
145
146
146− modifySTRef offsetC (+ kernelSize)
147+ modifySTRef' offsetC (+ kernelSize)
147
148
148 return dataCol
149 return dataCol
149
150
@@ -159,15 +160,19 @@ im2colUnsafe kernelRows kernelColumns striderows stridecols dataIm = U.runSTMatr
159 forM_ starts $ \(startRow, startCol) -> do
160 forM_ starts $ \(startRow, startCol) -> do
160 inputColumnRef <- newSTRef 0
161 inputColumnRef <- newSTRef 0
161 inputRow <- readSTRef inputRowRef
162 inputRow <- readSTRef inputRowRef
162− forM_ [0 .. kernelRows -1] $ \kr ->
163+ forM_ [startRow .. startRow + kernelRows -1] $ \kr ->
163− forM_ [0 .. kernelColumns -1] $ \kc -> do
164+ forM_ [startCol .. startCol + kernelColumns -1] $ \kc -> do
164 inputColumn <- readSTRef inputColumnRef
165 inputColumn <- readSTRef inputColumnRef
165− U.modifyMatrix dataCol inputRow inputColumn (+ U.atM' dataIm (kr + startRow) (kc + startCol))
166+ unsafeModifyMatrix dataCol inputRow inputColumn (+ U.atM' dataIm kr kc)
166− modifySTRef inputColumnRef (+1)
167+ modifySTRef' inputColumnRef (+1)
167− modifySTRef inputRowRef (+1)
168+ modifySTRef' inputRowRef (+1)
168
169
169 return dataCol
170 return dataCol
170
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+
171
176
172-- | Returns the starting sub matrix locations which fit inside the larger matrix for the
177-- | Returns the starting sub matrix locations which fit inside the larger matrix for the
173-- convolution. Takes into account the stride and kernel size.
178-- convolution. Takes into account the stride and kernel size.
src/Grenade/Layers/Internal/Pooling.hs+22−16
@@ -5,6 +5,7 @@ module Grenade.Layers.Internal.Pooling (
5 , poolBackwardList
5 , poolBackwardList
6 ) where
6 ) where
7
7
8+import Data.Foldable ( forM_ )
8import Data.Function ( on )
9import Data.Function ( on )
9import Data.List ( maximumBy )
10import Data.List ( maximumBy )
10
11
@@ -12,7 +13,6 @@ import Numeric.LinearAlgebra hiding ( uniformSample, konst )
12import qualified Numeric.LinearAlgebra as LA
13import qualified Numeric.LinearAlgebra as LA
13import qualified Numeric.LinearAlgebra.Devel as U
14import qualified Numeric.LinearAlgebra.Devel as U
14
15
15−
16import Grenade.Layers.Internal.Convolution
16import Grenade.Layers.Internal.Convolution
17
17
18poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
18poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
@@ -27,7 +27,7 @@ poolForwardList nrows ncols srows scols inRows inCols outputRows outputCols ms =
27
27
28poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
28poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
29poolForwardFit starts nrows ncols _ outputCols m =
29poolForwardFit starts nrows ncols _ outputCols m =
30− let els = fmap (\start -> unsafeMaxElement $ subMatrix start (nrows, ncols) m) starts
30+ let els = fmap (\start -> unsafeMaxElementSubmatrix start (nrows, ncols) m) starts
31 in LA.matrix outputCols els
31 in LA.matrix outputCols els
32
32
33poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
33poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
@@ -43,21 +43,27 @@ poolBackwardList krows kcols srows scols inRows inCols inputMatrices =
43 in uncurry (poolBackwardFit starts krows kcols) <$> inputMatrices
43 in uncurry (poolBackwardFit starts krows kcols) <$> inputMatrices
44
44
45poolBackwardFit :: [(Int,Int)] -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
45poolBackwardFit :: [(Int,Int)] -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
46−poolBackwardFit starts krows kcols inputMatrix gradientMatrix =
46+poolBackwardFit starts krows kcols inputMatrix gradientMatrix = U.runSTMatrix $ do
47 let inRows = rows inputMatrix
47 let inRows = rows inputMatrix
48 inCols = cols inputMatrix
48 inCols = cols inputMatrix
49− inds = fmap (\start -> unsafeMaxIndex $ subMatrix start (krows, kcols) inputMatrix) starts
49+ gradCol = cols gradientMatrix
50− grads = toList $ flatten gradientMatrix
50+ extent = (krows, kcols)
51− grads' = zip3 starts grads inds
51+
52− accums = fmap (\((stx',sty'),grad,(inx, iny)) -> ((stx' + inx, sty' + iny), grad)) grads'
53− in accum (LA.konst 0 (inRows, inCols)) (+) accums
52+ retM <- U.newMatrix 0 inRows inCols
54−
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+
55−unsafeMaxElement :: Matrix Double -> Double
60+unsafeMaxElementSubmatrix :: (Int,Int) -> (Int,Int) -> Matrix Double -> Double
56−unsafeMaxElement m = uncurry (U.atM' m) $ unsafeMaxIndex m
61+unsafeMaxElementSubmatrix starts extent m = uncurry (U.atM' m) $ unsafeMaxIndexSubMatrix starts extent m
57−
62+
58−unsafeMaxIndex :: Matrix Double -> (Int, Int)
63+unsafeMaxIndexSubMatrix :: (Int,Int) -> (Int,Int) -> Matrix Double -> (Int, Int)
59−unsafeMaxIndex m =
64+unsafeMaxIndexSubMatrix (startRow, startCol) (extentRow, extentCold) m =
60− let mrows = [0 .. rows m - 1]
65+ let mrows = [startRow .. startRow + extentRow - 1]
61− mcols = [0 .. cols m - 1]
66+ mcols = [startCol .. startCol + extentCold - 1]
62 pairs = concatMap ( \r -> fmap (\c -> (r , c)) mcols ) mrows
67 pairs = concatMap ( \r -> fmap (\c -> (r , c)) mcols ) mrows
63 in maximumBy (compare `on` uncurry (U.atM' m)) pairs
68 in maximumBy (compare `on` uncurry (U.atM' m)) pairs
69+