Commit 45989edd authored by dterei's avatar dterei

Add Repa Sobel benchmark

parent b86775a9
{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards #-}
{-# 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.IO.BMP
import Data.Array.Repa.IO.Timing
import Prelude hiding (compare)
import Solver
-- Main routine ---------------------------------------------------------------
main
= do args <- getArgs
case args of
[iterations, fileIn, fileOut]
-> run (read iterations) fileIn fileOut
_ -> putStrLn "Usage: sobel <iterations::Int> <fileIn.bmp> <fileOut.bmp>"
run iterations fileIn fileOut
= do inputImage <- liftM (force . either (error . show) id)
$ readImageFromBMP fileIn
let greyImage = toGreyScale inputImage
greyImage `deepSeqArray` return ()
(result, _tElapsed)
<- time $ let (gX, gY) = loop iterations greyImage
in gX `deepSeqArray` gY `deepSeqArray` return (gX, gY)
-- putStr $ prettyTime tElapsed
putStrLn "Done"
let (gX, gY) = result
let outImage = force2 $ Repa.zipWith magnitude gX gY
outImage `seq` return ()
-- TODO: The image normalization in this write fn eats up most of the runtime.
writeMatrixToGreyscaleBMP fileOut outImage
loop :: Int -> Image -> (Image, Image)
loop n
= withManifest $ \img ->
if n == 0
then (img, img)
else do
let gX = gradientX img
let gY = gradientY img
if (n == 1)
then gX `deepSeqArray` gY `deepSeqArray` (gX, gY)
else gX `deepSeqArray` gY `deepSeqArray` loop (n - 1) img
-- | Determine the squared magnitude of a vector.
magnitude :: Float -> Float -> Double
{-# 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)))
-- | 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
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
SRCS = ../_RepaLib/bmp/Codec/BMP/Base.hs \
../_RepaLib/bmp/Codec/BMP/BitmapInfo.hs \
../_RepaLib/bmp/Codec/BMP/BitmapInfoV3.hs \
../_RepaLib/bmp/Codec/BMP/BitmapInfoV4.hs \
../_RepaLib/bmp/Codec/BMP/BitmapInfoV5.hs \
../_RepaLib/bmp/Codec/BMP/CIEXYZ.hs \
../_RepaLib/bmp/Codec/BMP/Compression.hs \
../_RepaLib/bmp/Codec/BMP/Error.hs \
../_RepaLib/bmp/Codec/BMP/FileHeader.hs \
../_RepaLib/bmp/Codec/BMP.hs \
../_RepaLib/bmp/Codec/BMP/Pack.hs \
../_RepaLib/bmp/Codec/BMP/Unpack.hs \
../_RepaLib/quickcheck/Test/QuickCheck/All.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Arbitrary.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Exception.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Function.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Gen.hs \
../_RepaLib/quickcheck/Test/QuickCheck.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Modifiers.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Monadic.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Poly.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Property.hs \
../_RepaLib/quickcheck/Test/QuickCheck/State.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Test.hs \
../_RepaLib/quickcheck/Test/QuickCheck/Text.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/Complex.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/Convolve.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/DFT/Center.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/DFT.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/DFT/Roots.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/FFT.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/Iterate.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/Matrix.hs \
../_RepaLib/repa-algorithms/Data/Array/Repa/Algorithms/Randomish.hs \
../_RepaLib/repa-bytestring/Data/Array/Repa/ByteString.hs \
../_RepaLib/repa/Data/Array/Repa/Arbitrary.hs \
../_RepaLib/repa/Data/Array/Repa.hs \
../_RepaLib/repa/Data/Array/Repa/Index.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/Base.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/Elt.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/EvalBlockwise.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/EvalChunked.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/EvalCursored.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/EvalReduction.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/Forcing.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/Gang.hs \
../_RepaLib/repa/Data/Array/Repa/Internals/Select.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/IndexSpace.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/Interleave.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/Mapping.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/Modify.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/Reduction.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/Select.hs \
../_RepaLib/repa/Data/Array/Repa/Operators/Traverse.hs \
../_RepaLib/repa/Data/Array/Repa/Properties.hs \
../_RepaLib/repa/Data/Array/Repa/Shape.hs \
../_RepaLib/repa/Data/Array/Repa/Slice.hs \
../_RepaLib/repa/Data/Array/Repa/Specialised/Dim2.hs \
../_RepaLib/repa/Data/Array/Repa/Stencil/Base.hs \
../_RepaLib/repa/Data/Array/Repa/Stencil.hs \
../_RepaLib/repa/Data/Array/Repa/Stencil/Template.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/Binary.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/BMP.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/ColorRamp.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/Internals/Text.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/Matrix.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/Timing.hs \
../_RepaLib/repa-io/Data/Array/Repa/IO/Vector.hs \
Solver.hs \
Main.hs
PROG_ARGS += 180 lena.bmp out.bmp
HC_OPTS += -threaded -i. -i../_RepaLib/repa -i../_RepaLib/repa-algorithms -i../_RepaLib/repa-io -i../_RepaLib/bmp -i../_RepaLib/repa-bytestring -i../_RepaLib/quickcheck -package base -package binary -package bytestring -package dph-base -package dph-prim-par -package dph-prim-seq -package extensible-exceptions -package ghc -package mtl -package old-time -package random -package vector
CLEAN_FILES += out.bmp
include $(TOP)/mk/target.mk
{-# LANGUAGE PackageImports, BangPatterns, QuasiQuotes, PatternGuards #-}
{-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-incomplete-patterns #-}
module Solver
( Image
, gradientX
, gradientY )
where
import Data.Array.Repa as Repa
import Data.Array.Repa.Stencil
type Image = Array DIM2 Float
gradientX :: Image -> Image
{-# NOINLINE gradientX #-}
gradientX img
= img `deepSeqArray` force2
$ forStencil2 BoundClamp img
[stencil2| -1 0 1
-2 0 2
-1 0 1 |]
gradientY :: Image -> Image
{-# NOINLINE gradientY #-}
gradientY img
= img `deepSeqArray` force2
$ forStencil2 BoundClamp img
[stencil2| 1 2 1
0 0 0
-1 -2 -1 |]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment