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

Topic/performance

commit2cffa4a568184b3b903fe6fb08563bb7dfff6f60 authorHuw Campbell <huw.campbell@gmail.com> dateFri 9 Dec 2016, 22:04 (10 years ago) parent8b3ca1e267ebc2
2 files changed+58−47
compare with master
unifiedsplit
src/Grenade/Layers/Internal/Convolution.hs+36−31 src/Grenade/Layers/Internal/Pooling.hs+22−16
src/Grenade/Layers/Internal/Convolution.hs+36−31
@@ -4,14 +4,17 @@ module Grenade.Layers.Internal.Convolution (
44 , vid2colUnsafe
55 , im2colUnsafe
66 , fittingStarts
7+ , unsafeModifyMatrix
78 ) where
89
9−import Control.Monad.ST ( runST )
10+import Control.Monad.ST ( ST, runST )
1011
11−import Data.STRef ( newSTRef, modifySTRef, writeSTRef, readSTRef )
12+import Data.STRef ( newSTRef, modifySTRef', writeSTRef, readSTRef )
1213import Data.Foldable ( forM_ )
1314import Data.Traversable ( forM )
1415
16+import Foreign.Storable( Storable )
17+
1518import Numeric.LinearAlgebra hiding ( uniformSample, konst )
1619import qualified Numeric.LinearAlgebra.Devel as U
1720
@@ -72,18 +75,17 @@ col2imUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows d
7275
7376 forM_ [0 .. columnMatrixRows - 1] $ \inputRow -> do
7477 inputColumnRef <- newSTRef 0
75− forM_ [0 .. kernelRows -1] $ \kr ->
76− forM_ [0 .. kernelColumns -1] $ \kc -> do
78+ offsetR' <- readSTRef offsetR
79+ offsetC' <- readSTRef offsetC
80+ forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
81+ forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
7782 inputColumn <- readSTRef inputColumnRef
78− offsetR' <- readSTRef offsetR
79− offsetC' <- readSTRef offsetC
80− U.modifyMatrix dataIm (kr + offsetR') (kc + offsetC') (+ U.atM' columnMatrix inputRow inputColumn)
81− modifySTRef inputColumnRef (+1)
83+ unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix inputRow inputColumn)
84+ modifySTRef' inputColumnRef (+1)
8285
83− offsetC' <- readSTRef offsetC
8486 if offsetC' + kernelColumns < destinationCols
85− then modifySTRef offsetC (+ strideColumns)
86− else writeSTRef offsetC 0 >> modifySTRef offsetR (+ strideRows)
87+ then modifySTRef' offsetC (+ strideColumns)
88+ else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
8789
8890 return dataIm
8991
@@ -104,18 +106,17 @@ col2vidUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows
104106 offsetC <- newSTRef 0
105107 forM_ [0 .. columnMatrixRows - 1] $ \ir -> do
106108 inputColumn <- newSTRef 0
107− forM_ [0 .. kernelRows -1] $ \kr ->
108− forM_ [0 .. kernelColumns -1] $ \kc -> do
109+ offsetR' <- readSTRef offsetR
110+ offsetC' <- readSTRef offsetC
111+ forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
112+ forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
109113 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))
113− modifySTRef inputColumn (+1)
114+ unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix ir (ic + offsetM))
115+ modifySTRef' inputColumn (+1)
114116
115− offsetC' <- readSTRef offsetC
116117 if offsetC' + kernelColumns < destinationCols
117− then modifySTRef offsetC (+ strideColumns)
118− else writeSTRef offsetC 0 >> modifySTRef offsetR (+ strideRows)
118+ then modifySTRef' offsetC (+ strideColumns)
119+ else writeSTRef offsetC 0 >> modifySTRef' offsetR (+ strideRows)
119120
120121 U.unsafeFreezeMatrix dataIm
121122
@@ -136,14 +137,14 @@ vid2colUnsafe kernelRows kernelColumns striderows stridecols vidrows vidcols dat
136137 forM_ starts $ \(startRow, startCol) -> do
137138 inputColumnRef <- newSTRef 0
138139 inputRow <- readSTRef inputRowRef
139− forM_ [0 .. kernelRows -1] $ \kr ->
140− forM_ [0 .. kernelColumns -1] $ \kc -> do
140+ forM_ [startRow .. startRow + kernelRows -1] $ \kr ->
141+ forM_ [startCol .. startCol + kernelColumns -1] $ \kc -> do
141142 inputColumn <- readSTRef inputColumnRef
142− U.modifyMatrix dataCol inputRow (inputColumn + offsetC') (+ U.atM' dataIm (kr + startRow) (kc + startCol))
143− modifySTRef inputColumnRef (+1)
144− modifySTRef inputRowRef (+1)
143+ unsafeModifyMatrix dataCol inputRow (inputColumn + offsetC') (+ U.atM' dataIm kr kc)
144+ modifySTRef' inputColumnRef (+1)
145+ modifySTRef' inputRowRef (+1)
145146
146− modifySTRef offsetC (+ kernelSize)
147+ modifySTRef' offsetC (+ kernelSize)
147148
148149 return dataCol
149150
@@ -159,15 +160,19 @@ im2colUnsafe kernelRows kernelColumns striderows stridecols dataIm = U.runSTMatr
159160 forM_ starts $ \(startRow, startCol) -> do
160161 inputColumnRef <- newSTRef 0
161162 inputRow <- readSTRef inputRowRef
162− forM_ [0 .. kernelRows -1] $ \kr ->
163− forM_ [0 .. kernelColumns -1] $ \kc -> do
163+ forM_ [startRow .. startRow + kernelRows -1] $ \kr ->
164+ forM_ [startCol .. startCol + kernelColumns -1] $ \kc -> do
164165 inputColumn <- readSTRef inputColumnRef
165− U.modifyMatrix dataCol inputRow inputColumn (+ U.atM' dataIm (kr + startRow) (kc + startCol))
166− modifySTRef inputColumnRef (+1)
167− modifySTRef inputRowRef (+1)
166+ unsafeModifyMatrix dataCol inputRow inputColumn (+ U.atM' dataIm kr kc)
167+ modifySTRef' inputColumnRef (+1)
168+ modifySTRef' inputRowRef (+1)
168169
169170 return dataCol
170171
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+
171176
172177-- | Returns the starting sub matrix locations which fit inside the larger matrix for the
173178-- 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 (
55 , poolBackwardList
66 ) where
77
8+import Data.Foldable ( forM_ )
89import Data.Function ( on )
910import Data.List ( maximumBy )
1011
@@ -12,7 +13,6 @@ import Numeric.LinearAlgebra hiding ( uniformSample, konst )
1213import qualified Numeric.LinearAlgebra as LA
1314import qualified Numeric.LinearAlgebra.Devel as U
1415
15−
1616import Grenade.Layers.Internal.Convolution
1717
1818poolForward :: Int -> Int -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
@@ -27,7 +27,7 @@ poolForwardList nrows ncols srows scols inRows inCols outputRows outputCols ms =
2727
2828poolForwardFit :: [(Int,Int)] -> Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
2929poolForwardFit 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
3131 in LA.matrix outputCols els
3232
3333poolBackward :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double -> Matrix Double
@@ -43,21 +43,27 @@ poolBackwardList krows kcols srows scols inRows inCols inputMatrices =
4343 in uncurry (poolBackwardFit starts krows kcols) <$> inputMatrices
4444
4545poolBackwardFit :: [(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
4747 let inRows = rows inputMatrix
4848 inCols = cols inputMatrix
49− inds = fmap (\start -> unsafeMaxIndex $ subMatrix start (krows, kcols) inputMatrix) starts
50− grads = toList $ flatten gradientMatrix
51− grads' = zip3 starts grads inds
52− accums = fmap (\((stx',sty'),grad,(inx, iny)) -> ((stx' + inx, sty' + iny), grad)) grads'
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]
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]
6267 pairs = concatMap ( \r -> fmap (\c -> (r , c)) mcols ) mrows
6368 in maximumBy (compare `on` uncurry (U.atM' m)) pairs
69+