module Numeric.Signal.EEG.BDF (
BDF(..)
, loadBDFRaw
, loadBDF
) where
import qualified Data.ByteString as BS
import Data.Word
import Data.Bits
import Data.Packed.Vector
import qualified Numeric.Signal.Multichannel as M
import Control.Monad hiding(join)
import Control.Monad.State hiding(join)
type BSM a = StateT BS.ByteString IO a
getN :: Int -> BSM BS.ByteString
getN n = do
bs <- get
let (v,bs') = BS.splitAt n bs
put bs'
return v
data Date = Date { day :: Int, month :: Int, year :: Int }
deriving(Eq,Ord,Show)
data Time = Time { hour :: Int, minute :: Int, second :: Int }
deriving(Eq,Ord,Show)
data BDF = BDF {
id_ :: !Word8
, type_ :: !String
, subject :: !String
, recording :: !String
, date :: !Date
, time :: !Time
, head_bytes :: !Int
, data_version :: !String
, num_records :: !Int
, duration :: !Int
, channels :: !Int
, chan_labels :: ![String]
, tran_type :: ![String]
, dimensions :: ![String]
, phys_min :: ![Int]
, phys_max :: ![Int]
, dig_min :: ![Int]
, dig_max :: ![Int]
, prefilter :: ![String]
, samples :: ![Int]
, reserved :: ![String]
, data_ :: ![Vector Float]
} --deriving(Show)
getString :: Int -> BSM String
getString n = do
bs <- getN n
return $ (reverse . dropWhile (== ' ') . tail . reverse . tail . show) bs
getInt :: Int -> BSM Int
getInt n = do
s <- getString n
return $ read s
getDate = do
s <- getString 8
return $ strToDate' s
strToDate' :: String -> Date
strToDate' (d1:d2:'.':m1:m2:'.':y1:y2:[]) = Date (read [d1,d2]) (read [m1,m2]) (read [y1,y2])
strToDate' _ = error "strToDate"
getTime = do
s <- getString 8
return $ strToTime' s
strToTime' :: String -> Time
strToTime' (h1:h2:'.':m1:m2:'.':s1:s2:[]) = Time (read [h1,h2]) (read [m1,m2]) (read [s1,s2])
strToTime' _ = error "strToTime"
reverseBits :: Word8 -> Word8
reverseBits w = foldr (\b r -> if not $ testBit w b then setBit r (7b) else r) 0 [0..7]
get24Bit :: (Int -> Float) -> BSM Float
get24Bit f = do
b1 <- getN 1
b2 <- getN 1
b3 <- getN 1
return $ f $ (to32 b3) `shiftL` 16 .|. (to32 b2) `shiftL` 8 .|. (to32 b1)
where to32 = fromIntegral . BS.head
readRecord :: (Int -> Float) -> Int -> BSM (Vector Float)
readRecord f s = do
m <- replicateM s $ get24Bit f
return $! fromList m
readRecordBlock :: (Int -> Int -> Float) -> [(Int,Int)] -> BSM [Vector Float]
readRecordBlock f ss = mapM (\(i,s) -> readRecord (f i) s) ss
convert :: [Int] -> [Int] -> [Int] -> [Int] -> Int -> Int -> Float
convert p_min p_max d_min d_max i = \x -> (fromIntegral x) (fromIntegral (d_min !! i))*(fromIntegral ((p_max !! i) (p_min !! i)))/(fromIntegral ((d_max !! i) (d_min !! i)))
readData :: (Int -> Int -> Float) -> Int -> [(Int,Int)] -> BSM [Vector Float]
readData f rs ss = do
lift $ putStrLn $ "channels: " ++ (show $ length ss) ++ ", records: " ++ (show rs) ++ ", samples per record: " ++ (show $ snd $ head ss)
d <- mapM (\x -> do
lift $ putStrLn $ "Record: " ++ show x
readRecordBlock f ss) [1..rs]
return $! map join $! rotate_ d
where rotate_ [] = []
rotate_ xs@((_:[]):_) = [concat xs]
rotate_ ((x:xs):xss) = (x : (map head xss)) : (rotate_ (xs : (map tail xss)))
readBDF :: BSM (Maybe BDF)
readBDF = do
id_' <- getN 1
type_' <- getString 7
if (not $ BS.head id_' == 255 && type_' == "BIOSEMI")
then do
lift $ putStrLn "Error: File not BDF Format"
return Nothing
else do
subject' <- getString 80
recording' <- getString 80
date' <- getDate
time' <- getTime
head_bytes' <- getInt 8
data_version' <- getString 44
num_records' <- getInt 8
if (num_records' == 1)
then do
lift $ putStrLn "This file is probably a valid BDF file..."
lift $ putStrLn " but this program cannot grok an unspecified"
lift $ putStrLn " number of records"
lift $ putStrLn "So complain to the software author"
return Nothing
else do
duration' <- getInt 8
channels' <- getInt 4
chan_labels' <- replicateM channels' $ getString 16
tran_type' <- replicateM channels' $ getString 80
dimensions' <- replicateM channels' $ getString 8
phys_min' <- replicateM channels' $ getInt 8
phys_max' <- replicateM channels' $ getInt 8
dig_min' <- replicateM channels' $ getInt 8
dig_max' <- replicateM channels' $ getInt 8
prefilter' <- replicateM channels' $ getString 80
samples' <- replicateM channels' $ getInt 8
reserved' <- replicateM channels' $ getString 32
data_' <- readData (convert phys_min' phys_max' dig_min' dig_max') num_records' (zip [0..] samples')
return $ Just $ BDF {
id_ = BS.head id_'
, type_ = type_'
, subject = subject'
, recording = recording'
, date = date'
, time = time'
, head_bytes = head_bytes'
, data_version = data_version'
, num_records = num_records'
, duration = duration'
, channels = channels'
, chan_labels = chan_labels'
, tran_type = tran_type'
, dimensions = dimensions'
, phys_min = phys_min'
, phys_max = phys_max'
, dig_min = dig_min'
, dig_max = dig_max'
, prefilter = prefilter'
, samples = samples'
, reserved = reserved'
, data_ = data_'
}
loadBDF :: FilePath -> IO (Maybe (M.Multichannel Float))
loadBDF fn = do
bs <- BS.readFile fn
(bdf,bs') <- runStateT readBDF bs
m <- case bdf of
(Just b) -> do
return $ Just $ M.createMultichannel (head $ samples b) 24 (data_ b)
_ -> do
putStrLn "File not read"
return Nothing
when (not (BS.null bs')) $ do
putStrLn "data remaining..."
return m
loadBDFRaw :: FilePath -> IO (Maybe BDF)
loadBDFRaw fn = do
bs <- BS.readFile fn
(bdf,bs') <- runStateT readBDF bs
m <- case bdf of
Just b -> return (Just b)
_ -> do
putStrLn "File not read"
return Nothing
when (not (BS.null bs')) $ do
putStrLn "data remaining..."
return m