Haskell HIP повышает производительность при нарезке изображений

Question

Для рентгеновской нарезки я хотел бы создать программу, которая восстанавливает срезы и выполняет обратное преобразование радона.Первым шагом является создание синограмм изображений.Но создание одной синограммы занимает очень много времени.

У меня 1500 изображений, каждое размером 3,5 МБ в формате PNG.В распакованном виде они требуют около 10 ГБ на оперативной памяти, что мне подходит.

Чтобы создать одну синограмму, нужно выровнять один и тот же ряд всех изображений.Я использую HIP и Storable Векторы для этой задачи.Обработка всех изображений занимает около 1 минуты, и я хотел бы знать, как ускорить этот процесс.

Мой код здесь:

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

Я уже профилировал его с опцией + RTS -s, и время сбора мусора в порядке.Как я могу ускорить это?

Для того, чтобы установить стек HIP, необходимо выполнить следующие действия:

resolver: lts-9.20

extra-deps: [
repa-3.4.1.4,
]