X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMRI.hs;h=5cca1aed9ffcd2ab9250cd5883326fd45a59f087;hb=1ea61681483c8402faf572c8c853ba086b622ffe;hp=cb89af91d145c8c25c130a73b9814c9a6bfde869;hpb=b19b7a5fefbb3180a817b4aadc21f25675cb366f;p=spline3.git diff --git a/src/MRI.hs b/src/MRI.hs index cb89af9..5cca1ae 100644 --- a/src/MRI.hs +++ b/src/MRI.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE FlexibleContexts #-} +-- | The MRI module contains functionsd and definitions relevant (and +-- specific) to the MRI data files found at, +-- +-- +-- module MRI ( flip_x, flip_y, @@ -14,10 +20,13 @@ where 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.ColorRamp as R -import Data.Array.Repa.IO.BMP as R (writeComponentsToBMP) +import Data.Array.Repa as R +import Data.Array.Repa.Eval as R (now) +import Data.Array.Repa.Repr.Unboxed as R +import Data.Array.Repa.IO.Binary as R +import Data.Array.Repa.Algorithms.ColorRamp as R +import Data.Array.Repa.Operators.Traversal as R (unsafeTraverse) +import Data.Array.Repa.IO.BMP as R (writeImageToBMP) import Values @@ -42,18 +51,24 @@ mri_upper_threshold = 2500 mri_slice3d :: DIM3 mri_slice3d = (Z :. 1 :. mri_height :. mri_width) -type RawData sh = Array sh Word16 +-- | RawData is an array of words (16 bits), as contained in the MRI +-- data files. +type RawData sh = Array U sh Word16 + +-- | A specialization of the 'RawData' type, to three dimensions. type RawData3D = RawData DIM3 type RGB = (Word8, Word8, Word8) -type ColorData sh = Array sh RGB +type ColorData sh = Array U sh RGB +{-# INLINE read_word16s #-} read_word16s :: FilePath -> IO RawData3D read_word16s path = do arr <- R.readArrayFromStorableFile path mri_shape - arr `deepSeqArray` return () - return arr + c <- R.copyP arr + now $ c + bracket :: Double -> Word16 @@ -72,40 +87,50 @@ flip16 xx = shift xx 8 .|. (shift xx (-8) .&. 0x00ff) -swap_bytes :: (Shape sh) => (RawData sh) -> (RawData sh) -swap_bytes arr = - R.force $ R.map flip16 arr +{-# INLINE swap_bytes #-} +swap_bytes :: (Shape sh, Source r Word16) => Array r sh Word16 + -> Array D sh Word16 +swap_bytes = + R.map flip16 -bracket_array :: (Shape sh) => (Values sh) -> (RawData sh) -bracket_array arr = - R.force $ R.map bracket arr +bracket_array :: Shape sh => Values sh -> Array D sh Word16 +bracket_array = + R.map bracket -round_array :: (Shape sh) => (Values sh) -> (RawData sh) -round_array arr = - R.force $ R.map round arr +{-# INLINE round_array #-} +round_array :: Shape sh => Values sh -> Array D sh Word16 +round_array = + R.map round -flip_y :: RawData3D -> RawData3D +flip_y :: Source r Word16 => Array r DIM3 Word16 -> Array D DIM3 Word16 flip_y arr = - R.force $ R.traverse arr id + R.unsafeTraverse arr id (\get (Z :. z :. y :. x) -> get (Z :. z :. (mri_height - 1) - y :. x)) -flip_x :: RawData3D -> RawData3D +flip_x :: Source r Word16 => Array r DIM3 Word16 -> Array D DIM3 Word16 flip_x arr = - R.force $ R.traverse arr id + R.unsafeTraverse arr id (\get (Z :. z :. y :. x) -> get (Z :. z :. y :. (mri_width - 1) - x)) + +{-# INLINE write_word16s #-} write_word16s :: (Shape sh) => FilePath -> (RawData sh) -> IO () write_word16s = R.writeArrayToStorableFile -values_to_colors :: (Shape sh) => (Values sh) -> (ColorData sh) + +-- +-- Instead of IO, we could get away with a generic monad 'm' +-- here. However, /we/ only call this function from within IO. +-- +values_to_colors :: (Shape sh) => (Values sh) -> IO (ColorData sh) values_to_colors arr = - R.force $ R.map (truncate_rgb . ramp_it) arr + R.computeUnboxedP $ R.map (truncate_rgb . ramp_it) arr where ramp_it :: Double -> (Double, Double, Double) ramp_it x = @@ -123,19 +148,15 @@ values_to_colors arr = b' = truncate (b * 255) - -z_slice :: Elt a => Int -> Array DIM3 a -> Array DIM2 a +z_slice :: (R.Unbox a, Source r a) => Int -> Array r DIM3 a -> Array D DIM2 a z_slice n arr = slice arr (Any :. n :. All :. All) - write_values_slice_to_bitmap :: Values2D -> FilePath -> IO () -write_values_slice_to_bitmap v3d path = - R.writeComponentsToBMP path routput goutput boutput +write_values_slice_to_bitmap v3d path = do + values <- R.computeUnboxedP $ R.map fromIntegral arr_bracketed + colors <- values_to_colors $ values + R.writeImageToBMP path colors where arr_bracketed = bracket_array v3d - colors = values_to_colors $ R.map fromIntegral arr_bracketed - routput = R.map (\(red, _, _) -> red) colors - goutput = R.map (\(_, green, _) -> green) colors - boutput = R.map (\(_, _, blue) -> blue) colors