@@ -1,8 +1,11 @@
1+{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE ForeignFunctionInterface #-}
13module Grenade.Layers.Internal.Convolution (
24 col2vidUnsafe
35 , col2imUnsafe
46 , vid2colUnsafe
57 , im2colUnsafe
8+ , im2col_c
69 , fittingStarts
710 , unsafeModifyMatrix
811 ) where
@@ -13,11 +16,15 @@ import Data.STRef ( newSTRef, modifySTRef', writeSTRef, readSTRef )
1316import Data.Foldable ( forM_ )
1417import Data.Traversable ( forM )
1518
19+import Foreign ( mallocForeignPtrArray0, withForeignPtr )
20+import Foreign.Ptr ( Ptr )
1621import Foreign.Storable( Storable )
1722
1823import Numeric.LinearAlgebra hiding ( uniformSample, konst )
1924import qualified Numeric.LinearAlgebra.Devel as U
2025
26+import System.IO.Unsafe ( unsafePerformIO )
27+
2128-- This module provides provides im2col function and friends, ala caffe.
2229--
2330-- /* From Caffe */
@@ -105,13 +112,13 @@ col2vidUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows
105112 offsetR <- newSTRef 0
106113 offsetC <- newSTRef 0
107114 forM_ [0 .. columnMatrixRows - 1] $ \ir -> do
108− inputColumn <- newSTRef 0
109− offsetR' <- readSTRef offsetR
110− offsetC' <- readSTRef offsetC
115+ inputColumn <- newSTRef offsetM
116+ offsetR' <- readSTRef offsetR
117+ offsetC' <- readSTRef offsetC
111118 forM_ [offsetR' .. offsetR' + kernelRows -1] $ \kr ->
112119 forM_ [offsetC' .. offsetC' + kernelColumns -1] $ \kc -> do
113120 ic <- readSTRef inputColumn
114− unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix ir (ic + offsetM))
121+ unsafeModifyMatrix dataIm kr kc (+ U.atM' columnMatrix ir ic)
115122 modifySTRef' inputColumn (+1)
116123
117124 if offsetC' + kernelColumns < destinationCols
@@ -120,6 +127,62 @@ col2vidUnsafe kernelRows kernelColumns strideRows strideColumns destinationRows
120127
121128 U.unsafeFreezeMatrix dataIm
122129
130+
131+im2col_c :: Int -> Int -> Int -> Int -> Matrix Double -> Matrix Double
132+im2col_c kernelRows kernelColumns strideRows strideColumns dataIm =
133+ let height = rows dataIm
134+ width = cols dataIm
135+ vec = flatten dataIm
136+ rowOut = (height - kernelRows) `div` strideRows + 1
137+ colOut = (width - kernelColumns) `div` strideColumns + 1
138+ kernelSize = kernelRows * kernelColumns
139+ numberOfPatches = rowOut * colOut
140+ in unsafePerformIO $ do
141+ outPtr <- mallocForeignPtrArray0 (numberOfPatches * kernelSize)
142+ let (inPtr, inOffset, _) = U.unsafeToForeignPtr vec
143+
144+ withForeignPtr inPtr $ \inPtr' ->
145+ withForeignPtr outPtr $ \outPtr' ->
146+ im2col_cpu inPtr' inOffset 1 height width kernelRows kernelColumns strideRows strideColumns outPtr'
147+
148+ let matVec = U.unsafeFromForeignPtr outPtr 0 (numberOfPatches * kernelSize)
149+ return $ U.matrixFromVector U.RowMajor numberOfPatches kernelSize matVec
150+
151+foreign import ccall safe
152+ im2col_cpu
153+ :: Ptr Double -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Ptr Double -> IO ()
154+
155+
156+unsafeModifyMatrix :: (Storable t) => U.STMatrix s t -> Int -> Int -> (t -> t) -> ST s ()
157+unsafeModifyMatrix x r c f = U.unsafeReadMatrix x r c >>= U.unsafeWriteMatrix x r c . f
158+{-# INLINE unsafeModifyMatrix #-}
159+
160+
161+-- | Returns the starting sub matrix locations which fit inside the larger matrix for the
162+-- convolution. Takes into account the stride and kernel size.
163+fittingStarts :: Int -> Int -> Int -> Int -> Int -> Int -> [(Int,Int)]
164+fittingStarts nrows kernelrows steprows ncols kernelcols stepcolsh =
165+ let rs = fittingStart nrows kernelrows steprows
166+ cs = fittingStart ncols kernelcols stepcolsh
167+ in concatMap ( \r -> fmap (\c -> (r , c)) cs ) rs
168+
169+-- | Returns the starting sub vector which fit inside the larger vector for the
170+-- convolution. Takes into account the stride and kernel size.
171+fittingStart :: Int -> Int -> Int -> [Int]
172+fittingStart width kernel steps =
173+ let go left | left + kernel < width
174+ = left : go (left + steps)
175+ | left + kernel == width
176+ = [left]
177+ | otherwise
178+ = []
179+ in go 0
180+
181+
182+
183+
184+-- | Old functions (useful for sanity checking and benchmarking)
185+
123186vid2colUnsafe :: Int -> Int -> Int -> Int -> Int -> Int -> [Matrix Double] -> Matrix Double
124187vid2colUnsafe kernelRows kernelColumns striderows stridecols vidrows vidcols dataVid = U.runSTMatrix $ do
125188 let starts = fittingStarts vidrows kernelRows striderows vidcols kernelColumns stridecols
@@ -168,28 +231,3 @@ im2colUnsafe kernelRows kernelColumns striderows stridecols dataIm = U.runSTMatr
168231 modifySTRef' inputRowRef (+1)
169232
170233 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