-- |
-- Module     : Simulation.Aivika.Trans.Agent
-- 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 introduces basic entities for the agent-based modeling.
--
module Simulation.Aivika.Trans.Agent
       (Agent,
        AgentState,
        newAgent,
        newState,
        newSubstate,
        selectedState,
        selectedStateChanged,
        selectedStateChanged_,
        selectState,
        stateAgent,
        stateParent,
        addTimeout,
        addTimer,
        setStateActivation,
        setStateDeactivation,
        setStateTransition) where

import Control.Monad

import Simulation.Aivika.Trans.Ref.Base
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Signal

--
-- Agent-based Modeling
--

-- | Represents an agent.
data Agent m = Agent { forall (m :: * -> *). Agent m -> Ref m AgentMode
agentModeRef            :: Ref m AgentMode,
                       forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef           :: Ref m (Maybe (AgentState m)), 
                       forall (m :: * -> *).
Agent m -> SignalSource m (Maybe (AgentState m))
agentStateChangedSource :: SignalSource m (Maybe (AgentState m)) }

-- | Represents the agent state.
data AgentState m = AgentState { forall (m :: * -> *). AgentState m -> Agent m
stateAgent         :: Agent m,
                                 -- ^ Return the corresponded agent.
                                 forall (m :: * -> *). AgentState m -> Maybe (AgentState m)
stateParent        :: Maybe (AgentState m),
                                 -- ^ Return the parent state or 'Nothing'.
                                 forall (m :: * -> *). AgentState m -> Ref m (Event m ())
stateActivateRef   :: Ref m (Event m ()),
                                 forall (m :: * -> *). AgentState m -> Ref m (Event m ())
stateDeactivateRef :: Ref m (Event m ()),
                                 forall (m :: * -> *).
AgentState m -> Ref m (Event m (Maybe (AgentState m)))
stateTransitRef    :: Ref m (Event m (Maybe (AgentState m))),
                                 forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef    :: Ref m Int }
                  
data AgentMode = CreationMode
               | TransientMode
               | ProcessingMode
                      
instance MonadDES m => Eq (Agent m) where

  {-# INLINE (==) #-}
  Agent m
x == :: Agent m -> Agent m -> Bool
== Agent m
y = Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
x Ref m (Maybe (AgentState m))
-> Ref m (Maybe (AgentState m)) -> Bool
forall a. Eq a => a -> a -> Bool
== Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
y
  
instance MonadDES m => Eq (AgentState m) where

  {-# INLINE (==) #-}
  AgentState m
x == :: AgentState m -> AgentState m -> Bool
== AgentState m
y = AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
x Ref m Int -> Ref m Int -> Bool
forall a. Eq a => a -> a -> Bool
== AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
y

fullPath :: AgentState m -> [AgentState m] -> [AgentState m]
fullPath :: forall (m :: * -> *).
AgentState m -> [AgentState m] -> [AgentState m]
fullPath AgentState m
st [AgentState m]
acc =
  case AgentState m -> Maybe (AgentState m)
forall (m :: * -> *). AgentState m -> Maybe (AgentState m)
stateParent AgentState m
st of
    Maybe (AgentState m)
Nothing  -> AgentState m
st AgentState m -> [AgentState m] -> [AgentState m]
forall a. a -> [a] -> [a]
: [AgentState m]
acc
    Just AgentState m
st' -> AgentState m -> [AgentState m] -> [AgentState m]
forall (m :: * -> *).
AgentState m -> [AgentState m] -> [AgentState m]
fullPath AgentState m
st' (AgentState m
st AgentState m -> [AgentState m] -> [AgentState m]
forall a. a -> [a] -> [a]
: [AgentState m]
acc)

partitionPath :: MonadDES m => [AgentState m] -> [AgentState m] -> ([AgentState m], [AgentState m])
{-# INLINABLE partitionPath #-}
partitionPath :: forall (m :: * -> *).
MonadDES m =>
[AgentState m]
-> [AgentState m] -> ([AgentState m], [AgentState m])
partitionPath [AgentState m]
path1 [AgentState m]
path2 =
  case ([AgentState m]
path1, [AgentState m]
path2) of
    (AgentState m
h1 : [AgentState m]
t1, [AgentState m
h2]) | AgentState m
h1 AgentState m -> AgentState m -> Bool
forall a. Eq a => a -> a -> Bool
== AgentState m
h2 -> 
      ([AgentState m] -> [AgentState m]
forall a. [a] -> [a]
reverse [AgentState m]
path1, [AgentState m]
path2)
    (AgentState m
h1 : [AgentState m]
t1, AgentState m
h2 : [AgentState m]
t2) | AgentState m
h1 AgentState m -> AgentState m -> Bool
forall a. Eq a => a -> a -> Bool
== AgentState m
h2 -> 
      [AgentState m]
-> [AgentState m] -> ([AgentState m], [AgentState m])
forall (m :: * -> *).
MonadDES m =>
[AgentState m]
-> [AgentState m] -> ([AgentState m], [AgentState m])
partitionPath [AgentState m]
t1 [AgentState m]
t2
    ([AgentState m], [AgentState m])
_ ->
      ([AgentState m] -> [AgentState m]
forall a. [a] -> [a]
reverse [AgentState m]
path1, [AgentState m]
path2)

findPath :: MonadDES m => Maybe (AgentState m) -> AgentState m -> ([AgentState m], [AgentState m])
{-# INLINABLE findPath #-}
findPath :: forall (m :: * -> *).
MonadDES m =>
Maybe (AgentState m)
-> AgentState m -> ([AgentState m], [AgentState m])
findPath Maybe (AgentState m)
Nothing AgentState m
target = ([], AgentState m -> [AgentState m] -> [AgentState m]
forall (m :: * -> *).
AgentState m -> [AgentState m] -> [AgentState m]
fullPath AgentState m
target [])
findPath (Just AgentState m
source) AgentState m
target
  | AgentState m -> Agent m
forall (m :: * -> *). AgentState m -> Agent m
stateAgent AgentState m
source Agent m -> Agent m -> Bool
forall a. Eq a => a -> a -> Bool
/= AgentState m -> Agent m
forall (m :: * -> *). AgentState m -> Agent m
stateAgent AgentState m
target =
    [Char] -> ([AgentState m], [AgentState m])
forall a. HasCallStack => [Char] -> a
error [Char]
"Different agents: findPath."
  | Bool
otherwise =
    [AgentState m]
-> [AgentState m] -> ([AgentState m], [AgentState m])
forall (m :: * -> *).
MonadDES m =>
[AgentState m]
-> [AgentState m] -> ([AgentState m], [AgentState m])
partitionPath [AgentState m]
path1 [AgentState m]
path2
  where
    path1 :: [AgentState m]
path1 = AgentState m -> [AgentState m] -> [AgentState m]
forall (m :: * -> *).
AgentState m -> [AgentState m] -> [AgentState m]
fullPath AgentState m
source []
    path2 :: [AgentState m]
path2 = AgentState m -> [AgentState m] -> [AgentState m]
forall (m :: * -> *).
AgentState m -> [AgentState m] -> [AgentState m]
fullPath AgentState m
target []

traversePath :: MonadDES m => Maybe (AgentState m) -> AgentState m -> Event m ()
{-# INLINABLE traversePath #-}
traversePath :: forall (m :: * -> *).
MonadDES m =>
Maybe (AgentState m) -> AgentState m -> Event m ()
traversePath Maybe (AgentState m)
source AgentState m
target =
  let ([AgentState m]
path1, [AgentState m]
path2) = Maybe (AgentState m)
-> AgentState m -> ([AgentState m], [AgentState m])
forall (m :: * -> *).
MonadDES m =>
Maybe (AgentState m)
-> AgentState m -> ([AgentState m], [AgentState m])
findPath Maybe (AgentState m)
source AgentState m
target
      agent :: Agent m
agent = AgentState m -> Agent m
forall (m :: * -> *). AgentState m -> Agent m
stateAgent AgentState m
target
      activate :: AgentState m -> Point m -> m ()
activate AgentState m
st Point m
p   = Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> m (Event m ()) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Point m -> Event m (Event m ()) -> m (Event m ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Event m ()) -> m (Event m ()))
-> Event m (Event m ()) -> m (Event m ())
forall a b. (a -> b) -> a -> b
$ Ref m (Event m ()) -> Event m (Event m ())
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m (Event m ())
forall (m :: * -> *). AgentState m -> Ref m (Event m ())
stateActivateRef AgentState m
st))
      deactivate :: AgentState m -> Point m -> m ()
deactivate AgentState m
st Point m
p = Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> m (Event m ()) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Point m -> Event m (Event m ()) -> m (Event m ())
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Event m ()) -> m (Event m ()))
-> Event m (Event m ()) -> m (Event m ())
forall a b. (a -> b) -> a -> b
$ Ref m (Event m ()) -> Event m (Event m ())
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m (Event m ())
forall (m :: * -> *). AgentState m -> Ref m (Event m ())
stateDeactivateRef AgentState m
st))
      transit :: AgentState m -> Point m -> m (Maybe (AgentState m))
transit AgentState m
st Point m
p    = Point m
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m)))
-> m (Event m (Maybe (AgentState m))) -> m (Maybe (AgentState m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Point m
-> Event m (Event m (Maybe (AgentState m)))
-> m (Event m (Maybe (AgentState m)))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Event m (Maybe (AgentState m)))
 -> m (Event m (Maybe (AgentState m))))
-> Event m (Event m (Maybe (AgentState m)))
-> m (Event m (Maybe (AgentState m)))
forall a b. (a -> b) -> a -> b
$ Ref m (Event m (Maybe (AgentState m)))
-> Event m (Event m (Maybe (AgentState m)))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m (Event m (Maybe (AgentState m)))
forall (m :: * -> *).
AgentState m -> Ref m (Event m (Maybe (AgentState m)))
stateTransitRef AgentState m
st))
      continue :: AgentState m -> Point m -> m ()
continue AgentState m
st Point m
p   = Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (AgentState m) -> AgentState m -> Event m ()
forall (m :: * -> *).
MonadDES m =>
Maybe (AgentState m) -> AgentState m -> Event m ()
traversePath (AgentState m -> Maybe (AgentState m)
forall a. a -> Maybe a
Just AgentState m
target) AgentState m
st
  in (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AgentState m] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AgentState m]
path1 Bool -> Bool -> Bool
&& [AgentState m] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AgentState m]
path2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
       do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m AgentMode -> AgentMode -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Agent m -> Ref m AgentMode
forall (m :: * -> *). Agent m -> Ref m AgentMode
agentModeRef Agent m
agent) AgentMode
TransientMode
          [AgentState m] -> (AgentState m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AgentState m]
path1 ((AgentState m -> m ()) -> m ()) -> (AgentState m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \AgentState m
st ->
            do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AgentState m)) -> Maybe (AgentState m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
agent) (AgentState m -> Maybe (AgentState m)
forall a. a -> Maybe a
Just AgentState m
st)
               AgentState m -> Point m -> m ()
forall {m :: * -> *}. MonadRef m => AgentState m -> Point m -> m ()
deactivate AgentState m
st Point m
p
               -- it makes all timeout and timer handlers outdated
               Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> (Int -> Int) -> Event m ()
forall a. Ref m a -> (a -> a) -> Event m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref m a -> (a -> a) -> Event m ()
modifyRef (AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
st) (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
          [AgentState m] -> (AgentState m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AgentState m]
path2 ((AgentState m -> m ()) -> m ()) -> (AgentState m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \AgentState m
st ->
            do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AgentState m)) -> Maybe (AgentState m) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
agent) (AgentState m -> Maybe (AgentState m)
forall a. a -> Maybe a
Just AgentState m
st)
               AgentState m -> Point m -> m ()
forall {m :: * -> *}. MonadRef m => AgentState m -> Point m -> m ()
activate AgentState m
st Point m
p
          Maybe (AgentState m)
st' <- AgentState m -> Point m -> m (Maybe (AgentState m))
forall {m :: * -> *}.
MonadRef m =>
AgentState m -> Point m -> m (Maybe (AgentState m))
transit AgentState m
target Point m
p
          case Maybe (AgentState m)
st' of
            Maybe (AgentState m)
Nothing ->
              do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m AgentMode -> AgentMode -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (Agent m -> Ref m AgentMode
forall (m :: * -> *). Agent m -> Ref m AgentMode
agentModeRef Agent m
agent) AgentMode
ProcessingMode
                 Point m -> Agent m -> m ()
forall (m :: * -> *). MonadDES m => Point m -> Agent m -> m ()
triggerAgentStateChanged Point m
p Agent m
agent
            Just AgentState m
st' ->
              AgentState m -> Point m -> m ()
continue AgentState m
st' Point m
p

-- | Add to the state a timeout handler that will be actuated 
-- in the specified time period if the state will remain active.
addTimeout :: MonadDES m => AgentState m -> Double -> Event m () -> Event m ()
{-# INLINABLE addTimeout #-}
addTimeout :: forall (m :: * -> *).
MonadDES m =>
AgentState m -> Double -> Event m () -> Event m ()
addTimeout AgentState m
st Double
dt Event m ()
action =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
v <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
st)
     let m1 :: Event m ()
m1 = (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do Int
v' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
st)
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
action
         m2 :: Event m ()
m2 = Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt) Event m ()
m1
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
m2

-- | Add to the state a timer handler that will be actuated
-- in the specified time period and then repeated again many times,
-- while the state remains active.
addTimer :: MonadDES m => AgentState m -> Event m Double -> Event m () -> Event m ()
{-# INLINABLE addTimer #-}
addTimer :: forall (m :: * -> *).
MonadDES m =>
AgentState m -> Event m Double -> Event m () -> Event m ()
addTimer AgentState m
st Event m Double
dt Event m ()
action =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do Int
v <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
st)
     let m1 :: Event m ()
m1 = (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do Int
v' <- Point m -> Event m Int -> m Int
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m Int -> m Int) -> Event m Int -> m Int
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Event m Int
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (AgentState m -> Ref m Int
forall (m :: * -> *). AgentState m -> Ref m Int
stateVersionRef AgentState m
st)
              Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
v') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                do Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
m2
                   Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
action
         m2 :: Event m ()
m2 = (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
           do Double
dt' <- Point m -> Event m Double -> m Double
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m Double
dt
              Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Double -> Event m () -> Event m ()
forall (m :: * -> *).
EventQueueing m =>
Double -> Event m () -> Event m ()
enqueueEvent (Point m -> Double
forall (m :: * -> *). Point m -> Double
pointTime Point m
p Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt') Event m ()
m1
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p Event m ()
m2

-- | Create a new state.
newState :: MonadDES m => Agent m -> Simulation m (AgentState m)
{-# INLINABLE newState #-}
newState :: forall (m :: * -> *).
MonadDES m =>
Agent m -> Simulation m (AgentState m)
newState Agent m
agent =
  do Ref m (Event m ())
aref <- Event m () -> Simulation m (Ref m (Event m ()))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Event m () -> Simulation m (Ref m (Event m ())))
-> Event m () -> Simulation m (Ref m (Event m ()))
forall a b. (a -> b) -> a -> b
$ () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Ref m (Event m ())
dref <- Event m () -> Simulation m (Ref m (Event m ()))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Event m () -> Simulation m (Ref m (Event m ())))
-> Event m () -> Simulation m (Ref m (Event m ()))
forall a b. (a -> b) -> a -> b
$ () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Ref m (Event m (Maybe (AgentState m)))
tref <- Event m (Maybe (AgentState m))
-> Simulation m (Ref m (Event m (Maybe (AgentState m))))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Event m (Maybe (AgentState m))
 -> Simulation m (Ref m (Event m (Maybe (AgentState m)))))
-> Event m (Maybe (AgentState m))
-> Simulation m (Ref m (Event m (Maybe (AgentState m))))
forall a b. (a -> b) -> a -> b
$ Maybe (AgentState m) -> Event m (Maybe (AgentState m))
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (AgentState m)
forall a. Maybe a
Nothing
     Ref m Int
vref <- Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
     AgentState m -> Simulation m (AgentState m)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return AgentState { stateAgent :: Agent m
stateAgent = Agent m
agent,
                         stateParent :: Maybe (AgentState m)
stateParent = Maybe (AgentState m)
forall a. Maybe a
Nothing,
                         stateActivateRef :: Ref m (Event m ())
stateActivateRef = Ref m (Event m ())
aref,
                         stateDeactivateRef :: Ref m (Event m ())
stateDeactivateRef = Ref m (Event m ())
dref,
                         stateTransitRef :: Ref m (Event m (Maybe (AgentState m)))
stateTransitRef = Ref m (Event m (Maybe (AgentState m)))
tref,
                         stateVersionRef :: Ref m Int
stateVersionRef = Ref m Int
vref }

-- | Create a child state.
newSubstate :: MonadDES m => AgentState m -> Simulation m (AgentState m)
{-# INLINABLE newSubstate #-}
newSubstate :: forall (m :: * -> *).
MonadDES m =>
AgentState m -> Simulation m (AgentState m)
newSubstate AgentState m
parent =
  do let agent :: Agent m
agent = AgentState m -> Agent m
forall (m :: * -> *). AgentState m -> Agent m
stateAgent AgentState m
parent
     Ref m (Event m ())
aref <- Event m () -> Simulation m (Ref m (Event m ()))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Event m () -> Simulation m (Ref m (Event m ())))
-> Event m () -> Simulation m (Ref m (Event m ()))
forall a b. (a -> b) -> a -> b
$ () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Ref m (Event m ())
dref <- Event m () -> Simulation m (Ref m (Event m ()))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Event m () -> Simulation m (Ref m (Event m ())))
-> Event m () -> Simulation m (Ref m (Event m ()))
forall a b. (a -> b) -> a -> b
$ () -> Event m ()
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Ref m (Event m (Maybe (AgentState m)))
tref <- Event m (Maybe (AgentState m))
-> Simulation m (Ref m (Event m (Maybe (AgentState m))))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef (Event m (Maybe (AgentState m))
 -> Simulation m (Ref m (Event m (Maybe (AgentState m)))))
-> Event m (Maybe (AgentState m))
-> Simulation m (Ref m (Event m (Maybe (AgentState m))))
forall a b. (a -> b) -> a -> b
$ Maybe (AgentState m) -> Event m (Maybe (AgentState m))
forall a. a -> Event m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (AgentState m)
forall a. Maybe a
Nothing
     Ref m Int
vref <- Int -> Simulation m (Ref m Int)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Int
0
     AgentState m -> Simulation m (AgentState m)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return AgentState { stateAgent :: Agent m
stateAgent = Agent m
agent,
                         stateParent :: Maybe (AgentState m)
stateParent = AgentState m -> Maybe (AgentState m)
forall a. a -> Maybe a
Just AgentState m
parent,
                         stateActivateRef :: Ref m (Event m ())
stateActivateRef= Ref m (Event m ())
aref,
                         stateDeactivateRef :: Ref m (Event m ())
stateDeactivateRef = Ref m (Event m ())
dref,
                         stateTransitRef :: Ref m (Event m (Maybe (AgentState m)))
stateTransitRef = Ref m (Event m (Maybe (AgentState m)))
tref,
                         stateVersionRef :: Ref m Int
stateVersionRef = Ref m Int
vref }

-- | Create an agent.
newAgent :: MonadDES m => Simulation m (Agent m)
{-# INLINABLE newAgent #-}
newAgent :: forall (m :: * -> *). MonadDES m => Simulation m (Agent m)
newAgent =
  do Ref m AgentMode
modeRef  <- AgentMode -> Simulation m (Ref m AgentMode)
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef AgentMode
CreationMode
     Ref m (Maybe (AgentState m))
stateRef <- Maybe (AgentState m) -> Simulation m (Ref m (Maybe (AgentState m)))
forall a. a -> Simulation m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> Simulation m (Ref m a)
newRef Maybe (AgentState m)
forall a. Maybe a
Nothing
     SignalSource m (Maybe (AgentState m))
stateChangedSource <- Simulation m (SignalSource m (Maybe (AgentState m)))
forall (m :: * -> *) a.
MonadDES m =>
Simulation m (SignalSource m a)
newSignalSource
     Agent m -> Simulation m (Agent m)
forall a. a -> Simulation m a
forall (m :: * -> *) a. Monad m => a -> m a
return Agent { agentModeRef :: Ref m AgentMode
agentModeRef = Ref m AgentMode
modeRef,
                    agentStateRef :: Ref m (Maybe (AgentState m))
agentStateRef = Ref m (Maybe (AgentState m))
stateRef, 
                    agentStateChangedSource :: SignalSource m (Maybe (AgentState m))
agentStateChangedSource = SignalSource m (Maybe (AgentState m))
stateChangedSource }

-- | Return the selected active state.
selectedState :: MonadDES m => Agent m -> Event m (Maybe (AgentState m))
{-# INLINABLE selectedState #-}
selectedState :: forall (m :: * -> *).
MonadDES m =>
Agent m -> Event m (Maybe (AgentState m))
selectedState Agent m
agent = Ref m (Maybe (AgentState m)) -> Event m (Maybe (AgentState m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
agent)
                   
-- | Select the state. The activation and selection are repeated while
-- there is the transition state defined by 'setStateTransition'.
selectState :: MonadDES m => AgentState m -> Event m ()
{-# INLINABLE selectState #-}
selectState :: forall (m :: * -> *). MonadDES m => AgentState m -> Event m ()
selectState AgentState m
st =
  (Point m -> m ()) -> Event m ()
forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event ((Point m -> m ()) -> Event m ())
-> (Point m -> m ()) -> Event m ()
forall a b. (a -> b) -> a -> b
$ \Point m
p ->
  do let agent :: Agent m
agent = AgentState m -> Agent m
forall (m :: * -> *). AgentState m -> Agent m
stateAgent AgentState m
st
     AgentMode
mode <- Point m -> Event m AgentMode -> m AgentMode
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m AgentMode -> m AgentMode)
-> Event m AgentMode -> m AgentMode
forall a b. (a -> b) -> a -> b
$ Ref m AgentMode -> Event m AgentMode
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Agent m -> Ref m AgentMode
forall (m :: * -> *). Agent m -> Ref m AgentMode
agentModeRef Agent m
agent)
     case AgentMode
mode of
       AgentMode
CreationMode ->
         do Maybe (AgentState m)
x0 <- Point m
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m)))
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AgentState m)) -> Event m (Maybe (AgentState m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
agent)
            Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (AgentState m) -> AgentState m -> Event m ()
forall (m :: * -> *).
MonadDES m =>
Maybe (AgentState m) -> AgentState m -> Event m ()
traversePath Maybe (AgentState m)
x0 AgentState m
st
       AgentMode
TransientMode ->
         [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$
         [Char]
"Use the setStateTransition function to define " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
         [Char]
"the transition state: activateState."
       AgentMode
ProcessingMode ->
         do Maybe (AgentState m)
x0 <- Point m
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m)))
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AgentState m)) -> Event m (Maybe (AgentState m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
agent)
            case Maybe (AgentState m)
x0 of
              Just AgentState m
st0 -> Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (AgentState m) -> AgentState m -> Event m ()
forall (m :: * -> *).
MonadDES m =>
Maybe (AgentState m) -> AgentState m -> Event m ()
traversePath Maybe (AgentState m)
x0 AgentState m
st
              Maybe (AgentState m)
Nothing  -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Pattern match failed: selectState"

-- | Set the activation computation for the specified state.
setStateActivation :: MonadDES m => AgentState m -> Event m () -> Event m ()
{-# INLINABLE setStateActivation #-}
setStateActivation :: forall (m :: * -> *).
MonadDES m =>
AgentState m -> Event m () -> Event m ()
setStateActivation AgentState m
st Event m ()
action =
  Ref m (Event m ()) -> Event m () -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (AgentState m -> Ref m (Event m ())
forall (m :: * -> *). AgentState m -> Ref m (Event m ())
stateActivateRef AgentState m
st) Event m ()
action
  
-- | Set the deactivation computation for the specified state.
setStateDeactivation :: MonadDES m => AgentState m -> Event m () -> Event m ()
{-# INLINABLE setStateDeactivation #-}
setStateDeactivation :: forall (m :: * -> *).
MonadDES m =>
AgentState m -> Event m () -> Event m ()
setStateDeactivation AgentState m
st Event m ()
action =
  Ref m (Event m ()) -> Event m () -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (AgentState m -> Ref m (Event m ())
forall (m :: * -> *). AgentState m -> Ref m (Event m ())
stateDeactivateRef AgentState m
st) Event m ()
action
  
-- | Set the transition state which will be next and which is used only
-- when selecting the state directly with help of 'selectState'.
-- If the state was activated intermediately, when selecting
-- another state, then this computation is not used.
setStateTransition :: MonadDES m => AgentState m -> Event m (Maybe (AgentState m)) -> Event m ()
{-# INLINABLE setStateTransition #-}
setStateTransition :: forall (m :: * -> *).
MonadDES m =>
AgentState m -> Event m (Maybe (AgentState m)) -> Event m ()
setStateTransition AgentState m
st Event m (Maybe (AgentState m))
action =
  Ref m (Event m (Maybe (AgentState m)))
-> Event m (Maybe (AgentState m)) -> Event m ()
forall a. Ref m a -> a -> Event m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> Event m ()
writeRef (AgentState m -> Ref m (Event m (Maybe (AgentState m)))
forall (m :: * -> *).
AgentState m -> Ref m (Event m (Maybe (AgentState m)))
stateTransitRef AgentState m
st) Event m (Maybe (AgentState m))
action
  
-- | Trigger the signal when the agent state changes.
triggerAgentStateChanged :: MonadDES m => Point m -> Agent m -> m ()
{-# INLINABLE triggerAgentStateChanged #-}
triggerAgentStateChanged :: forall (m :: * -> *). MonadDES m => Point m -> Agent m -> m ()
triggerAgentStateChanged Point m
p Agent m
agent =
  do Maybe (AgentState m)
st <- Point m
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m)))
-> Event m (Maybe (AgentState m)) -> m (Maybe (AgentState m))
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe (AgentState m)) -> Event m (Maybe (AgentState m))
forall a. Ref m a -> Event m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> Event m a
readRef (Agent m -> Ref m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Ref m (Maybe (AgentState m))
agentStateRef Agent m
agent)
     Point m -> Event m () -> m ()
forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point m
p (Event m () -> m ()) -> Event m () -> m ()
forall a b. (a -> b) -> a -> b
$ SignalSource m (Maybe (AgentState m))
-> Maybe (AgentState m) -> Event m ()
forall (m :: * -> *) a. SignalSource m a -> a -> Event m ()
triggerSignal (Agent m -> SignalSource m (Maybe (AgentState m))
forall (m :: * -> *).
Agent m -> SignalSource m (Maybe (AgentState m))
agentStateChangedSource Agent m
agent) Maybe (AgentState m)
st

-- | Return a signal that notifies about every change of the selected state.
selectedStateChanged :: Agent m -> Signal m (Maybe (AgentState m))
{-# INLINABLE selectedStateChanged #-}
selectedStateChanged :: forall (m :: * -> *). Agent m -> Signal m (Maybe (AgentState m))
selectedStateChanged Agent m
agent =
  SignalSource m (Maybe (AgentState m))
-> Signal m (Maybe (AgentState m))
forall (m :: * -> *) a. SignalSource m a -> Signal m a
publishSignal (Agent m -> SignalSource m (Maybe (AgentState m))
forall (m :: * -> *).
Agent m -> SignalSource m (Maybe (AgentState m))
agentStateChangedSource Agent m
agent)

-- | Return a signal that notifies about every change of the selected state.
selectedStateChanged_ :: MonadDES m => Agent m -> Signal m ()
{-# INLINABLE selectedStateChanged_ #-}
selectedStateChanged_ :: forall (m :: * -> *). MonadDES m => Agent m -> Signal m ()
selectedStateChanged_ Agent m
agent =
  (Maybe (AgentState m) -> ())
-> Signal m (Maybe (AgentState m)) -> Signal m ()
forall (m :: * -> *) a b.
MonadDES m =>
(a -> b) -> Signal m a -> Signal m b
mapSignal (() -> Maybe (AgentState m) -> ()
forall a b. a -> b -> a
const ()) (Signal m (Maybe (AgentState m)) -> Signal m ())
-> Signal m (Maybe (AgentState m)) -> Signal m ()
forall a b. (a -> b) -> a -> b
$ Agent m -> Signal m (Maybe (AgentState m))
forall (m :: * -> *). Agent m -> Signal m (Maybe (AgentState m))
selectedStateChanged Agent m
agent