{-# LANGUAGE RecursiveDo #-} -- | -- Module : Simulation.Aivika.Trans.Transform -- Copyright : Copyright (c) 2009-2016, David Sorokin <david.sorokin@gmail.com> -- License : BSD3 -- Maintainer : David Sorokin <david.sorokin@gmail.com> -- Stability : experimental -- Tested with: GHC 8.0.1 -- -- The module defines something which is most close to the notion of -- analogous circuit as an opposite to the digital one. -- module Simulation.Aivika.Trans.Transform (-- * The Transform Arrow Transform(..), -- * Delaying the Transform delayTransform, -- * The Time Transform timeTransform, -- * Differential and Difference Equations integTransform, integTransformEither, sumTransform, sumTransformEither) where import qualified Control.Category as C import Control.Arrow import Control.Monad import Control.Monad.Fix import Simulation.Aivika.Trans.Simulation import Simulation.Aivika.Trans.Dynamics import qualified Simulation.Aivika.Trans.Dynamics.Memo as M import qualified Simulation.Aivika.Trans.Dynamics.Memo.Unboxed as MU import Simulation.Aivika.Trans.SystemDynamics import Simulation.Aivika.Trans.SD -- | It allows representing an analogous circuit as an opposite to -- the digital one. -- -- This is a transform of one time varying function to another usually -- specified in the integration time points and then interpolated in -- other time points with help of one of the memoization functions -- like 'memo0Dynamics'. -- newtype Transform m a b = Transform { runTransform :: Dynamics m a -> Simulation m (Dynamics m b) -- ^ Run the transform. } instance Monad m => C.Category (Transform m) where {-# INLINE id #-} id = Transform return {-# INLINE (.) #-} (Transform g) . (Transform f) = Transform $ \a -> f a >>= g instance MonadSD m => Arrow (Transform m) where {-# INLINE arr #-} arr f = Transform $ return . fmap f {-# INLINABLE first #-} first (Transform f) = Transform $ \bd -> do (b, d) <- M.unzip0Dynamics bd c <- f b return $ liftM2 (,) c d {-# INLINABLE second #-} second (Transform f) = Transform $ \db -> do (d, b) <- M.unzip0Dynamics db c <- f b return $ liftM2 (,) d c {-# INLINABLE (***) #-} (Transform f) *** (Transform g) = Transform $ \bb' -> do (b, b') <- M.unzip0Dynamics bb' c <- f b c' <- g b' return $ liftM2 (,) c c' {-# INLINABLE (&&&) #-} (Transform f) &&& (Transform g) = Transform $ \b -> do c <- f b c' <- g b return $ liftM2 (,) c c' -- instance (MonadSD m, MonadFix m) => ArrowLoop (Transform m) where -- -- {-# INLINABLE loop #-} -- loop (Transform f) = -- Transform $ \b -> -- mdo let bd = liftM2 (,) b d -- cd <- f bd -- (c, d) <- M.unzip0Dynamics cd -- return c -- | A transform that returns the current modeling time. timeTransform :: Monad m => Transform m a Double {-# INLINE timeTransform #-} timeTransform = Transform $ const $ return time -- | Return a delayed transform by the specified lag time and initial value. -- -- This is actually the 'delayI' function wrapped in the 'Transform' type. delayTransform :: MonadSD m => Dynamics m Double -- ^ the lag time -> Dynamics m a -- ^ the initial value -> Transform m a a -- ^ the delayed transform {-# INLINE delayTransform #-} delayTransform lagTime init = Transform $ \a -> delayI a lagTime init -- | Return a transform that maps the derivative to an integral -- by the specified initial value. -- -- This is actually the 'integ' function wrapped in the 'Transform' type. integTransform :: (MonadSD m, MonadFix m) => Dynamics m Double -- ^ the initial value -> Transform m Double Double -- ^ map the derivative to an integral {-# INLINE integTransform #-} integTransform init = Transform $ \diff -> integ diff init -- | Like 'integTransform' but allows either setting a new 'Left' value of the integral, -- or updating it by the specified 'Right' derivative. integTransformEither :: (MonadSD m, MonadFix m) => Dynamics m Double -- ^ the initial value -> Transform m (Either Double Double) Double -- ^ map either a new 'Left' value or the 'Right' derivative to an integral {-# INLINE integTransformEither #-} integTransformEither init = Transform $ \diff -> integEither diff init -- | Return a transform that maps the difference to a sum -- by the specified initial value. -- -- This is actually the 'diffsum' function wrapped in the 'Transform' type. sumTransform :: (MonadSD m, MonadFix m, Num a, MU.MonadMemo m a) => Dynamics m a -- ^ the initial value -> Transform m a a -- ^ map the difference to a sum {-# INLINE sumTransform #-} sumTransform init = Transform $ \diff -> diffsum diff init -- | Like 'sumTransform' but allows either setting a new 'Left' value of the sum, -- or updating it by the specified 'Right' difference. sumTransformEither :: (MonadSD m, MonadFix m, Num a, MU.MonadMemo m a) => Dynamics m a -- ^ the initial value -> Transform m (Either a a) a -- ^ map either a new 'Left' value or the 'Right' difference to a sum {-# INLINE sumTransformEither #-} sumTransformEither init = Transform $ \diff -> diffsumEither diff init