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