Multichannel.hs

{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Signal.Multichannel
-- Copyright   :  (c) Alexander Vivian Hugh McPhail 2010
-- License     :  GPL-style
--
-- Maintainer  :  haskell.vivian.mcphail <at> gmail <dot> com
-- Stability   :  provisional
-- Portability :  uses Concurrency
--
-- Signal processing functions, multichannel datatype
--
-- link with '-threaded' and run with +RTS Nn, where n is the number of CPUs
--
-----------------------------------------------------------------------------

module Numeric.Signal.Multichannel (
                       Multichannel,readMultichannel,writeMultichannel,
                       fromList,
                       sampling_rate,precision,channels,
                       getChannel,getChannels,
                       mapConcurrently
                ) where

-----------------------------------------------------------------------------

--import qualified Numeric.Signal as S

--import Complex

import qualified Data.Array.IArray as I

import Control.Concurrent
--import Control.Concurrent.MVar

import System.IO.Unsafe(unsafePerformIO)

--import qualified Data.List as L

import Data.Packed.Vector hiding(fromList)
--import Data.Packed(Container(..))

import Data.Binary

import Foreign.Storable
--import Numeric.GSL.Vector

--import Numeric.LinearAlgebra.Algorithms

--import qualified Numeric.GSL.Fourier as F

--import Prelude hiding(filter)

-----------------------------------------------------------------------------

-- | data type with multiple channels
data Multichannel a = MC {
                          _sampling_rate :: Int -- ^ sampling rate
                          , _precision   :: Int -- ^ bits of precision
                          , _channels    :: Int -- ^ number of channels
                          , _length      :: Int -- ^ length in samples
                          , _data        :: I.Array Int (Vector a) -- ^ data
                         }

-----------------------------------------------------------------------------

instance Binary (Multichannel Double) where
    put (MC s p c l d) = do
                         put s
                         put p
                         put c
                         put l
                         put d
    get = do
          s <- get
          p <- get
          c <- get
          l <- get
          d <- get
          return (MC s p c l d)

-----------------------------------------------------------------------------

readMultichannel :: FilePath -> IO (Multichannel Double)
readMultichannel = decodeFile

writeMultichannel :: FilePath -> Multichannel Double -> IO ()
writeMultichannel = encodeFile

-----------------------------------------------------------------------------

-- | create a multichannel data type
fromList :: Storable a =>
            Int             -- ^ sampling rate
         -> Int             -- ^ bits of precision
         -> [Vector a]      -- ^ data
         -> Multichannel a  -- ^ datatype
fromList s p d = let c = length d
                 in MC s p c (dim $ head d) (I.listArray (1,c) d)

-- | the sampling rate
sampling_rate :: Multichannel a -> Int
sampling_rate = _sampling_rate

-- | the bits of precision
precision :: Multichannel a -> Int
precision = _precision

-- | the number of channels
channels :: Multichannel a -> Int
channels = _channels

-- | the length, in samples
samples :: Multichannel a -> Int
samples = _length

-- | extract one channel
getChannel :: Int -> Multichannel a -> Vector a
getChannel c d = (_data d) I.! c

-- | extract all channels
getChannels :: Multichannel a -> [Vector a]
getChannels d = I.elems $ _data d

-----------------------------------------------------------------------------

-- | map a function executed concurrently
mapConcurrently :: Storable b => 
                   Multichannel a                -- ^ input data
                -> (Vector a -> Vector b)        -- ^ the function to be mapped
                -> Multichannel b                -- ^ output data
mapConcurrently (MC sr p c _ d) f = unsafePerformIO $ do
                                    results <- newMVar []
                                    mapM_ (forkIO . applyFunction results f) $ I.assocs d
                                    vectors <- takeMVar results
                                    return $ MC sr p c (dim $ snd $ head vectors) (I.array (1,c) vectors)
    where applyFunction results f' (i,e) = do
                                          let o = f' e
                                          modifyMVar_ results (\x -> return ((i,o):x))
                                    
-----------------------------------------------------------------------------