repa-examples 2.2.0.1 → 3.0.0.1
raw patch · 14 files changed
+434/−514 lines, 14 filesdep ~basedep ~repadep ~repa-algorithms
Dependency ranges changed: base, repa, repa-algorithms, repa-io, template-haskell
Files
- LICENSE +1/−1
- examples/Blur/src-repa/Main.hs +39/−49
- examples/Canny/src-repa/Main.hs +135/−138
- examples/FFT/FFT2d/src-repa/Main.hs +27/−14
- examples/FFT/HighPass2d/src-repa/Main.hs +19/−22
- examples/FFT/HighPass3d/src-repa/Main.hs +11/−16
- examples/Laplace/src-repa/Main.hs +27/−81
- examples/Laplace/src-repa/SolverGet.hs +15/−17
- examples/Laplace/src-repa/SolverStencil.hs +17/−33
- examples/MMult/src-repa/Main.hs +6/−9
- examples/Sobel/src-repa/Main.hs +38/−50
- examples/Sobel/src-repa/Solver.hs +8/−7
- examples/Volume/Main.hs +18/−17
- repa-examples.cabal +73/−60
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010, University of New South Wales.+Copyright (c) 2010-2012, University of New South Wales. All rights reserved. Redistribution and use in source and binary forms, with or without
examples/Blur/src-repa/Main.hs view
@@ -7,10 +7,11 @@ import Data.Word import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing-import Data.Array.Repa.Algorithms.Iterate-import Data.Array.Repa as A-import Data.Array.Repa.Stencil as A-import Prelude as P+import Data.Array.Repa as A+import qualified Data.Array.Repa.Repr.Unboxed as U+import Data.Array.Repa.Stencil as A+import Data.Array.Repa.Stencil.Dim2 as A+import Prelude as P main = do args <- getArgs@@ -20,42 +21,48 @@ usage = putStr $ unlines [ "repa-blur <iterations::Int> <fileIn.bmp> <fileOut.bmp>" ]- +++-- | Perform the blur.+run :: Int -> FilePath -> FilePath -> IO () run iterations fileIn fileOut- = do comps <- liftM (either (error . show) id) - $ readComponentsListFromBMP fileIn+ = do arrRGB <- liftM (either (error . show) id) + $ readImageFromBMP fileIn - comps `deepSeqArrays` return ()+ arrRGB `deepSeqArray` return ()+ let (arrRed, arrGreen, arrBlue) = U.unzip3 arrRGB+ let comps = [arrRed, arrGreen, arrBlue] (comps', tElapsed) <- time $ let comps' = P.map (process iterations) comps in comps' `deepSeqArrays` return comps' putStr $ prettyTime tElapsed- - writeComponentsListToBMP fileOut comps' + let [arrRed', arrGreen', arrBlue'] = comps'+ writeImageToBMP fileOut+ (U.zip3 arrRed' arrGreen' arrBlue')++ {-# NOINLINE process #-}-process :: Int -> Array DIM2 Word8 -> Array DIM2 Word8-process iterations = demote . blur iterations . promote+process :: Int -> Array U DIM2 Word8 -> Array U DIM2 Word8+process iterations+ = demote . blur iterations . promote {-# NOINLINE promote #-}-promote :: Array DIM2 Word8 -> Array DIM2 Double-promote arr@(Array _ [Region RangeAll (GenManifest _)])- = arr `deepSeqArray` force- $ A.map ffs arr-+promote :: Array U DIM2 Word8 -> Array U DIM2 Double+promote arr+ = computeP $ A.map ffs arr where {-# INLINE ffs #-} ffs :: Word8 -> Double ffs x = fromIntegral (fromIntegral x :: Int) {-# NOINLINE demote #-}-demote :: Array DIM2 Double -> Array DIM2 Word8-demote arr@(Array _ [Region RangeAll (GenManifest _)])- = arr `deepSeqArray` force- $ A.map ffs arr+demote :: Array U DIM2 Double -> Array U DIM2 Word8+demote arr+ = computeP $ A.map ffs arr where {-# INLINE ffs #-} ffs :: Double -> Word8@@ -63,36 +70,19 @@ {-# NOINLINE blur #-}-blur :: Int -> Array DIM2 Double -> Array DIM2 Double-blur !iterations arr@(Array _ [Region RangeAll (GenManifest _)])- = arr `deepSeqArray` force2- $ iterateBlockwise' iterations arr- $ A.map (/ 159)- . mapStencil2 BoundClamp- [stencil2| 2 4 5 4 2+blur :: Int -> Array U DIM2 Double -> 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+ 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 |] --{- version using convolveOut--- | Run several iterations of blurring.-blur :: Int -> Array DIM2 Double -> Array DIM2 Double-blur 0 arr = arr-blur n arr = blurs (n - 1) (force $ blur arr)---- | Run a single iteration of blurring.-blur :: Array DIM2 Double -> Array DIM2 Double-blur input@Manifest{}- = convolveOut outClamp kernel input- where kernel = force - $ A.fromList (Z :. 5 :. 5) - $ Data.List.map (\x -> x / 159) - [2.0, 4.0, 5.0, 4.0, 2.0,- 4.0, 9.0, 12.0, 9.0, 4.0,- 5.0, 12.0, 15.0, 12.0, 5.0,- 4.0, 9.0, 12.0, 9.0, 4.0,- 2.0, 4.0, 5.0, 4.0, 2.0]--} -
examples/Canny/src-repa/Main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards #-}+{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards, MagicHash, ScopedTypeVariables #-} {-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-incomplete-patterns #-} -- | Canny edge detector.@@ -13,33 +13,40 @@ import Control.Monad import System.Environment import Data.Array.Repa as R+import Data.Array.Repa.Repr.Unboxed as U+import Data.Array.Repa.Repr.Cursored as C import Data.Array.Repa.Stencil+import Data.Array.Repa.Stencil.Dim2 import Data.Array.Repa.Specialised.Dim2+import Data.Array.Repa.Algorithms.Pixel import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing-import Prelude hiding (compare)- import System.IO.Unsafe+import Debug.Trace+import GHC.Exts import qualified Data.Vector.Unboxed.Mutable as VM import qualified Data.Vector.Unboxed as V import Prelude as P+import Prelude hiding (compare) -type Image a = Array DIM2 a +type Image a = Array U DIM2 a+ -- Constants ------------------------------------------------------------------ -- TODO: It would be better to use Word8 to represent the edge orientations, -- but doing so currently triggers a bug in the LLVM mangler.-orientUndef = 0 :: Float-orientPosDiag = 64 :: Float-orientVert = 128 :: Float-orientNegDiag = 192 :: Float-orientHoriz = 255 :: Float+orientUndef = 0 :: Int+orientPosDiag = 64 :: Int+orientVert = 128 :: Int+orientNegDiag = 192 :: Int+orientHoriz = 255 :: Int data Edge = None | Weak | Strong edge None = 0 :: Word8 edge Weak = 128 :: Word8 edge Strong = 255 :: Word8 + -- Main routine --------------------------------------------------------------- main = do args <- getArgs@@ -50,64 +57,83 @@ [loops, threshLow, threshHigh, fileIn, fileOut] -> run (read loops) (read threshLow) (read threshHigh) fileIn fileOut - _ -> putStrLn "repa-canny [<loops::Int> <threshLow::Int> <threshHigh::Int>] <fileIn.bmp> <fileOut.bmp>"+ _ -> putStrLn + $ concat [ "repa-canny [<loops::Int> <threshLow::Int> <threshHigh::Int>]"+ , " <fileIn.bmp> <fileOut.bmp>" ] run loops threshLow threshHigh fileIn fileOut- = do arrInput <- liftM (force . either (error . show) id) - $ readImageFromBMP fileIn+ = do arrInput <- liftM (either (error . show) id) + $ readImageFromBMP fileIn - arrInput `deepSeqArray` return () (arrResult, tTotal)- <- time- $ do {-let stage str arr - = timeStage loops str $ return arr-}- - arrGrey <- timeStage loops "toGreyScale" $ return $ toGreyScale arrInput- arrBluredX <- timeStage loops "blurX" $ return $ blurSepX arrGrey- arrBlured <- timeStage loops "blurY" $ return $ blurSepY arrBluredX- arrDX <- timeStage loops "diffX" $ return $ gradientX arrBlured- arrDY <- timeStage loops "diffY" $ return $ gradientY arrBlured- - arrMagOrient <- timeStage loops "magOrient" - $ return $ gradientMagOrient threshLow arrDX arrDY-- arrSuppress <- timeStage loops "suppress" - $ return $ suppress threshLow threshHigh arrMagOrient-- arrStrong <- timeStage loops "select" $ return $ selectStrong arrSuppress - arrEdges <- timeStage loops "wildfire" $ return $ wildfire arrSuppress arrStrong -- return arrEdges+ <- time $ process loops threshLow threshHigh arrInput when (loops >= 1) $ putStrLn $ "\nTOTAL\n" putStr $ prettyTime tTotal - writeComponentsToBMP fileOut arrResult arrResult arrResult+ writeImageToBMP fileOut (U.zip3 arrResult arrResult arrResult) +process loops threshLow threshHigh arrInput+ = do arrGrey <- timeStage loops "toGreyScale"+ $ return $ toGreyScale arrInput++ arrBluredX <- timeStage loops "blurX"+ $ return $ blurSepX arrGrey++ arrBlured <- timeStage loops "blurY"+ $ return $ blurSepY arrBluredX+++ arrDX <- timeStage loops "diffX" + $ return $ gradientX arrBlured++ arrDY <- timeStage loops "diffY"+ $ return $ gradientY arrBlured+ + arrMagOrient <- timeStage loops "magOrient" + $ return $ gradientMagOrient threshLow arrDX arrDY++ arrSuppress <- timeStage loops "suppress" + $ return $ suppress threshLow threshHigh arrMagOrient++ arrStrong <- timeStage loops "select"+ $ return $ selectStrong arrSuppress ++ arrEdges <- timeStage loops "wildfire"+ $ return $ wildfire arrSuppress arrStrong ++ return arrEdges++ -- | Wrapper to time each stage of the algorithm. timeStage- :: (Shape sh, Elt a)+ :: (Shape sh, Unbox a) => Int -> String - -> (IO (Array sh a))- -> (IO (Array sh a))+ -> IO (Array U sh a)+ -> IO (Array U sh a) {-# NOINLINE timeStage #-} timeStage loops name fn- = do let burn !n+ = do + let burn !n = do arr <- fn arr `deepSeqArray` return () if n <= 1 then return arr else burn (n - 1)- ++ traceEventIO $ "**** Stage " P.++ name P.++ " begin."+ (arrResult, t) <- time $ do arrResult' <- burn loops arrResult' `deepSeqArray` return arrResult' + traceEventIO $ "**** Stage " P.++ name P.++ " end."+ when (loops >= 1) $ putStr $ name P.++ "\n" P.++ unlines [ " " P.++ l | l <- lines $ prettyTime t ]@@ -116,58 +142,30 @@ ---------------------------------------------------------------------------------- | The default conversions supplied via the prelude go via a GMP function--- call instead of just using the appropriate primop.-{-# INLINE floatOfWord8 #-}-floatOfWord8 :: Word8 -> Float-floatOfWord8 w8- = fromIntegral (fromIntegral w8 :: Int)---{-# INLINE word8OfFloat #-}-word8OfFloat :: Float -> Word8-word8OfFloat f- = fromIntegral (truncate f :: Int)---------------------------------------------------------------------------------- -- | RGB to greyscale conversion. {-# NOINLINE toGreyScale #-}-toGreyScale :: Array DIM3 Word8 -> Array DIM2 Word8-toGreyScale - arr@(Array _ [Region RangeAll (GenManifest _)])- = arr `deepSeqArray` force2- $ unsafeTraverse arr- (\(sh :. _) -> sh)- (\get ix -> rgbToLuminance - (get (ix :. 0))- (get (ix :. 1))- (get (ix :. 2)))-- where {-# INLINE rgbToLuminance #-}- rgbToLuminance :: Word8 -> Word8 -> Word8 -> Word8- rgbToLuminance r g b - = word8OfFloat - ( floatOfWord8 r * 0.3- + floatOfWord8 g * 0.59- + floatOfWord8 b * 0.11)+toGreyScale :: Image (Word8, Word8, Word8) -> Image Float+toGreyScale arr+ = arr `deepSeqArray` computeP+ $ R.map (* 255)+ $ R.map floatLuminanceOfRGB8 arr -- | Separable Gaussian blur in the X direction. {-# NOINLINE blurSepX #-}-blurSepX :: Array DIM2 Word8 -> Array DIM2 Float-blurSepX arr@(Array _ [Region RangeAll (GenManifest _)]) - = arr `deepSeqArray` force2- $ forStencilFrom2 BoundClamp arr floatOfWord8- [stencil2| 1 4 6 4 1 |] +blurSepX :: Image Float -> Image Float+blurSepX arr+ = arr `deepSeqArray` computeP+ $ forStencil2 BoundClamp arr+ [stencil2| 1 4 6 4 1 |] -- | Separable Gaussian blur in the Y direction. {-# NOINLINE blurSepY #-}-blurSepY :: Array DIM2 Float -> Array DIM2 Float-blurSepY arr@(Array _ [Region RangeAll (GenManifest _)]) - = arr `deepSeqArray` force2- $ R.map (/ 256)+blurSepY :: Image Float -> Image Float+blurSepY arr+ = arr `deepSeqArray` computeP+ $ R.cmap (/ 256) $ forStencil2 BoundClamp arr [stencil2| 1 4@@ -178,10 +176,10 @@ -- | Compute gradient in the X direction. {-# NOINLINE gradientX #-}-gradientX :: Array DIM2 Float -> Array DIM2 Float-gradientX img@(Array _ [Region RangeAll (GenManifest _)])- = img `deepSeqArray` force2- $ forStencil2 (BoundConst 0) img+gradientX :: Image Float -> Image Float+gradientX img+ = img `deepSeqArray` computeP+ $ forStencil2 BoundClamp img [stencil2| -1 0 1 -2 0 2 -1 0 1 |]@@ -189,10 +187,10 @@ -- | Compute gradient in the Y direction. {-# NOINLINE gradientY #-}-gradientY :: Array DIM2 Float -> Array DIM2 Float-gradientY img@(Array _ [Region RangeAll (GenManifest _)])- = img `deepSeqArray` force2- $ forStencil2 (BoundConst 0) img+gradientY :: Image Float -> Image Float+gradientY img+ = img `deepSeqArray` computeP+ $ forStencil2 BoundClamp img [stencil2| 1 2 1 0 0 0 -1 -2 -1 |] @@ -200,16 +198,13 @@ -- | Classify the magnitude and orientation of the vector gradient. {-# NOINLINE gradientMagOrient #-}-gradientMagOrient :: Float -> Image Float -> Image Float -> Image (Float, Float)-gradientMagOrient !threshLow - dX@(Array _ [Region RangeAll (GenManifest _)])- dY@(Array _ [Region RangeAll (GenManifest _)])-- = [dX, dY] `deepSeqArrays` force2- $ R.zipWith magOrient dX dY+gradientMagOrient :: Float -> Image Float -> Image Float -> Image (Float, Int)+gradientMagOrient !threshLow dX dY+ = [dX, dY] `deepSeqArrays` computeP+ $ R.zipWith magOrient dX dY where {-# INLINE magOrient #-}- magOrient :: Float -> Float -> (Float, Float)+ magOrient :: Float -> Float -> (Float, Int) magOrient !x !y = (magnitude x y, orientation x y) @@ -219,13 +214,13 @@ = sqrt (x * x + y * y) {-# INLINE orientation #-}- orientation :: Float -> Float -> Float+ orientation :: Float -> Float -> Int orientation !x !y -- Don't bother computing orientation if vector is below threshold. | x >= negate threshLow, x < threshLow , y >= negate threshLow, y < threshLow- = orientUndef+ = orientUndef | otherwise = let -- Determine the angle of the vector and rotate it around a bit@@ -237,45 +232,45 @@ !dNorm = if dRot < 0 then dRot + 8 else dRot -- Doing explicit tests seems to be faster than using the FP floor function.- in if dNorm >= 4- then if dNorm >= 6- then if dNorm >= 7- then orientHoriz -- 7- else orientNegDiag -- 6+ in I# (if dNorm >= 4+ then if dNorm >= 6+ then if dNorm >= 7+ then 255# -- 7+ else 192# -- 6 - else if dNorm >= 5- then orientVert -- 5- else orientPosDiag -- 4+ else if dNorm >= 5+ then 128# -- 5+ else 64# -- 4 - else if dNorm >= 2+ else if dNorm >= 2 then if dNorm >= 3- then orientHoriz -- 3- else orientNegDiag -- 2+ then 255# -- 3+ else 192# -- 2 else if dNorm >= 1- then orientVert -- 1- else orientPosDiag -- 0+ then 128# -- 1+ else 64#) -- 0 -- | 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, Float) -> Image Word8-suppress threshLow threshHigh- dMagOrient@(Array shSrc [Region RangeAll (GenManifest _)]) - = dMagOrient `deepSeqArray` force2 - $ makeBordered2 shSrc 1 - (GenCursor id addDim (const 0))- (GenCursor id addDim comparePts)+suppress :: Float -> Float -> Image (Float, Int) -> Image Word8+suppress !threshLow !threshHigh !dMagOrient+ = dMagOrient `deepSeqArray` computeP+ $ makeBordered2 + (extent dMagOrient) 1 + (makeCursored (extent dMagOrient) id addDim comparePts)+ (fromFunction (extent dMagOrient) (const 0)) where {-# INLINE comparePts #-} comparePts d@(sh :. i :. j) | o == orientUndef = edge None | o == orientHoriz = isMax (getMag (sh :. i :. j-1)) (getMag (sh :. i :. j+1)) | o == orientVert = isMax (getMag (sh :. i-1 :. j)) (getMag (sh :. i+1 :. j)) - | o == orientNegDiag = isMax (getMag (sh :. i-1 :. j-1)) (getMag (sh :. i+1 :. j+1)) - | o == orientPosDiag = isMax (getMag (sh :. i-1 :. j+1)) (getMag (sh :. i+1 :. j-1)) - | otherwise = edge None+ | o == orientNegDiag = isMax (getMag (sh :. i-1 :. j-1)) (getMag (sh :. i+1 :. j+1)) + | o == orientPosDiag = isMax (getMag (sh :. i-1 :. j+1)) (getMag (sh :. i+1 :. j-1)) + | otherwise = edge None where !o = getOrient d @@ -285,7 +280,7 @@ getOrient = snd . (R.unsafeIndex dMagOrient) {-# INLINE isMax #-}- isMax intensity1 intensity2+ isMax !intensity1 !intensity2 | m < threshLow = edge None | m < intensity1 = edge None | m < intensity2 = edge None@@ -294,38 +289,40 @@ -- | 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.+-- 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 DIM1 Int-selectStrong img@(Array _ [Region RangeAll (GenManifest vec)])- = img `deepSeqArray` +selectStrong :: Image Word8 -> Array U DIM1 Int+selectStrong img+ = img `deepSeqArray` let {-# INLINE match #-}+ vec = toUnboxed img match ix = vec `V.unsafeIndex` ix == edge Strong - {-# INLINE process #-}- process ix = ix+ {-# INLINE process' #-}+ process' ix = ix - in select match process (size $ extent img)+ in select match process' (size $ extent img) -- | 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.- -> Array DIM1 Int -- ^ Array containing flat indices of strong edges.+ :: Image Word8 -- ^ Image with strong and weak edges set.+ -> Array U DIM1 Int -- ^ Array containing flat indices of strong edges. -> Image Word8 -wildfire img@(Array _ [Region RangeAll (GenManifest _)]) arrStrong- = unsafePerformIO +wildfire img arrStrong+ = img `deepSeqArray` arrStrong `deepSeqArray`+ unsafePerformIO $ do (sh, vec) <- wildfireIO - return $ sh `seq` vec `seq` - Array sh [Region RangeAll (GenManifest vec)]+ return $ sh `seq` vec `seq` fromUnboxed sh vec where lenImg = R.size $ R.extent img lenStrong = R.size $ R.extent arrStrong- vStrong = toVector arrStrong+ vStrong = toUnboxed arrStrong wildfireIO = do -- Stack of image indices we still need to consider.
examples/FFT/FFT2d/src-repa/Main.hs view
@@ -4,11 +4,14 @@ import Data.Array.Repa.Algorithms.FFT import Data.Array.Repa.Algorithms.DFT.Center 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.Word+ main :: IO () main = do args <- getArgs@@ -25,31 +28,41 @@ , " most of the pixels in the output BMP will be black. Start with a value equal" , " to about the width of the image (eg 512)" , "" ]- + mainWithArgs fileIn (clipMag :: Double) fileMag filePhase = do -- Load in the matrix.- arrReal <- liftM (either (\e -> error $ show e) force)- $ readMatrixFromGreyscaleBMP fileIn-- let arrComplex = force $ A.map (\r -> (r, 0 :: Double)) arrReal+ arrRGB <- liftM (either (\e -> error $ show e) id)+ $ readImageFromBMP fileIn+ + arrComplex <- now $ computeUnboxedP+ $ A.map (\r -> (r, 0 :: Double)) + $ A.map doubleLuminanceOfRGB8 arrRGB -- Apply the centering transform so that the output has the zero -- frequency in the middle of the image.- let arrCentered = center2d arrComplex+ arrCentered <- now $ computeUnboxedP+ $ center2d arrComplex -- Do the 2d transform.- let arrFreq = fft2d Forward arrCentered+ arrFreq <- now $ fft2d Forward arrCentered -- Write out the magnitude of the transformed array, -- clipping it at the given value.- let clip m = if m >= clipMag then clipMag else m- let arrMag = force $ A.map (clip . mag) arrFreq- writeMatrixToGreyscaleBMP fileMag arrMag+ let clip m = if m >= clipMag then 1 else (m / clipMag)+ arrMag <- now $ computeUnboxedP + $ A.map (rgb8OfGreyDouble . clip . mag) + $ arrFreq - -- Write out the phase of the transofmed array, + 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) * (255 / (2 * pi))- let arrPhase = force $ A.map scaledArg arrFreq- writeMatrixToGreyscaleBMP filePhase arrPhase+ let scaledArg x = (arg x + pi) / (2 * pi)+ arrPhase <- now $ computeUnboxedP + $ A.map (rgb8OfGreyDouble . scaledArg) arrFreq++ writeImageToBMP filePhase arrPhase++
examples/FFT/HighPass2d/src-repa/Main.hs view
@@ -7,8 +7,10 @@ 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 main :: IO ()@@ -28,39 +30,34 @@ mainWithArgs cutoff fileIn fileOut = do -- Load in the matrix.- (arrRed, arrGreen, arrBlue)- <- liftM (either (\e -> error $ show e) id)- $ readComponentsFromBMP fileIn+ arrRGB <- liftM (either (\e -> error $ show e) id)+ $ readImageFromBMP fileIn - -- The deepSeqs are to make sure we're just measuring the transform time.- arrRed - `deepSeqArray` arrGreen- `deepSeqArray` arrBlue- `deepSeqArray` return ()- + let (arrRed, arrGreen, arrBlue)+ = U.unzip3 arrRGB+ -- Do the transform on each component individually ((arrRed', arrGreen', arrBlue'), t) <- time- $ let arrRed' = transform cutoff arrRed- arrGreen' = transform cutoff arrGreen- arrBlue' = transform cutoff arrBlue- in arrRed' - `deepSeqArray` arrGreen'- `deepSeqArray` arrBlue'- `deepSeqArray` return (arrRed', arrGreen', arrBlue')+ $ do arrRed' <- now $ transform cutoff arrRed+ arrGreen' <- now $ transform cutoff arrGreen+ arrBlue' <- now $ transform cutoff arrBlue+ return (arrRed', arrGreen', arrBlue') putStr (prettyTime t) -- Write it back to file.- writeComponentsToBMP fileOut- arrRed' arrGreen' arrBlue' + writeImageToBMP fileOut+ (U.zip3 arrRed' arrGreen' arrBlue') +-- | Perform high-pass filtering on a rank-2 array.+transform :: Int -> Array U DIM2 Word8 -> Array U DIM2 Word8 transform cutoff arrReal- = let arrComplex = force $ A.map (\r -> (fromIntegral r, 0)) arrReal+ = let arrComplex = A.map (\r -> (fromIntegral r, 0)) arrReal -- Do the 2d transform.- arrCentered = center2d arrComplex+ arrCentered = computeUnboxedP $ center2d arrComplex arrFreq = fft2d Forward arrCentered -- Zap out the low frequency components.@@ -79,13 +76,13 @@ | otherwise = 0 - arrFilt = traverse arrFreq id highpass+ arrFilt = computeUnboxedP $ traverse arrFreq id highpass -- Do the inverse transform to get back to image space. arrInv = fft2d Inverse arrFilt -- Get the magnitude of the transformed array, - arrMag = A.map (truncate . mag) arrInv+ arrMag = computeUnboxedP $ A.map (truncate . mag) arrInv in arrMag
examples/FFT/HighPass3d/src-repa/Main.hs view
@@ -3,10 +3,11 @@ import Data.Array.Repa.Algorithms.FFT import Data.Array.Repa.Algorithms.DFT.Center import Data.Array.Repa.Algorithms.Complex+import Data.Array.Repa.Algorithms.ColorRamp import Data.Array.Repa.IO.BMP-import Data.Array.Repa.IO.ColorRamp import Data.Array.Repa.IO.Timing import Data.Array.Repa as A+import qualified Data.Array.Repa.Repr.Unboxed as U import Data.Word import System.Environment import Control.Monad@@ -34,18 +35,12 @@ let center = size `div` 2 let cutoff = 4 - let arrInit = force - $ fromFunction shape + arrInit <- now $ computeP+ $ fromFunction shape (\ix -> if isInCenteredCube center cubeSize ix then (1, 0) else (0, 0)) - arrInit `deepSeqArray` return ()-- (arrFinal, t)- <- time - $ let arrFinal' = transform arrInit center cutoff- in arrFinal' `deepSeqArray` return arrFinal'-+ (arrFinal, t) <- time $ now $ transform arrInit center cutoff putStr (prettyTime t) mapM_ (dumpSlice prefixOut arrFinal) [0..size - 1]@@ -53,10 +48,10 @@ -- | To the high pass transform. transform- :: Array DIM3 Complex+ :: Array U DIM3 Complex -> Int -> Int- -> Array DIM3 Complex+ -> Array U DIM3 Complex transform arrInit center cutoff = let -- Transform to frequency space. arrCentered = center3d arrInit@@ -73,17 +68,17 @@ -- | Dump a numbered slice of this array to a BMP file. dumpSlice :: FilePath- -> Array DIM3 Complex+ -> Array U DIM3 Complex -> Int -> IO () dumpSlice prefix arr sliceNum = do let arrSlice = slice arr (Any :. sliceNum :. All)- let arrGrey = A.map (truncate . (* 255) . mag) arrSlice+ let arrGrey = computeUnboxedP $ A.map (truncate . (* 255) . mag) arrSlice let fileName = prefix P.++ (pad0 3 (show sliceNum)) P.++ ".bmp" - writeComponentsToBMP fileName- arrGrey arrGrey arrGrey+ writeImageToBMP fileName+ (U.zip3 arrGrey arrGrey arrGrey) pad0 n str = P.replicate (n - length str) '0' P.++ str
examples/Laplace/src-repa/Main.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE BangPatterns #-}- -- | 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 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 -import Data.Array.Repa.IO.ColorRamp import Data.Array.Repa.IO.Timing import System.Environment import Data.Word@@ -17,10 +17,10 @@ type Solver = Int -- ^ Number of iterations to use.- -> Array DIM2 Double -- ^ Boundary value mask.- -> Array DIM2 Double -- ^ Boundary values.- -> Array DIM2 Double -- ^ Initial state.- -> Array DIM2 Double+ -> Array U DIM2 Double -- ^ Boundary value mask.+ -> Array U DIM2 Double -- ^ Boundary values.+ -> Array U DIM2 Double -- ^ Initial state.+ -> Array U DIM2 Double solvers = [ ("get", SG.solveLaplace)@@ -73,84 +73,31 @@ laplace solve steps fileInput fileOutput = do -- Load up the file containing boundary conditions.- arrImage <- liftM (either (error . show) force)- $ readImageFromBMP fileInput- - arrImage `deepSeqArray` return ()- let arrBoundValue = force $ slurpDoublesFromImage slurpBoundValue arrImage- let arrBoundMask = force $ slurpDoublesFromImage slurpBoundMask arrImage- arrBoundValue `deepSeqArray` return ()- arrBoundMask `deepSeqArray` return ()+ arrImage <- liftM (either (error . show) id)+ $ readImageFromBMP fileInput - let arrInitial = arrBoundValue + arrBoundValue <- now $ computeP $ A.map slurpBoundValue arrImage+ arrBoundMask <- now $ computeP $ A.map slurpBoundMask arrImage+ let arrInitial = arrBoundValue - -- Run the solver.- (arrFinal, t)- <- time- $ let arrFinal = solve steps arrBoundMask arrBoundValue arrInitial- in arrFinal `deepSeqArray` return arrFinal+ -- Run the Laplace solver and print how long it took.+ (arrFinal, t) <- time $ now + $ solve steps arrBoundMask arrBoundValue arrInitial - -- Print how long it took putStr (prettyTime t) - -- Make the result image- let arrImageOut - = makeImageFromDoubles (rampColorHotToCold 0.0 1.0) arrFinal-- -- Write out the image to file. - writeImageToBMP- fileOutput- arrImageOut----slurpDoublesFromImage- :: (Word8 -> Word8 -> Word8 -> Double)- -> Array DIM3 Word8- -> Array DIM2 Double- -{-# INLINE slurpDoublesFromImage #-}-slurpDoublesFromImage mkDouble - arrBound@(Array _ [Region _ (GenManifest _)])- = arrBound `deepSeqArray` force- $ unsafeTraverse arrBound- (\(Z :. height :. width :. _) - -> Z :. height :. width)-- (\get (Z :. y :. x)- -> mkDouble- (get (Z :. y :. x :. 0))- (get (Z :. y :. x :. 1))- (get (Z :. y :. x :. 2)))---makeImageFromDoubles- :: (Double -> (Double, Double, Double))- -> Array DIM2 Double- -> Array DIM3 Word8- -{-# INLINE makeImageFromDoubles #-}-makeImageFromDoubles fnColor - arrDoubles@(Array _ [Region _ (GenManifest _)])- = arrDoubles `deepSeqArray` force- $ unsafeTraverse arrDoubles- (\(Z :. height :. width)- -> Z :. height :. width :. 4)- - (\get (Z :. y :. x :. c)- -> let (r, g, b) = fnColor (get (Z :. y :. x))- in case c of- 0 -> fromIntegral $ (truncate (r * 255) :: Int)- 1 -> fromIntegral $ (truncate (g * 255) :: Int)- 2 -> fromIntegral $ (truncate (b * 255) :: Int)- 3 -> 0)+ -- Write out the result to a file.+ arrImageOut <- now $ computeP+ $ A.map rgb8OfDouble+ $ A.map (rampColorHotToCold 0.0 1.0) arrFinal + writeImageToBMP fileOutput arrImageOut -- | Extract the boundary value from a RGB triple.-slurpBoundValue :: Word8 -> Word8 -> Word8 -> Double+slurpBoundValue :: (Word8, Word8, Word8) -> Double {-# INLINE slurpBoundValue #-}-slurpBoundValue r g b+slurpBoundValue (!r, !g, !b) -- A non-boundary value. | r == 0 && g == 0 && b == 255 = 0@@ -164,9 +111,9 @@ -- | Extract boundary mask from a RGB triple.-slurpBoundMask :: Word8 -> Word8 -> Word8 -> Double+slurpBoundMask :: (Word8, Word8, Word8) -> Double {-# INLINE slurpBoundMask #-}-slurpBoundMask r g b+slurpBoundMask (!r, !g, !b) -- A non-boundary value. | r == 0 && g == 0 && b == 255 = 1@@ -177,5 +124,4 @@ | otherwise = error $ "Unhandled pixel value in input " P.++ show (r, g, b)- - +
examples/Laplace/src-repa/SolverGet.hs view
@@ -8,10 +8,10 @@ -- | Solver for the Laplace equation. solveLaplace :: Int -- ^ Number of iterations to use.- -> Array DIM2 Double -- ^ Boundary value mask.- -> Array DIM2 Double -- ^ Boundary values.- -> Array DIM2 Double -- ^ Initial state.- -> Array DIM2 Double+ -> Array U DIM2 Double -- ^ Boundary value mask.+ -> Array U DIM2 Double -- ^ Boundary values.+ -> Array U DIM2 Double -- ^ Initial state.+ -> Array U DIM2 Double {-# NOINLINE solveLaplace #-} solveLaplace steps arrBoundMask arrBoundValue arrInit@@ -37,21 +37,19 @@ -- and 0 otherwise. -- relaxLaplace- :: Array DIM2 Double -- ^ Boundary condition mask- -> Array DIM2 Double -- ^ Boundary condition values- -> Array DIM2 Double -- ^ Initial matrix- -> Array DIM2 Double + :: Array U DIM2 Double -- ^ Boundary condition mask+ -> Array U DIM2 Double -- ^ Boundary condition values+ -> Array U DIM2 Double -- ^ Initial matrix+ -> Array U DIM2 Double {-# INLINE relaxLaplace #-}-relaxLaplace - arrBoundMask@(Array _ [Region RangeAll (GenManifest _)])- arrBoundValue@(Array _ [Region RangeAll (GenManifest _)])- arr@(Array _ [Region RangeAll (GenManifest _)])- = [arrBoundMask, arrBoundValue, arr] `deepSeqArrays` force- $ A.zipWith (+) arrBoundValue- $ A.zipWith (*) arrBoundMask- $ unsafeTraverse arr id elemFn- where+relaxLaplace arrBoundMask arrBoundValue arr+ = [arrBoundMask, arrBoundValue, arr] + `deepSeqArrays` computeP+ $ A.zipWith (+) arrBoundValue+ $ A.zipWith (*) arrBoundMask+ $ unsafeTraverse arr id elemFn+ where _ :. height :. width = extent arr
examples/Laplace/src-repa/SolverStencil.hs view
@@ -4,7 +4,7 @@ where import Data.Array.Repa as A import Data.Array.Repa.Stencil as A-import Data.Array.Repa.Algorithms.Iterate as A+import Data.Array.Repa.Stencil.Dim2 as A import qualified Data.Array.Repa.Shape as S import Language.Haskell.TH import Language.Haskell.TH.Quote@@ -12,40 +12,24 @@ -- | Solver for the Laplace equation. solveLaplace :: Int -- ^ Number of iterations to use.- -> Array DIM2 Double -- ^ Boundary value mask.- -> Array DIM2 Double -- ^ Boundary values.- -> Array DIM2 Double -- ^ Initial state.- -> Array DIM2 Double+ -> Array U DIM2 Double -- ^ Boundary value mask.+ -> Array U DIM2 Double -- ^ Boundary values.+ -> Array U DIM2 Double -- ^ Initial state.+ -> 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)- --{-# INLINE relaxLaplace #-}-relaxLaplace- :: Array DIM2 Double -- ^ Boundary value mask.- -> Array DIM2 Double -- ^ Boundary values.- -> Array DIM2 Double -- ^ Initial state.- -> Array DIM2 Double+ where go 0 !arr = arr+ go n !arr = go (n - 1) + $ relaxLaplace arrBoundMask arrBoundValue arr -relaxLaplace - arrBoundMask@(Array _ [Region RangeAll (GenManifest _)])- arrBoundValue@(Array _ [Region RangeAll (GenManifest _)])- arr@(Array _ [Region RangeAll (GenManifest _)])- = [arrBoundMask, arrBoundValue, arr] `deepSeqArrays` - let ex = extent arr- arrBoundMask' = reshape ex arrBoundMask- arrBoundValue' = reshape ex arrBoundValue- arr' = reshape ex arr- in force- $ A.zipWith (+) arrBoundValue'- $ A.zipWith (*) arrBoundMask'- $ A.map (/ 4)- $ mapStencil2 BoundClamp- [stencil2| 0 1 0- 1 0 1 - 0 1 0 |] arr'- + relaxLaplace arrBoundMask arrBoundValue arr+ = computeP+ $ A.czipWith (+) arrBoundValue+ $ A.czipWith (*) arrBoundMask+ $ A.cmap (/ 4)+ $ mapStencil2 (BoundConst 0)+ [stencil2| 0 1 0+ 1 0 1 + 0 1 0 |] arr
examples/MMult/src-repa/Main.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE PatternGuards, PackageImports #-} +import Solver import Data.Array.Repa as A import Data.Array.Repa.IO.Matrix import Data.Array.Repa.IO.Timing-import Data.Array.Repa.Algorithms.Matrix import Data.Array.Repa.Algorithms.Randomish import Data.Maybe import System.Environment@@ -11,7 +11,7 @@ import System.Random import Prelude as P --- Arg Parsing ------------------------------------------------------------------------------------+-- Arg Parsing ---------------------------------------------------------------- data Arg = ArgSolver String | ArgMatrixRandom Int Int@@ -59,7 +59,7 @@ -- | Get a matrix from a file, or generate a random one.-getMatrix :: Arg -> IO (Array DIM2 Double)+getMatrix :: Arg -> IO (Array U DIM2 Double) getMatrix arg = case arg of ArgMatrixFile fileName @@ -69,7 +69,7 @@ -> return $ randomishDoubleArray (Z :. height :. width) (-100) 100 12345 --- Main -------------------------------------------------------------------------------------------+-- Main ----------------------------------------------------------------------- main :: IO () main = do args <- liftM parseArgs $ getArgs@@ -87,16 +87,13 @@ mat1 `deepSeqArray` mat2 `deepSeqArray` return () -- Run the solver.- (matResult, t) - <- time - $ let matResult = multiplyMM mat1 mat2- in matResult `deepSeqArray` return matResult+ (matResult, t) <- time $ now $ mmultP mat1 mat2 -- Print how long it took. putStr (prettyTime t) -- Print a checksum of all the elements- putStrLn $ "checkSum = " P.++ show (A.sumAll matResult)+ putStrLn $ "checkSum = " P.++ show (A.sumAllP matResult) -- Write the output to file if requested. case mArgOut of
examples/Sobel/src-repa/Main.hs view
@@ -1,18 +1,17 @@-{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards #-}+{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards, ScopedTypeVariables #-} {-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-incomplete-patterns #-} -- | Apply Sobel operators to an image.-import Data.Word-import Control.Monad import System.Environment-import Data.Array.Repa as Repa+import Data.Array.Repa as R+import Data.Array.Repa.Algorithms.Pixel as R import Data.Array.Repa.IO.BMP import Data.Array.Repa.IO.Timing import Prelude hiding (compare)-+import Control.Monad import Solver+import Debug.Trace --- Main routine --------------------------------------------------------------- main = do args <- getArgs case args of@@ -21,65 +20,54 @@ _ -> putStrLn "Usage: sobel <iterations::Int> <fileIn.bmp> <fileOut.bmp>" + run iterations fileIn fileOut- = do inputImage <- liftM (force . either (error . show) id) + = do -- Load the source image and convert it to greyscale+ traceEventIO "******** Sobel Read Image"+ inputImage <- liftM (either (error . show) id) $ readImageFromBMP fileIn- - let greyImage = toGreyScale inputImage- greyImage `deepSeqArray` return ()++ traceEventIO "******** Sobel Luminance"+ (greyImage :: Array U DIM2 Float)+ <- now $ computeP+ $ R.map floatLuminanceOfRGB8 inputImage - (result, tElapsed)- <- time $ let (gX, gY) = loop iterations greyImage- in gX `deepSeqArray` gY `deepSeqArray` return (gX, gY)+ -- Run the filter.+ traceEventIO "******** Sobel Loop Start"+ ((gX, gY), tElapsed)+ <- time $ loop iterations greyImage + traceEventIO "******** Sobel Loop End" putStr $ prettyTime tElapsed - let (gX, gY) = result- let outImage = force2 $ Repa.zipWith magnitude gX gY -- outImage `seq` return ()+ -- Write out the magnitute of the vector gradient as the result image.+ traceEventIO "******** Sobel Magnitude"+ outImage <- now $ computeUnboxedP+ $ R.map rgb8OfGreyFloat + $ R.map (/ 3)+ $ R.zipWith magnitude gX gY - -- TODO: The image normalization in this write fn eats up most of the runtime.- writeMatrixToGreyscaleBMP fileOut outImage+ traceEventIO "******** Sobel Write Image"+ writeImageToBMP fileOut outImage -loop :: Int -> Image -> (Image, Image)-loop n - = withManifest $ \img ->+loop :: Int -> Image -> IO (Image, Image)+loop n img+ = img `deepSeqArray` if n == 0- then (img, img)+ then return (img, img) else do - let gX = gradientX img- let gY = gradientY img + traceEventIO $ "******** Sobel Loop " Prelude.++ show n+ gX <- now $ gradientX img+ gY <- now $ gradientY img if (n == 1) - then gX `deepSeqArray` gY `deepSeqArray` (gX, gY)- else gX `deepSeqArray` gY `deepSeqArray` loop (n - 1) img+ then return (gX, gY)+ else loop (n - 1) img -- | Determine the squared magnitude of a vector.-magnitude :: Float -> Float -> Double+magnitude :: Float -> Float -> Float {-# INLINE magnitude #-} magnitude x y- = fromRational $ toRational $ sqrt (x * x + y * y)----- | RGB to greyscale conversion.-toGreyScale :: Array DIM3 Word8 -> Image-{-# NOINLINE toGreyScale #-}-toGreyScale - = withManifest $ \arr ->- arr `seq` force2 $ traverse arr- (\(sh :. _) -> sh)- (\get ix -> rgbToLuminance - (get (ix :. 0))- (get (ix :. 1))- (get (ix :. 2)))-+ = sqrt (x * x + y * y) --- | Convert a RGB value to a luminance.-rgbToLuminance :: Word8 -> Word8 -> Word8 -> Float-{-# INLINE rgbToLuminance #-}-rgbToLuminance r g b - = fromIntegral r * 0.3- + fromIntegral g * 0.59- + fromIntegral b * 0.11
examples/Sobel/src-repa/Solver.hs view
@@ -6,17 +6,18 @@ , gradientX , gradientY ) where-import Data.Array.Repa as Repa-import Data.Array.Repa.Stencil+import Data.Array.Repa as R+import Data.Array.Repa.Stencil as R+import Data.Array.Repa.Stencil.Dim2 as R -type Image = Array DIM2 Float+type Image = Array U DIM2 Float gradientX :: Image -> Image {-# NOINLINE gradientX #-} gradientX img- = img `deepSeqArray` force2- $ forStencil2 BoundClamp img+ = img `deepSeqArray` computeP+ $ forStencil2 (BoundConst 0) img [stencil2| -1 0 1 -2 0 2 -1 0 1 |]@@ -25,8 +26,8 @@ gradientY :: Image -> Image {-# NOINLINE gradientY #-} gradientY img- = img `deepSeqArray` force2- $ forStencil2 BoundClamp img+ = img `deepSeqArray` computeP+ $ forStencil2 (BoundConst 0) img [stencil2| 1 2 1 0 0 0 -1 -2 -1 |]
examples/Volume/Main.hs view
@@ -2,11 +2,12 @@ {-# LANGUAGE ScopedTypeVariables #-} import Data.Word import Data.Bits-import Data.Array.Repa as R-import Data.Array.Repa.IO.Binary as R-import Data.Array.Repa.IO.BMP as R-import Data.Array.Repa.IO.ColorRamp as R-import Prelude as P+import Data.Array.Repa as R+import Data.Array.Repa.Repr.ForeignPtr as R+import Data.Array.Repa.IO.Binary as R+import Data.Array.Repa.IO.BMP as R+import Data.Array.Repa.Algorithms.ColorRamp as R+import Prelude as P import System.Environment import Control.Monad @@ -20,16 +21,18 @@ (read depth') (read height') (read width') (read sliceNum') (read low') (read high') - _ -> do- putStr $ unlines- [ "usage: volume <fileIn> <fileOut> <depth> <height> <width> <sliceNum> <lowVal> <highVal>" ]+ _ -> putStr usage +usage+ = "usage: volume <fileIn> <fileOut> <depth> <height> <width> <sliceNum> <lowVal> <highVal>"++ run :: FilePath -> FilePath -> Int -> Int -> Int -> Int -> Int -> Int -> IO () run fileIn fileOut depth width height sliceNum low high = do -- Read data from the raw file of Word16s. let arraySize = (Z :. depth :. width :. height)- (arr :: Array DIM3 Word16) + (arr :: Array F DIM3 Word16) <- R.readArrayFromStorableFile fileIn arraySize -- Ensure it's all read in before proceeding.@@ -40,7 +43,7 @@ -- | Dump a numbered slice of this array to a BMP file. dumpSlice :: FilePath -- output base name- -> Array DIM3 Word16 -- source data+ -> Array F DIM3 Word16 -- source data -> Int -- array slice number -> Int -- low value for color ramp -> Int -- high value for color ramp@@ -51,7 +54,7 @@ let arrSlice = slice arr (Any :. sliceNum :. All :. All) -- select a part of the large dynamic range- let arrBrack :: Array DIM2 Word16+ let arrBrack :: Array D DIM2 Word16 arrBrack = R.map (bracket low high . fromIntegral . flip16) arrSlice -- invert the y coordinate so the image is the correct way around@@ -63,22 +66,20 @@ R.writeArrayToStorableFile (fileBase P.++ ".w16") arrInv -- colorise and write to BMP file- let arrColor :: Array DIM2 (Double, Double, Double)+ let arrColor :: Array D DIM2 (Double, Double, Double) arrColor = R.map (\x -> if x == 0 then (0, 0, 0) else rampColorHotToCold 0 255 x) $ R.map fromIntegral arrInv - let arrColor' = R.force+ let arrColor' :: Array U DIM2 (Word8, Word8, Word8)+ arrColor' = computeP $ R.map (\(r, g, b) -> ( truncate (r * 255) , truncate (g * 255) , truncate (b * 255))) $ arrColor - R.writeComponentsToBMP (fileBase P.++ ".bmp")- (R.map (\(r, g, b) -> r) arrColor')- (R.map (\(r, g, b) -> g) arrColor')- (R.map (\(r, g, b) -> b) arrColor') + R.writeImageToBMP (fileBase P.++ ".bmp") arrColor' {-# INLINE bracket #-}
repa-examples.cabal view
@@ -1,5 +1,5 @@ Name: repa-examples-Version: 2.2.0.1+Version: 3.0.0.1 License: BSD3 License-file: LICENSE Author: The DPH Team@@ -17,138 +17,150 @@ Examples using the Repa array library. +Executable repa-canny+ Build-depends: + base == 4.5.*,+ repa == 3.0.*,+ repa-algorithms == 3.0.*,+ template-haskell >= 2.5 && < 2.8++ Main-is: examples/Canny/src-repa/Main.hs+ hs-source-dirs: examples/Canny/src-repa .+ ghc-options: + -rtsopts + -threaded + -eventlog+ -Odph -fllvm -optlo-O3+ -fno-liberate-case++ Executable repa-mmult Build-depends: - base == 4.*,- repa == 2.2.*,- repa-io == 2.2.*,- repa-algorithms == 2.2.*,+ base == 4.5.*,+ repa == 3.0.*,+ repa-io == 3.0.*,+ repa-algorithms == 3.0.*, random == 1.0.* Main-is: examples/MMult/src-repa/Main.hs hs-source-dirs: examples/MMult/src-repa . ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case- -funfolding-use-threshold30+ -funfolding-use-threshold100+ -funfolding-keeness-factor100 Executable repa-laplace Build-depends: - base == 4.*,- repa == 2.2.*,- repa-io == 2.2.*+ base == 4.5.*,+ repa == 3.0.*,+ repa-io == 3.0.* Main-is: examples/Laplace/src-repa/Main.hs other-modules: SolverGet SolverStencil hs-source-dirs: examples/Laplace/src-repa . ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case- -funfolding-use-threshold30 Executable repa-fft2d Build-depends: - base == 4.*,- repa == 2.2.*,- repa-algorithms == 2.2.*,- repa-io == 2.2.*+ base == 4.5.*,+ repa == 3.0.*,+ repa-algorithms == 3.0.*,+ repa-io == 3.0.* Main-is: examples/FFT/FFT2d/src-repa/Main.hs hs-source-dirs: examples/FFT/FFT2d/src-repa . ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case- -funfolding-use-threshold30+ -funfolding-use-threshold100+ -funfolding-keeness-factor100 Executable repa-fft2d-highpass Build-depends: - base == 4.*,- repa == 2.2.*,- repa-algorithms == 2.2.*,- repa-io == 2.2.*+ base == 4.5.*,+ repa == 3.0.*,+ repa-algorithms == 3.0.*,+ repa-io == 3.0.* Main-is: examples/FFT/HighPass2d/src-repa/Main.hs hs-source-dirs: examples/FFT/HighPass2d/src-repa . ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case- -funfolding-use-threshold30+ -funfolding-use-threshold100+ -funfolding-keeness-factor100 + Executable repa-fft3d-highpass Build-depends: - base == 4.*,- repa == 2.2.*,- repa-algorithms == 2.2.*+ base == 4.5.*,+ repa == 3.0.*,+ repa-algorithms == 3.0.* Main-is: examples/FFT/HighPass3d/src-repa/Main.hs hs-source-dirs: examples/FFT/HighPass3d/src-repa . ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case- -funfolding-use-threshold30+ -funfolding-use-threshold100+ -funfolding-keeness-factor100 Executable repa-blur Build-depends: - base == 4.*,- repa == 2.2.*,- repa-algorithms == 2.2.*,+ base == 4.5.*,+ repa == 3.0.*,+ repa-algorithms == 3.0.*, vector == 0.9.* Main-is: examples/Blur/src-repa/Main.hs hs-source-dirs: examples/Blur/src-repa . ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case- -funfolding-use-threshold30+ -funfolding-use-threshold100+ -funfolding-keeness-factor100 Executable repa-sobel Build-depends: - base == 4.*,- repa == 2.2.*,- repa-algorithms == 2.2.*,- template-haskell >= 2.5 && < 2.7+ base == 4.5.*,+ repa == 3.0.*,+ repa-algorithms == 3.0.*,+ template-haskell >= 2.5 && < 2.8 Main-is: examples/Sobel/src-repa/Main.hs other-modules: Solver hs-source-dirs: examples/Sobel/src-repa .- ghc-options: - -threaded + ghc-options: -rtsopts - -Odph -fllvm -optlo-O3- -fno-liberate-case- -funfolding-use-threshold30---Executable repa-canny- Build-depends: - base == 4.*,- repa == 2.2.*,- repa-algorithms == 2.2.*,- template-haskell >= 2.5 && < 2.7-- Main-is: examples/Canny/src-repa/Main.hs- hs-source-dirs: examples/Canny/src-repa .- ghc-options: -threaded - -rtsopts + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case -funfolding-use-threshold100@@ -157,14 +169,15 @@ Executable repa-volume Build-depends: - base == 4.*,- repa == 2.2.*,- repa-io == 2.2.*+ base == 4.5.*,+ repa == 3.0.*,+ repa-io == 3.0.* Main-is: examples/Volume/Main.hs ghc-options: - -threaded -rtsopts + -threaded + -eventlog -Odph -fllvm -optlo-O3 -fno-liberate-case -funfolding-use-threshold100