diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/examples/Blur/src-repa/Main.hs b/examples/Blur/src-repa/Main.hs --- a/examples/Blur/src-repa/Main.hs +++ b/examples/Blur/src-repa/Main.hs @@ -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 " ] - + + +-- | 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] --} - diff --git a/examples/Canny/src-repa/Main.hs b/examples/Canny/src-repa/Main.hs --- a/examples/Canny/src-repa/Main.hs +++ b/examples/Canny/src-repa/Main.hs @@ -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 [ ] " + _ -> putStrLn + $ concat [ "repa-canny [ ]" + , " " ] 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. diff --git a/examples/FFT/FFT2d/src-repa/Main.hs b/examples/FFT/FFT2d/src-repa/Main.hs --- a/examples/FFT/FFT2d/src-repa/Main.hs +++ b/examples/FFT/FFT2d/src-repa/Main.hs @@ -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 + + diff --git a/examples/FFT/HighPass2d/src-repa/Main.hs b/examples/FFT/HighPass2d/src-repa/Main.hs --- a/examples/FFT/HighPass2d/src-repa/Main.hs +++ b/examples/FFT/HighPass2d/src-repa/Main.hs @@ -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 diff --git a/examples/FFT/HighPass3d/src-repa/Main.hs b/examples/FFT/HighPass3d/src-repa/Main.hs --- a/examples/FFT/HighPass3d/src-repa/Main.hs +++ b/examples/FFT/HighPass3d/src-repa/Main.hs @@ -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 diff --git a/examples/Laplace/src-repa/Main.hs b/examples/Laplace/src-repa/Main.hs --- a/examples/Laplace/src-repa/Main.hs +++ b/examples/Laplace/src-repa/Main.hs @@ -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) - - + diff --git a/examples/Laplace/src-repa/SolverGet.hs b/examples/Laplace/src-repa/SolverGet.hs --- a/examples/Laplace/src-repa/SolverGet.hs +++ b/examples/Laplace/src-repa/SolverGet.hs @@ -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 diff --git a/examples/Laplace/src-repa/SolverStencil.hs b/examples/Laplace/src-repa/SolverStencil.hs --- a/examples/Laplace/src-repa/SolverStencil.hs +++ b/examples/Laplace/src-repa/SolverStencil.hs @@ -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 diff --git a/examples/MMult/src-repa/Main.hs b/examples/MMult/src-repa/Main.hs --- a/examples/MMult/src-repa/Main.hs +++ b/examples/MMult/src-repa/Main.hs @@ -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 diff --git a/examples/Sobel/src-repa/Main.hs b/examples/Sobel/src-repa/Main.hs --- a/examples/Sobel/src-repa/Main.hs +++ b/examples/Sobel/src-repa/Main.hs @@ -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 " + 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 diff --git a/examples/Sobel/src-repa/Solver.hs b/examples/Sobel/src-repa/Solver.hs --- a/examples/Sobel/src-repa/Solver.hs +++ b/examples/Sobel/src-repa/Solver.hs @@ -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 |] diff --git a/examples/Volume/Main.hs b/examples/Volume/Main.hs --- a/examples/Volume/Main.hs +++ b/examples/Volume/Main.hs @@ -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 " ] + _ -> putStr usage +usage + = "usage: volume " + + 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 #-} diff --git a/repa-examples.cabal b/repa-examples.cabal --- a/repa-examples.cabal +++ b/repa-examples.cabal @@ -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