Add Repa Sobel benchmark

fibon/Repa/Sobel/Main.hs

+{-# 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

fibon/Repa/Sobel/Makefile

+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
+

fibon/Repa/Sobel/Sobel.stdout

+Done

fibon/Repa/Sobel/Solver.hs

+{-# 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 |] 
+
+
+