Add Repa Volume bechmark.
authorDavid Terei <davidterei@gmail.com>
Mon, 16 Jan 2012 10:44:46 +0000 (02:44 -0800)
committerDavid Terei <davidterei@gmail.com>
Mon, 16 Jan 2012 10:44:46 +0000 (02:44 -0800)
fibon/Repa/Volume/Main.hs [new file with mode: 0644]
fibon/Repa/Volume/Makefile [new file with mode: 0644]
fibon/Repa/Volume/lena.bmp [new file with mode: 0644]

diff --git a/fibon/Repa/Volume/Main.hs b/fibon/Repa/Volume/Main.hs
new file mode 100644 (file)
index 0000000..5b2083b
--- /dev/null
@@ -0,0 +1,97 @@
+
+{-# 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 System.Environment
+import Control.Monad
+
+-- | Cuts slices out of a volume cube of Word16 data.
+main :: IO ()
+main 
+ = do   args <- getArgs
+        case args of
+         [fileIn, fileOut, depth', height', width', sliceNum', low', high']
+          ->    run fileIn fileOut
+                        (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>" ]
+
+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) 
+         <- R.readArrayFromStorableFile fileIn arraySize
+
+        -- Ensure it's all read in before proceeding.
+        arr `deepSeqArray` return ()
+        dumpSlice fileOut arr sliceNum low high 
+
+
+-- | Dump a numbered slice of this array to a BMP file.
+dumpSlice 
+       :: FilePath             -- output base name
+       -> Array DIM3 Word16    -- source data
+       -> Int                  -- array slice number
+       -> Int                  -- low value for color ramp
+       -> Int                  -- high value for color ramp
+       -> IO ()
+
+dumpSlice fileBase arr sliceNum low high
+ = do  -- slice out the part that we want from the cube 
+        let arrSlice   = slice arr (Any :. sliceNum :. All :. All)
+
+        -- select a part of the large dynamic range
+       let arrBrack    :: Array DIM2 Word16
+           arrBrack    = R.map (bracket low high . fromIntegral . flip16) arrSlice
+
+        -- invert the y coordinate so the image is the correct way around
+        let (Z :. height :. _) = R.extent arrSlice
+        let arrInv      = R.traverse arrBrack id 
+                                (\get (Z :. y :. x) -> get (Z :. (height - 1) - y :. x))
+
+        -- dump the slice back as word16
+       R.writeArrayToStorableFile (fileBase P.++ ".w16") arrInv
+
+        -- colorise and write to BMP file
+        let arrColor :: Array 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
+                        $ 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') 
+
+
+{-# INLINE bracket #-}
+bracket low high x
+        | x < low      = 0
+        | x > high     = 255
+        | otherwise    
+        = let  r       = fromIntegral (x - low) / fromIntegral (high - low)
+          in   truncate (r * 255)
+
+
+{-# INLINE flip16 #-}
+flip16 :: Word16 -> Word16
+flip16 xx
+        = shift xx 8 .|. (shift xx (-8) .&. 0x00ff)
+
diff --git a/fibon/Repa/Volume/Makefile b/fibon/Repa/Volume/Makefile
new file mode 100644 (file)
index 0000000..dedac92
--- /dev/null
@@ -0,0 +1,76 @@
+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 \
+       Main.hs
+PROG_ARGS += lena.bmp out 500 500 500 1 1 500
+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 out.w16
+include $(TOP)/mk/target.mk
+
diff --git a/fibon/Repa/Volume/lena.bmp b/fibon/Repa/Volume/lena.bmp
new file mode 100644 (file)
index 0000000..53d59e9
Binary files /dev/null and b/fibon/Repa/Volume/lena.bmp differ