-- |
-- 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 =
  Maybe a -> Signal IO a -> Composite IO (SignalHistory IO a)
forall a.
Maybe a -> Signal IO a -> Composite IO (SignalHistory IO a)
newSignalHistoryStartingWith Maybe a
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 <- IO (Vector Double) -> Composite IO (Vector Double)
forall a. IO a -> Composite IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Vector Double)
forall a. Unboxed a => IO (Vector a)
UV.newVector
     Vector a
xs <- IO (Vector a) -> Composite IO (Vector a)
forall a. IO a -> Composite IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Vector a)
forall a. IO (Vector a)
V.newVector
     case Maybe a
init of
       Maybe a
Nothing -> () -> Composite IO ()
forall a. a -> Composite IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just a
a ->
         do Double
t <- Dynamics IO Double -> Composite IO Double
forall a. Dynamics IO a -> Composite IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
DynamicsLift t m =>
Dynamics m a -> t m a
liftDynamics Dynamics IO Double
forall (m :: * -> *). Monad m => Dynamics m Double
time
            IO () -> Composite IO ()
forall a. IO a -> Composite IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Composite IO ()) -> IO () -> Composite IO ()
forall a b. (a -> b) -> a -> b
$
              do Vector Double -> Double -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts Double
t
                 Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
     Signal IO a -> (a -> Event IO ()) -> Composite IO ()
forall (m :: * -> *) a.
MonadDES m =>
Signal m a -> (a -> Event m ()) -> Composite m ()
handleSignalComposite Signal IO a
signal ((a -> Event IO ()) -> Composite IO ())
-> (a -> Event IO ()) -> Composite IO ()
forall a b. (a -> b) -> a -> b
$ \a
a ->
       (Point IO -> IO ()) -> Event IO ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO ()) -> Event IO ())
-> (Point IO -> IO ()) -> Event IO ()
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
       IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       do Vector Double -> Double -> IO ()
forall a. Unboxed a => Vector a -> a -> IO ()
UV.appendVector Vector Double
ts (Point IO -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point IO
p)
          Vector a -> a -> IO ()
forall a. Vector a -> a -> IO ()
V.appendVector Vector a
xs a
a
     SignalHistory IO a -> Composite IO (SignalHistory IO a)
forall a. a -> Composite IO 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 =
  (Point IO -> IO (Array Int Double, Array Int a))
-> Event IO (Array Int Double, Array Int a)
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point IO -> IO (Array Int Double, Array Int a))
 -> Event IO (Array Int Double, Array Int a))
-> (Point IO -> IO (Array Int Double, Array Int a))
-> Event IO (Array Int Double, Array Int a)
forall a b. (a -> b) -> a -> b
$ \Point IO
p ->
  IO (Array Int Double, Array Int a)
-> IO (Array Int Double, Array Int a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array Int Double, Array Int a)
 -> IO (Array Int Double, Array Int a))
-> IO (Array Int Double, Array Int a)
-> IO (Array Int Double, Array Int a)
forall a b. (a -> b) -> a -> b
$
  do Array Int Double
xs <- Vector Double -> IO (Array Int Double)
forall a. Unboxed a => Vector a -> IO (Array Int a)
UV.freezeVector (SignalHistory IO a -> Vector Double
forall (m :: * -> *) a. SignalHistory m a -> Vector Double
signalHistoryTimes SignalHistory IO a
history)
     Array Int a
ys <- Vector a -> IO (Array Int a)
forall a. Vector a -> IO (Array Int a)
V.freezeVector (SignalHistory IO a -> Vector a
forall (m :: * -> *) a. SignalHistory m a -> Vector a
signalHistoryValues SignalHistory IO a
history)
     (Array Int Double, Array Int a)
-> IO (Array Int Double, Array Int a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Int Double
xs, Array Int a
ys)