Haskell HIP improve Performance when slicing Images

65 views Asked by At

For X-Ray Slicing I would like to create a program that reconstructs slices and performs the inverse radon transform. The first step is to create sinograms of the images. But it takes very long to create one sinogram.

I have 1500 Images, each having 3.5MB in the PNG format. Unpacked, they require abuot 10 GB on ram, which is fine for me.

In order to create one sinogram, one has to align the same row of all the images. I am using HIP and Storable Vectors for this task. It takes about 1 Minute to process all the images, and i would like to know, how to speed up this process.

My code is here:

{-# LANGUAGE TypeFamilies,
  BangPatterns #-}
import System.Directory
import qualified Control.Monad as CM(mapM_, mapM)
import Graphics.Image.IO
import Graphics.Image.ColorSpace
import Graphics.Image.IO.Formats
import Graphics.Image.Interface as GII
import Graphics.Image.Interface.Vector
import Data.Vector.Storable as DVS
import Data.List as DL

type PngFormat = Image VS Y Word16

printList :: Show a => [a] -> IO()
printList list = CM.mapM_ print list

mdisplayImage :: PngFormat -> IO()
mdisplayImage = displayImageUsing eogViewer True

prepend prep app = prep DL.++ app

rowOfImage :: Int -> PngFormat -> DVS.Vector (Pixel Y Word16)
rowOfImage row image =
  slice start cols $ toVector image
  where
    rows = fst $ dims image
    cols = snd $ dims image
    start = row * cols

main :: IO()
main = do
  -- This line fetches the filenames, filtering ("..", and "." as directories)
  files <- fmap ((fmap (prepend "raw_data/")) . (DL.take numImages) . (DL.drop 2) . sort) (getDirectoryContents "raw_data/")
  images <- CM.mapM (readImageExact' PNG) files :: IO([Image VS Y Word16])
  mdisplayImage $ fromVector (numImages, (snd $ dims (DL.head images)))$ DVS.concat $ DL.map (rowOfImage 500) images
  where
    numImages = 1500

I already profiled it with the +RTS -s option, and the time spent garbage collecting is fine. How could i speed this up ?

In Order to install HIP stack, requires following deps

resolver: lts-9.20

extra-deps: [
repa-3.4.1.4,
]
0

There are 0 answers