src/MRI.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 -- | The MRI module contains functionsd and definitions relevant (and
   3 --   specific) to the MRI data files found at,
   4 --
   5 --   <http://graphics.stanford.edu/data/voldata/>
   6 --
   7 module MRI (
   8   flip_x,
   9   flip_y,
  10   read_word16s,
  11   round_array,
  12   swap_bytes,
  13   write_values_slice_to_bitmap,
  14   write_word16s,
  15   z_slice
  16   )
  17 where
  18
  19 import Data.Word
  20 import Data.Bits
  21 import Data.Array.Repa                          as R
  22 import Data.Array.Repa.Eval                     as R (now)
  23 import Data.Array.Repa.Repr.Unboxed             as R
  24 import Data.Array.Repa.IO.Binary                as R
  25 import Data.Array.Repa.Algorithms.ColorRamp     as R
  26 import Data.Array.Repa.Operators.Traversal      as R (unsafeTraverse)
  27 import Data.Array.Repa.IO.BMP                   as R (writeImageToBMP)
  28
  29 import Values
  30
  31 mri_lower_threshold :: Double
  32 mri_lower_threshold = 1400
  33
  34 mri_upper_threshold :: Double
  35 mri_upper_threshold = 2500
  36
  37 -- | RawData is an array of words (16 bits), as contained in the MRI
  38 --   data files.
  39 type RawData sh = Array U sh Word16
  40
  41 -- | A specialization of the 'RawData' type, to three dimensions.
  42 type RawData3D = RawData DIM3
  43
  44 type RGB = (Word8, Word8, Word8)
  45 type ColorData sh = Array U sh RGB
  46
  47
  48 {-# INLINE read_word16s #-}
  49 read_word16s :: FilePath -> DIM3 -> IO RawData3D
  50 read_word16s path mri_shape = do
  51   arr <- R.readArrayFromStorableFile path mri_shape
  52   c   <- R.copyP arr
  53   now $ c
  54
  55
  56
  57 bracket :: Double -> Word16
  58 bracket x
  59         | x < mri_lower_threshold      = 0
  60         | x > mri_upper_threshold      = 255
  61         | otherwise                    = truncate (r * 255)
  62             where
  63               numerator = x - mri_lower_threshold
  64               denominator = mri_upper_threshold - mri_lower_threshold
  65               r = numerator/denominator
  66
  67
  68 flip16 :: Word16 -> Word16
  69 flip16 xx =
  70   shift xx 8 .|. (shift xx (-8) .&. 0x00ff)
  71
  72
  73 {-# INLINE swap_bytes #-}
  74 swap_bytes :: (Shape sh, Source r Word16) => Array r sh Word16
  75              -> Array D sh Word16
  76 swap_bytes =
  77   R.map flip16
  78
  79
  80 bracket_array :: Shape sh => Values sh -> Array D sh Word16
  81 bracket_array =
  82   R.map bracket
  83
  84
  85 {-# INLINE round_array #-}
  86 round_array :: Shape sh => Values sh -> Array D sh Word16
  87 round_array =
  88   R.map round
  89
  90
  91 flip_y :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16
  92 flip_y height arr =
  93   R.unsafeTraverse arr id
  94               (\get (Z :. z :. y :. x) ->
  95                    get (Z :. z :. (height - 1) - y :. x))
  96
  97 flip_x :: Source r Word16 => Int -> Array r DIM3 Word16 -> Array D DIM3 Word16
  98 flip_x width arr =
  99   R.unsafeTraverse arr id
 100               (\get (Z :. z :. y :. x) ->
 101                    get (Z :. z :. y :. (width - 1) - x))
 102
 103
 104 {-# INLINE write_word16s #-}
 105 write_word16s :: (Shape sh) => FilePath -> (RawData sh) -> IO ()
 106 write_word16s = R.writeArrayToStorableFile
 107
 108
 109
 110 --
 111 -- Instead of IO, we could get away with a generic monad 'm'
 112 -- here. However, /we/ only call this function from within IO.
 113 --
 114 values_to_colors :: (Shape sh) => (Values sh) -> IO (ColorData sh)
 115 values_to_colors arr =
 116   R.computeUnboxedP $ R.map (truncate_rgb . ramp_it) arr
 117   where
 118     ramp_it :: Double -> (Double, Double, Double)
 119     ramp_it x =
 120       if x == 0 then
 121         (0, 0, 0)
 122       else
 123         rampColorHotToCold 0 255 x
 124
 125     truncate_rgb :: (Double, Double, Double) -> (Word8, Word8, Word8)
 126     truncate_rgb (r, g, b) =
 127       (r', g', b')
 128       where
 129         r' = truncate (r * 255)
 130         g' = truncate (g * 255)
 131         b' = truncate (b * 255)
 132
 133
 134 z_slice :: (R.Unbox a, Source r a) => Int -> Array r DIM3 a -> Array D DIM2 a
 135 z_slice n arr =
 136   slice arr (Any :. n :. All :. All)
 137
 138
 139 write_values_slice_to_bitmap :: Values2D -> FilePath -> IO ()
 140 write_values_slice_to_bitmap v3d path = do
 141   values <- R.computeUnboxedP $ R.map fromIntegral arr_bracketed
 142   colors <- values_to_colors $ values
 143   R.writeImageToBMP path colors
 144   where
 145     arr_bracketed = bracket_array v3d