-- |
-- Module     : Simulation.Aivika.IO.Signal
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- This module allows collecting the signal history in a more
-- optimal way than it suggests the general implementation.
--

module Simulation.Aivika.IO.Signal
       (-- * Signal History
        SignalHistory,
        signalHistorySignal,
        newSignalHistory,
        newSignalHistoryStartingWith,
        readSignalHistory) where

import Data.Monoid
import Data.List
import Data.Array
import Data.Array.MArray.Safe

import Control.Monad
import Control.Monad.Trans

import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Composite
import Simulation.Aivika.Trans.Signal hiding (SignalHistory,
                                              signalHistorySignal,
                                              newSignalHistory,
                                              newSignalHistoryStartingWith,
                                              readSignalHistory)

import Simulation.Aivika.IO.DES

import qualified Simulation.Aivika.Vector as V
import qualified Simulation.Aivika.Vector.Unboxed as UV
                                    
-- | Represents the history of the signal values.
data SignalHistory m a =
  SignalHistory { forall (m :: * -> *) a. SignalHistory m a -> Signal m a
signalHistorySignal :: Signal m a,  
                  -- ^ The signal for which the history is created.
                  forall (m :: * -> *) a. SignalHistory m a -> Vector Double
signalHistoryTimes  :: UV.Vector Double,
                  forall (m :: * -> *) a. SignalHistory m a -> Vector a
signalHistoryValues :: V.Vector a }

-- | Create a history of the signal values.
newSignalHistory :: Signal IO a -> Composite IO (SignalHistory IO a)
{-# INLINABLE newSignalHistory #-}
newSignalHistory :: forall a. Signal IO a -> Composite IO (SignalHistory IO a)
newSignalHistory =
  forall a.
Maybe a -> Signal IO a -> Composite IO (SignalHistory IO a)
newSignalHistoryStartingWith forall a. Maybe a
Nothing

-- | Create a history of the signal values starting with
-- the optional initial value.
newSignalHistoryStartingWith :: Maybe a -> Signal IO a -> Composite IO (SignalHistory IO a)
{-# INLINABLE newSignalHistoryStartingWith #-}
newSignalHistoryStartingWith :: forall a.
Maybe a -> Signal IO a -> Composite IO (SignalHistory IO a)
newSignalHistoryStartingWith Maybe a
init Signal IO a
signal =
  do Vector Double
ts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector a
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (Vector a)
V.newVector
     case Maybe a
init of
       Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a ->
         do Double
t <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics forall (m :: * -> *). Monad m => Dynamics m Double
time
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
              do forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts Double
t
                 forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
     forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Composite m ()
handleSignalComposite Signal IO a
signal forall a b. (a -> b) -> a -> b
$ \a
a ->
       forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
       do forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts (forall (m :: * -> *). Point m -> Double
pointTime Point IO
p)
          forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
     forall (m :: * -> *) a. Monad m => a -> m a
return SignalHistory { signalHistorySignal :: Signal IO a
signalHistorySignal = Signal IO a
signal,
                            signalHistoryTimes :: Vector Double
signalHistoryTimes  = Vector Double
ts,
                            signalHistoryValues :: Vector a
signalHistoryValues = Vector a
xs }
       
-- | Read the history of signal values.
readSignalHistory :: SignalHistory IO a -> Event IO (Array Int Double, Array Int a)
-- readSignalHistory :: (MonadDES m, MonadIO m, MonadTemplate m)
--                      => SignalHistory m a -> Event m (Array Int Double, Array Int a)
{-# INLINABLE readSignalHistory #-}
readSignalHistory :: forall a.
SignalHistory IO a -> Event IO (Array Int Double, Array Int a)
readSignalHistory SignalHistory IO a
history =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  do Array Int Double
xs <- forall a. Unboxed a => Vector a -> IO (Array Int a)
UV.freezeVector (forall (m :: * -> *) a. SignalHistory m a -> Vector Double
signalHistoryTimes SignalHistory IO a
history)
     Array Int a
ys <- forall a. Vector a -> IO (Array Int a)
V.freezeVector (forall (m :: * -> *) a. SignalHistory m a -> Vector a
signalHistoryValues SignalHistory IO a
history)
     forall (m :: * -> *) a. Monad m => a -> m a
return (Array Int Double
xs, Array Int a
ys)