repa-examples 3.0.0.2 → 3.1.0.1
raw patch · 14 files changed
+217/−203 lines, 14 filesdep ~repadep ~repa-algorithmsdep ~repa-io
Dependency ranges changed: repa, repa-algorithms, repa-io
Files
- examples/Blur/src-repa/Main.hs +21/−22
- examples/Canny/src-repa/Main.hs +50/−43
- examples/FFT/FFT2d/src-repa/Main.hs +11/−11
- examples/FFT/HighPass2d/src-repa/Main.hs +18/−20
- examples/FFT/HighPass3d/src-repa/Main.hs +17/−16
- examples/Laplace/src-repa/Main.hs +16/−16
- examples/Laplace/src-repa/SolverGet.hs +17/−12
- examples/Laplace/src-repa/SolverStencil.hs +8/−6
- examples/MMult/src-repa/Main.hs +3/−2
- examples/MMult/src-repa/Solver.hs +21/−18
- examples/Sobel/src-repa/Main.hs +4/−4
- examples/Sobel/src-repa/Solver.hs +4/−5
- examples/Volume/Main.hs +2/−3
- repa-examples.cabal +25/−25
examples/Blur/src-repa/Main.hs view
@@ -34,8 +34,7 @@ let comps = [arrRed, arrGreen, arrBlue] (comps', tElapsed)- <- time $ let comps' = P.map (process iterations) comps- in comps' `deepSeqArrays` return comps'+ <- time $ P.mapM (process iterations) comps putStr $ prettyTime tElapsed @@ -44,45 +43,45 @@ (U.zip3 arrRed' arrGreen' arrBlue') +process :: Monad m => Int -> Array U DIM2 Word8 -> m (Array U DIM2 Word8)+process iterations + = promote >=> blur iterations >=> demote {-# NOINLINE process #-}-process :: Int -> Array U DIM2 Word8 -> Array U DIM2 Word8-process iterations- = demote . blur iterations . promote -{-# NOINLINE promote #-}-promote :: Array U DIM2 Word8 -> Array U DIM2 Double+promote :: Monad m => Array U DIM2 Word8 -> m (Array U DIM2 Double) promote arr = computeP $ A.map ffs arr where {-# INLINE ffs #-} ffs :: Word8 -> Double ffs x = fromIntegral (fromIntegral x :: Int)+{-# NOINLINE promote #-} -{-# NOINLINE demote #-}-demote :: Array U DIM2 Double -> Array U DIM2 Word8+demote :: Monad m => Array U DIM2 Double -> m (Array U DIM2 Word8) demote arr = computeP $ A.map ffs arr where {-# INLINE ffs #-} ffs :: Double -> Word8 ffs x = fromIntegral (truncate x :: Int)+{-# NOINLINE demote #-} -{-# NOINLINE blur #-}-blur :: Int -> Array U DIM2 Double -> Array U DIM2 Double+blur :: Monad m => Int -> Array U DIM2 Double -> m (Array U DIM2 Double) blur !iterations arrInit = go iterations arrInit- where go :: Int -> Array U DIM2 Double -> Array U DIM2 Double- go !0 !arr = arr+ where go !0 !arr = return arr go !n !arr - = arr `deepSeqArray` go (n-1) - $ computeP- $ A.cmap (/ 159)- $ forStencil2 BoundClamp arr- [stencil2| 2 4 5 4 2- 4 9 12 9 4- 5 12 15 12 5- 4 9 12 9 4- 2 4 5 4 2 |]+ = arr `deepSeqArray` + do arr' <- computeP+ $ A.cmap (/ 159)+ $ forStencil2 BoundClamp arr+ [stencil2| 2 4 5 4 2+ 4 9 12 9 4+ 5 12 15 12 5+ 4 9 12 9 4+ 2 4 5 4 2 |]+ go (n-1) arr'+{-# NOINLINE blur #-}
examples/Canny/src-repa/Main.hs view
@@ -21,7 +21,6 @@ import Data.Array.Repa.Algorithms.Pixel import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing-import System.IO.Unsafe import Debug.Trace import GHC.Exts import qualified Data.Vector.Unboxed.Mutable as VM@@ -79,32 +78,32 @@ process loops threshLow threshHigh arrInput = do arrGrey <- timeStage loops "toGreyScale"- $ return $ toGreyScale arrInput+ $ toGreyScale arrInput arrBluredX <- timeStage loops "blurX"- $ return $ blurSepX arrGrey+ $ blurSepX arrGrey arrBlured <- timeStage loops "blurY"- $ return $ blurSepY arrBluredX+ $ blurSepY arrBluredX arrDX <- timeStage loops "diffX" - $ return $ gradientX arrBlured+ $ gradientX arrBlured arrDY <- timeStage loops "diffY"- $ return $ gradientY arrBlured+ $ gradientY arrBlured arrMagOrient <- timeStage loops "magOrient" - $ return $ gradientMagOrient threshLow arrDX arrDY+ $ gradientMagOrient threshLow arrDX arrDY arrSuppress <- timeStage loops "suppress" - $ return $ suppress threshLow threshHigh arrMagOrient+ $ suppress threshLow threshHigh arrMagOrient arrStrong <- timeStage loops "select"- $ return $ selectStrong arrSuppress + $ selectStrong arrSuppress arrEdges <- timeStage loops "wildfire"- $ return $ wildfire arrSuppress arrStrong + $ wildfire arrSuppress arrStrong return arrEdges @@ -117,7 +116,6 @@ -> IO (Array U sh a) -> IO (Array U sh a) -{-# NOINLINE timeStage #-} timeStage loops name fn = do let burn !n@@ -139,30 +137,30 @@ P.++ unlines [ " " P.++ l | l <- lines $ prettyTime t ] return arrResult+{-# NOINLINE timeStage #-} ------------------------------------------------------------------------------- -- | RGB to greyscale conversion.-{-# NOINLINE toGreyScale #-}-toGreyScale :: Image (Word8, Word8, Word8) -> Image Float+toGreyScale :: Monad m => Image (Word8, Word8, Word8) -> m (Image Float) toGreyScale arr = arr `deepSeqArray` computeP $ R.map (* 255) $ R.map floatLuminanceOfRGB8 arr +{-# NOINLINE toGreyScale #-} -- | Separable Gaussian blur in the X direction.-{-# NOINLINE blurSepX #-}-blurSepX :: Image Float -> Image Float+blurSepX :: Monad m => Image Float -> m (Image Float) blurSepX arr = arr `deepSeqArray` computeP $ forStencil2 BoundClamp arr [stencil2| 1 4 6 4 1 |] +{-# NOINLINE blurSepX #-} -- | Separable Gaussian blur in the Y direction.-{-# NOINLINE blurSepY #-}-blurSepY :: Image Float -> Image Float+blurSepY :: Monad m => Image Float -> m (Image Float) blurSepY arr = arr `deepSeqArray` computeP $ R.cmap (/ 256)@@ -172,48 +170,51 @@ 6 4 1 |]+{-# NOINLINE blurSepY #-} -- | Compute gradient in the X direction.-{-# NOINLINE gradientX #-}-gradientX :: Image Float -> Image Float+gradientX :: Monad m => Image Float -> m (Image Float) gradientX img = img `deepSeqArray` computeP $ forStencil2 BoundClamp img [stencil2| -1 0 1 -2 0 2 -1 0 1 |]+{-# NOINLINE gradientX #-} -- | Compute gradient in the Y direction.-{-# NOINLINE gradientY #-}-gradientY :: Image Float -> Image Float+gradientY :: Monad m => Image Float -> m (Image Float) gradientY img = img `deepSeqArray` computeP $ forStencil2 BoundClamp img [stencil2| 1 2 1 0 0 0 -1 -2 -1 |] +{-# NOINLINE gradientY #-} -- | Classify the magnitude and orientation of the vector gradient.-{-# NOINLINE gradientMagOrient #-}-gradientMagOrient :: Float -> Image Float -> Image Float -> Image (Float, Int)+gradientMagOrient + :: Monad m + => Float -> Image Float -> Image Float -> m (Image (Float, Int))+ gradientMagOrient !threshLow dX dY = [dX, dY] `deepSeqArrays` computeP $ R.zipWith magOrient dX dY - where {-# INLINE magOrient #-}- magOrient :: Float -> Float -> (Float, Int)+ where magOrient :: Float -> Float -> (Float, Int) magOrient !x !y = (magnitude x y, orientation x y)- - {-# INLINE magnitude #-}+ {-# INLINE magOrient #-}+ magnitude :: Float -> Float -> Float magnitude !x !y = sqrt (x * x + y * y)+ {-# INLINE magnitude #-} - {-# INLINE orientation #-}+ {-# INLINE orientation #-} orientation :: Float -> Float -> Int orientation !x !y @@ -252,12 +253,15 @@ else 64#) -- 0 +{-# NOINLINE gradientMagOrient #-}++ -- | Suppress pixels that are not local maxima, and use the magnitude to classify maxima -- into strong and weak (potential) edges.-{-# NOINLINE suppress #-}-suppress :: Float -> Float -> Image (Float, Int) -> Image Word8+suppress :: Monad m => Float -> Float -> Image (Float, Int) -> m (Image Word8) suppress !threshLow !threshHigh !dMagOrient- = dMagOrient `deepSeqArray` computeP+ = dMagOrient `deepSeqArray` + computeP $ makeBordered2 (extent dMagOrient) 1 (makeCursored (extent dMagOrient) id addDim comparePts)@@ -286,38 +290,38 @@ | m < intensity2 = edge None | m < threshHigh = edge Weak | otherwise = edge Strong+{-# NOINLINE suppress #-} -- | Select indices of strong edges. -- TODO: If would better if we could medge this into the above stage, and -- record the strong edge during non-maximum suppression, but Repa -- doesn't provide a fused mapFilter primitive yet.-{-# NOINLINE selectStrong #-}-selectStrong :: Image Word8 -> Array U DIM1 Int+selectStrong :: Monad m => Image Word8 -> m (Array U DIM1 Int) selectStrong img = img `deepSeqArray`- let {-# INLINE match #-}- vec = toUnboxed img- match ix = vec `V.unsafeIndex` ix == edge Strong+ let vec = toUnboxed img - {-# INLINE process' #-}+ match ix = vec `V.unsafeIndex` ix == edge Strong+ {-# INLINE match #-}+ process' ix = ix+ {-# INLINE process' #-} - in select match process' (size $ extent img)+ in selectP match process' (size $ extent img)+{-# NOINLINE selectStrong #-} -- | Trace out strong edges in the final image. -- Also trace out weak edges that are connected to strong edges.-{-# NOINLINE wildfire #-} wildfire - :: Image Word8 -- ^ Image with strong and weak edges set.+ :: Image Word8 -- ^ Image with strong and weak edges set. -> Array U DIM1 Int -- ^ Array containing flat indices of strong edges.- -> Image Word8+ -> IO (Image Word8) wildfire img arrStrong = img `deepSeqArray` arrStrong `deepSeqArray`- unsafePerformIO - $ do (sh, vec) <- wildfireIO + do (sh, vec) <- wildfireIO return $ sh `seq` vec `seq` fromUnboxed sh vec where lenImg = R.size $ R.extent img@@ -379,3 +383,6 @@ return (top + 1) else return top+{-# NOINLINE wildfire #-}++
examples/FFT/FFT2d/src-repa/Main.hs view
@@ -6,9 +6,9 @@ import Data.Array.Repa.Algorithms.Complex import Data.Array.Repa.Algorithms.Pixel import Data.Array.Repa.IO.BMP-import Data.Array.Repa as A import System.Environment import Control.Monad+import Data.Array.Repa as R import Data.Word @@ -36,32 +36,32 @@ arrRGB <- liftM (either (\e -> error $ show e) id) $ readImageFromBMP fileIn - arrComplex <- now $ computeUnboxedP- $ A.map (\r -> (r, 0 :: Double)) - $ A.map doubleLuminanceOfRGB8 arrRGB+ arrComplex <- computeUnboxedP+ $ R.map (\r -> (r, 0 :: Double)) + $ R.map doubleLuminanceOfRGB8 arrRGB -- Apply the centering transform so that the output has the zero -- frequency in the middle of the image.- arrCentered <- now $ computeUnboxedP+ arrCentered <- computeUnboxedP $ center2d arrComplex -- Do the 2d transform.- arrFreq <- now $ fft2d Forward arrCentered+ arrFreq <- fft2dP Forward arrCentered -- Write out the magnitude of the transformed array, -- clipping it at the given value. let clip m = if m >= clipMag then 1 else (m / clipMag)- arrMag <- now $ computeUnboxedP - $ A.map (rgb8OfGreyDouble . clip . mag) - $ arrFreq+ arrMag <- computeUnboxedP + $ R.map (rgb8OfGreyDouble . clip . mag) + $ arrFreq writeImageToBMP fileMag arrMag -- Write out the phase of the transformed array, -- scaling it to make full use of the 8 bit greyscale. let scaledArg x = (arg x + pi) / (2 * pi)- arrPhase <- now $ computeUnboxedP - $ A.map (rgb8OfGreyDouble . scaledArg) arrFreq+ arrPhase <- computeUnboxedP + $ R.map (rgb8OfGreyDouble . scaledArg) arrFreq writeImageToBMP filePhase arrPhase
examples/FFT/HighPass2d/src-repa/Main.hs view
@@ -6,11 +6,11 @@ import Data.Array.Repa.Algorithms.Complex import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing-import Data.Array.Repa as A-import qualified Data.Array.Repa.Repr.Unboxed as U import System.Environment import Control.Monad import Data.Word+import Data.Array.Repa as R+import qualified Data.Array.Repa.Repr.Unboxed as U main :: IO ()@@ -39,9 +39,9 @@ -- Do the transform on each component individually ((arrRed', arrGreen', arrBlue'), t) <- time- $ do arrRed' <- now $ transform cutoff arrRed- arrGreen' <- now $ transform cutoff arrGreen- arrBlue' <- now $ transform cutoff arrBlue+ $ do arrRed' <- transformP cutoff arrRed+ arrGreen' <- transformP cutoff arrGreen+ arrBlue' <- transformP cutoff arrBlue return (arrRed', arrGreen', arrBlue') putStr (prettyTime t)@@ -52,21 +52,21 @@ -- | Perform high-pass filtering on a rank-2 array.-transform :: Int -> Array U DIM2 Word8 -> Array U DIM2 Word8-transform cutoff arrReal- = let arrComplex = A.map (\r -> (fromIntegral r, 0)) arrReal+transformP :: Monad m => Int -> Array U DIM2 Word8 -> m (Array U DIM2 Word8)+transformP cutoff arrReal+ = do let arrComplex = R.map (\r -> (fromIntegral r, 0)) arrReal -- Do the 2d transform.- arrCentered = computeUnboxedP $ center2d arrComplex- arrFreq = fft2d Forward arrCentered+ arrCentered <- computeUnboxedP $ center2d arrComplex+ arrFreq <- fft2dP Forward arrCentered -- Zap out the low frequency components.- _ :. height :. width = extent arrFreq- centerX = width `div` 2- centerY = height `div` 2+ let _ :. height :. width = extent arrFreq+ let centerX = width `div` 2+ let centerY = height `div` 2 - {-# INLINE highpass #-}- highpass get ix@(_ :. y :. x)+ let {-# INLINE highpass #-}+ highpass get ix@(_ :. y :. x) | x > centerX + cutoff || x < centerX - cutoff || y > centerY + cutoff@@ -76,13 +76,11 @@ | otherwise = 0 - arrFilt = computeUnboxedP $ traverse arrFreq id highpass+ arrFilt <- computeUnboxedP $ traverse arrFreq id highpass -- Do the inverse transform to get back to image space.- arrInv = fft2d Inverse arrFilt+ arrInv <- fft2dP Inverse arrFilt -- Get the magnitude of the transformed array, - arrMag = computeUnboxedP $ A.map (truncate . mag) arrInv-- in arrMag+ computeUnboxedP $ R.map (truncate . mag) arrInv
examples/FFT/HighPass3d/src-repa/Main.hs view
@@ -6,12 +6,12 @@ import Data.Array.Repa.Algorithms.ColorRamp import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing-import Data.Array.Repa as A-import qualified Data.Array.Repa.Repr.Unboxed as U+import Data.Array.Repa as R import Data.Word import System.Environment import Control.Monad import Prelude as P+import qualified Data.Array.Repa.Repr.Unboxed as U main :: IO () main @@ -35,34 +35,35 @@ let center = size `div` 2 let cutoff = 4 - arrInit <- now $ computeP+ arrInit <- computeP $ fromFunction shape (\ix -> if isInCenteredCube center cubeSize ix then (1, 0) else (0, 0)) - (arrFinal, t) <- time $ now $ transform arrInit center cutoff+ (arrFinal, t) <- time $ transformP arrInit center cutoff putStr (prettyTime t) mapM_ (dumpSlice prefixOut arrFinal) [0..size - 1] -- | To the high pass transform.-transform- :: Array U DIM3 Complex+transformP+ :: Monad m+ => Array U DIM3 Complex -> Int -> Int- -> Array U DIM3 Complex-transform arrInit center cutoff- = let -- Transform to frequency space.- arrCentered = center3d arrInit- arrFreq = fft3d Forward arrCentered+ -> m (Array U DIM3 Complex)++transformP arrInit center cutoff+ = do -- Transform to frequency space.+ let arrCentered = center3d arrInit+ arrFreq <- fft3dP Forward arrCentered -- Zap out the high frequency components- arrFilt = traverse arrFreq id (highpass center cutoff)+ let arrFilt = traverse arrFreq id (highpass center cutoff) -- Do the inverse transform to get back to image space.- arrInv = fft3d Inverse arrFilt- in arrInv+ fft3dP Inverse arrFilt -- | Dump a numbered slice of this array to a BMP file.@@ -73,8 +74,8 @@ -> IO () dumpSlice prefix arr sliceNum- = do let arrSlice = slice arr (Any :. sliceNum :. All)- let arrGrey = computeUnboxedP $ A.map (truncate . (* 255) . mag) arrSlice+ = do let arrSlice = slice arr (Any :. sliceNum :. All)+ arrGrey <- computeUnboxedP $ R.map (truncate . (* 255) . mag) arrSlice let fileName = prefix P.++ (pad0 3 (show sliceNum)) P.++ ".bmp" writeImageToBMP fileName
examples/Laplace/src-repa/Main.hs view
@@ -1,11 +1,8 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, RankNTypes, FlexibleContexts #-} -- | Solver for the Laplace equation -- You supply a BMP files specifying the boundary conditions. -- The output is written back to another BMP file. ---import SolverGet as SG-import SolverStencil as SS-import Data.Array.Repa as A import Data.Array.Repa.Algorithms.Pixel import Data.Array.Repa.Algorithms.ColorRamp import Data.Array.Repa.IO.BMP @@ -13,14 +10,18 @@ import System.Environment import Data.Word import Control.Monad-import Prelude as P+import SolverGet as SG+import SolverStencil as SS+import Data.Array.Repa as R+import Prelude as P -type Solver - = Int -- ^ Number of iterations to use.+type Solver m + = Monad m+ => Int -- ^ Number of iterations to use. -> Array U DIM2 Double -- ^ Boundary value mask. -> Array U DIM2 Double -- ^ Boundary values. -> Array U DIM2 Double -- ^ Initial state.- -> Array U DIM2 Double+ -> m (Array U DIM2 Double) solvers = [ ("get", SG.solveLaplace)@@ -64,7 +65,7 @@ -- | Solve it.-laplace :: Solver+laplace :: Solver IO -> Int -- ^ Number of iterations to use. -> FilePath -- ^ Input file. -> FilePath -- ^ Output file@@ -76,20 +77,19 @@ arrImage <- liftM (either (error . show) id) $ readImageFromBMP fileInput - arrBoundValue <- now $ computeP $ A.map slurpBoundValue arrImage- arrBoundMask <- now $ computeP $ A.map slurpBoundMask arrImage+ arrBoundValue <- computeP $ R.map slurpBoundValue arrImage+ arrBoundMask <- computeP $ R.map slurpBoundMask arrImage let arrInitial = arrBoundValue -- Run the Laplace solver and print how long it took.- (arrFinal, t) <- time $ now - $ solve steps arrBoundMask arrBoundValue arrInitial+ (arrFinal, t) <- time $ solve steps arrBoundMask arrBoundValue arrInitial putStr (prettyTime t) -- Write out the result to a file.- arrImageOut <- now $ computeP- $ A.map rgb8OfDouble- $ A.map (rampColorHotToCold 0.0 1.0) arrFinal+ arrImageOut <- computeP+ $ R.map rgb8OfDouble+ $ R.map (rampColorHotToCold 0.0 1.0) arrFinal writeImageToBMP fileOutput arrImageOut
examples/Laplace/src-repa/SolverGet.hs view
@@ -2,25 +2,29 @@ module SolverGet (solveLaplace) where -import Data.Array.Repa as A+import Data.Array.Repa as R+import Data.Array.Repa.Unsafe as R import qualified Data.Array.Repa.Shape as S -- | Solver for the Laplace equation. solveLaplace- :: Int -- ^ Number of iterations to use.+ :: Monad m+ => Int -- ^ Number of iterations to use. -> Array U DIM2 Double -- ^ Boundary value mask. -> Array U DIM2 Double -- ^ Boundary values. -> Array U DIM2 Double -- ^ Initial state.- -> Array U DIM2 Double+ -> m (Array U DIM2 Double) -{-# NOINLINE solveLaplace #-} solveLaplace steps arrBoundMask arrBoundValue arrInit = go steps arrInit where go !i !arr- | i == 0 = arr+ | i == 0 + = return arr+ | otherwise - = let arr' = relaxLaplace arrBoundMask arrBoundValue arr- in arr' `deepSeqArray` go (i - 1) arr'+ = do arr' <- relaxLaplace arrBoundMask arrBoundValue arr+ go (i - 1) arr'+{-# NOINLINE solveLaplace #-} -- | Perform matrix relaxation for the Laplace equation,@@ -37,17 +41,17 @@ -- and 0 otherwise. -- relaxLaplace- :: Array U DIM2 Double -- ^ Boundary condition mask+ :: Monad m+ => Array U DIM2 Double -- ^ Boundary condition mask -> Array U DIM2 Double -- ^ Boundary condition values -> Array U DIM2 Double -- ^ Initial matrix- -> Array U DIM2 Double + -> m (Array U DIM2 Double) -{-# INLINE relaxLaplace #-} relaxLaplace arrBoundMask arrBoundValue arr = [arrBoundMask, arrBoundValue, arr] `deepSeqArrays` computeP- $ A.zipWith (+) arrBoundValue- $ A.zipWith (*) arrBoundMask+ $ R.zipWith (+) arrBoundValue+ $ R.zipWith (*) arrBoundMask $ unsafeTraverse arr id elemFn where _ :. height :. width @@ -68,5 +72,6 @@ isBorder !i !j = (i == 0) || (i >= width - 1) || (j == 0) || (j >= height - 1) +{-# INLINE relaxLaplace #-}
examples/Laplace/src-repa/SolverStencil.hs view
@@ -11,18 +11,19 @@ -- | Solver for the Laplace equation. solveLaplace- :: Int -- ^ Number of iterations to use.+ :: Monad m+ => Int -- ^ Number of iterations to use. -> Array U DIM2 Double -- ^ Boundary value mask. -> Array U DIM2 Double -- ^ Boundary values. -> Array U DIM2 Double -- ^ Initial state.- -> Array U DIM2 Double+ -> m (Array U DIM2 Double) -{-# NOINLINE solveLaplace #-} solveLaplace !steps !arrBoundMask !arrBoundValue !arrInit = go steps arrInit- where go 0 !arr = arr- go n !arr = go (n - 1) - $ relaxLaplace arrBoundMask arrBoundValue arr+ where go 0 !arr = return arr+ go n !arr + = do arr' <- relaxLaplace arrBoundMask arrBoundValue arr+ go (n - 1) arr' relaxLaplace arrBoundMask arrBoundValue arr = computeP@@ -33,3 +34,4 @@ [stencil2| 0 1 0 1 0 1 0 1 0 |] arr+{-# NOINLINE solveLaplace #-}
examples/MMult/src-repa/Main.hs view
@@ -87,13 +87,14 @@ mat1 `deepSeqArray` mat2 `deepSeqArray` return () -- Run the solver.- (matResult, t) <- time $ now $ mmultP mat1 mat2+ (matResult, t) <- time $ mmultP mat1 mat2 -- Print how long it took. putStr (prettyTime t) -- Print a checksum of all the elements- putStrLn $ "checkSum = " P.++ show (A.sumAllP matResult)+ checkSum <- A.sumAllP matResult+ putStrLn $ "checkSum = " P.++ show checkSum -- Write the output to file if requested. case mArgOut of
examples/MMult/src-repa/Solver.hs view
@@ -1,32 +1,34 @@ module Solver (mmultP) where-import Data.Array.Repa as R+import Data.Array.Repa as R+import Data.Array.Repa.Unsafe as R -- | Matrix matrix multiply.-mmultP :: Array U DIM2 Double +mmultP :: Monad m+ => Array U DIM2 Double -> Array U DIM2 Double - -> Array U DIM2 Double--mmultP arr' brr - = mmult' arr' (transpose2P brr) - where (Z :. h1 :. _) = extent arr'- (Z :. _ :. w2) = extent brr+ -> m (Array U DIM2 Double) - mmult' arr trr- = trr `deepSeqArray` computeP- $ fromFunction (Z :. h1 :. w2)- $ \ix -> R.sumAllS - $ R.zipWith (*)- (slice arr (Any :. (row ix) :. All))- (slice trr (Any :. (col ix) :. All))-{-# INLINE mmultP #-}+mmultP arr brr + = [arr, brr] `deepSeqArrays` + do trr <- transpose2P brr+ let (Z :. h1 :. _) = extent arr+ let (Z :. _ :. w2) = extent brr+ computeP + $ fromFunction (Z :. h1 :. w2)+ $ \ix -> R.sumAllS + $ R.zipWith (*)+ (unsafeSlice arr (Any :. (row ix) :. All))+ (unsafeSlice trr (Any :. (col ix) :. All))+{-# NOINLINE mmultP #-} -- | Transpose a 2D matrix. transpose2P- :: Array U DIM2 Double - -> Array U DIM2 Double+ :: Monad m+ => Array U DIM2 Double + -> m (Array U DIM2 Double) transpose2P arr = computeUnboxedP@@ -46,4 +48,5 @@ col :: DIM2 -> Int col (Z :. _ :. c) = c {-# INLINE col #-}+
examples/Sobel/src-repa/Main.hs view
@@ -29,7 +29,7 @@ traceEventIO "******** Sobel Luminance" (greyImage :: Array U DIM2 Float)- <- now $ computeP+ <- computeP $ R.map floatLuminanceOfRGB8 inputImage -- Run the filter.@@ -42,7 +42,7 @@ -- Write out the magnitute of the vector gradient as the result image. traceEventIO "******** Sobel Magnitude"- outImage <- now $ computeUnboxedP+ outImage <- computeUnboxedP $ R.map rgb8OfGreyFloat $ R.map (/ 3) $ R.zipWith magnitude gX gY @@ -58,8 +58,8 @@ then return (img, img) else do traceEventIO $ "******** Sobel Loop " Prelude.++ show n- gX <- now $ gradientX img- gY <- now $ gradientY img + gX <- gradientX img+ gY <- gradientY img if (n == 1) then return (gX, gY) else loop (n - 1) img
examples/Sobel/src-repa/Solver.hs view
@@ -12,25 +12,24 @@ type Image = Array U DIM2 Float --gradientX :: Image -> Image-{-# NOINLINE gradientX #-}+gradientX :: Monad m => Image -> m Image gradientX img = img `deepSeqArray` computeP $ forStencil2 (BoundConst 0) img [stencil2| -1 0 1 -2 0 2 -1 0 1 |]+{-# NOINLINE gradientX #-} -gradientY :: Image -> Image-{-# NOINLINE gradientY #-}+gradientY :: Monad m => Image -> m Image gradientY img = img `deepSeqArray` computeP $ forStencil2 (BoundConst 0) img [stencil2| 1 2 1 0 0 0 -1 -2 -1 |] +{-# NOINLINE gradientY #-}
examples/Volume/Main.hs view
@@ -72,9 +72,8 @@ else rampColorHotToCold 0 255 x) $ R.map fromIntegral arrInv - let arrColor' :: Array U DIM2 (Word8, Word8, Word8)- arrColor' = computeP- $ R.map (\(r, g, b) -> ( truncate (r * 255)+ (arrColor' :: Array U DIM2 (Word8, Word8, Word8))+ <- computeP $ R.map (\(r, g, b) -> ( truncate (r * 255) , truncate (g * 255) , truncate (b * 255))) $ arrColor
repa-examples.cabal view
@@ -1,5 +1,5 @@ Name: repa-examples-Version: 3.0.0.2+Version: 3.1.0.1 License: BSD3 License-file: LICENSE Author: The DPH Team@@ -20,8 +20,8 @@ Executable repa-canny Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-algorithms == 3.0.*,+ repa == 3.1.*,+ repa-algorithms == 3.1.*, template-haskell >= 2.5 && < 2.8 Main-is: examples/Canny/src-repa/Main.hs@@ -37,10 +37,10 @@ Executable repa-mmult Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-io == 3.0.*,- repa-algorithms == 3.0.*,- random == 1.0.*+ random == 1.0.*,+ repa == 3.1.*,+ repa-io == 3.1.*,+ repa-algorithms == 3.1.* Main-is: examples/MMult/src-repa/Main.hs other-modules: Solver@@ -58,8 +58,8 @@ Executable repa-laplace Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-io == 3.0.*+ repa == 3.1.*,+ repa-io == 3.1.* Main-is: examples/Laplace/src-repa/Main.hs other-modules: SolverGet SolverStencil@@ -75,9 +75,9 @@ Executable repa-fft2d Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-algorithms == 3.0.*,- repa-io == 3.0.*+ repa == 3.1.*,+ repa-algorithms == 3.1.*,+ repa-io == 3.1.* Main-is: examples/FFT/FFT2d/src-repa/Main.hs hs-source-dirs: examples/FFT/FFT2d/src-repa .@@ -94,9 +94,9 @@ Executable repa-fft2d-highpass Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-algorithms == 3.0.*,- repa-io == 3.0.*+ repa == 3.1.*,+ repa-algorithms == 3.1.*,+ repa-io == 3.1.* Main-is: examples/FFT/HighPass2d/src-repa/Main.hs hs-source-dirs: examples/FFT/HighPass2d/src-repa .@@ -114,8 +114,8 @@ Executable repa-fft3d-highpass Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-algorithms == 3.0.*+ repa == 3.1.*,+ repa-algorithms == 3.1.* Main-is: examples/FFT/HighPass3d/src-repa/Main.hs hs-source-dirs: examples/FFT/HighPass3d/src-repa .@@ -132,9 +132,9 @@ Executable repa-blur Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-algorithms == 3.0.*,- vector == 0.9.*+ vector == 0.9.*,+ repa == 3.1.*,+ repa-algorithms == 3.1.* Main-is: examples/Blur/src-repa/Main.hs hs-source-dirs: examples/Blur/src-repa .@@ -151,9 +151,9 @@ Executable repa-sobel Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-algorithms == 3.0.*,- template-haskell >= 2.5 && < 2.8+ template-haskell >= 2.5 && < 2.8,+ repa == 3.1.*,+ repa-algorithms == 3.1.* Main-is: examples/Sobel/src-repa/Main.hs other-modules: Solver@@ -171,8 +171,8 @@ Executable repa-volume Build-depends: base == 4.5.*,- repa == 3.0.*,- repa-io == 3.0.*+ repa == 3.1.*,+ repa-io == 3.1.* Main-is: examples/Volume/Main.hs ghc-options: