-- |
-- Module : Simulation.Aivika.Trans.Agent
-- Copyright : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
-- License : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability : experimental
-- Tested with: GHC 7.8.3
--
-- 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.Session
import Simulation.Aivika.Trans.ProtoRef
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Event
import Simulation.Aivika.Trans.Internal.Signal
--
-- Agent-based Modeling
--
-- | Represents an agent.
data Agent m = Agent { agentMarker :: SessionMarker m,
agentModeRef :: ProtoRef m AgentMode,
agentStateRef :: ProtoRef m (Maybe (AgentState m)),
agentStateChangedSource :: SignalSource m (Maybe (AgentState m)) }
-- | Represents the agent state.
data AgentState m = AgentState { stateAgent :: Agent m,
-- ^ Return the corresponded agent.
stateParent :: Maybe (AgentState m),
-- ^ Return the parent state or 'Nothing'.
stateMarker :: SessionMarker m,
stateActivateRef :: ProtoRef m (Event m ()),
stateDeactivateRef :: ProtoRef m (Event m ()),
stateTransitRef :: ProtoRef m (Event m (Maybe (AgentState m))),
stateVersionRef :: ProtoRef m Int }
data AgentMode = CreationMode
| TransientMode
| ProcessingMode
instance MonadComp m => Eq (Agent m) where
x == y = agentMarker x == agentMarker y
instance MonadComp m => Eq (AgentState m) where
x == y = stateMarker x == stateMarker y
fullPath :: AgentState m -> [AgentState m] -> [AgentState m]
fullPath st acc =
case stateParent st of
Nothing -> st : acc
Just st' -> fullPath st' (st : acc)
partitionPath :: MonadComp m => [AgentState m] -> [AgentState m] -> ([AgentState m], [AgentState m])
partitionPath path1 path2 =
case (path1, path2) of
(h1 : t1, [h2]) | h1 == h2 ->
(reverse path1, path2)
(h1 : t1, h2 : t2) | h1 == h2 ->
partitionPath t1 t2
_ ->
(reverse path1, path2)
findPath :: MonadComp m => Maybe (AgentState m) -> AgentState m -> ([AgentState m], [AgentState m])
findPath Nothing target = ([], fullPath target [])
findPath (Just source) target
| stateAgent source /= stateAgent target =
error "Different agents: findPath."
| otherwise =
partitionPath path1 path2
where
path1 = fullPath source []
path2 = fullPath target []
traversePath :: MonadComp m => Maybe (AgentState m) -> AgentState m -> Event m ()
traversePath source target =
let (path1, path2) = findPath source target
agent = stateAgent target
activate st p = invokeEvent p =<< readProtoRef (stateActivateRef st)
deactivate st p = invokeEvent p =<< readProtoRef (stateDeactivateRef st)
transit st p = invokeEvent p =<< readProtoRef (stateTransitRef st)
continue st p = invokeEvent p $ traversePath (Just target) st
in Event $ \p ->
unless (null path1 && null path2) $
do writeProtoRef (agentModeRef agent) TransientMode
forM_ path1 $ \st ->
do writeProtoRef (agentStateRef agent) (Just st)
deactivate st p
-- it makes all timeout and timer handlers outdated
modifyProtoRef (stateVersionRef st) (1 +)
forM_ path2 $ \st ->
do writeProtoRef (agentStateRef agent) (Just st)
activate st p
st' <- transit target p
case st' of
Nothing ->
do writeProtoRef (agentModeRef agent) ProcessingMode
triggerAgentStateChanged p agent
Just st' ->
continue st' p
-- | Add to the state a timeout handler that will be actuated
-- in the specified time period if the state will remain active.
addTimeout :: MonadComp m => AgentState m -> Double -> Event m () -> Event m ()
addTimeout st dt action =
Event $ \p ->
do v <- readProtoRef (stateVersionRef st)
let m1 = Event $ \p ->
do v' <- readProtoRef (stateVersionRef st)
when (v == v') $
invokeEvent p action
m2 = enqueueEvent (pointTime p + dt) m1
invokeEvent p 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 :: MonadComp m => AgentState m -> Event m Double -> Event m () -> Event m ()
addTimer st dt action =
Event $ \p ->
do v <- readProtoRef (stateVersionRef st)
let m1 = Event $ \p ->
do v' <- readProtoRef (stateVersionRef st)
when (v == v') $
do invokeEvent p m2
invokeEvent p action
m2 = Event $ \p ->
do dt' <- invokeEvent p dt
invokeEvent p $ enqueueEvent (pointTime p + dt') m1
invokeEvent p m2
-- | Create a new state.
newState :: MonadComp m => Agent m -> Simulation m (AgentState m)
newState agent =
Simulation $ \r ->
do let s = runSession r
aref <- newProtoRef s $ return ()
dref <- newProtoRef s $ return ()
tref <- newProtoRef s $ return Nothing
vref <- newProtoRef s 0
mrkr <- newSessionMarker s
return AgentState { stateAgent = agent,
stateParent = Nothing,
stateMarker = mrkr,
stateActivateRef = aref,
stateDeactivateRef = dref,
stateTransitRef = tref,
stateVersionRef = vref }
-- | Create a child state.
newSubstate :: MonadComp m => AgentState m -> Simulation m (AgentState m)
newSubstate parent =
Simulation $ \r ->
do let agent = stateAgent parent
s = runSession r
aref <- newProtoRef s $ return ()
dref <- newProtoRef s $ return ()
tref <- newProtoRef s $ return Nothing
vref <- newProtoRef s 0
mrkr <- newSessionMarker s
return AgentState { stateAgent = agent,
stateParent = Just parent,
stateMarker = mrkr,
stateActivateRef= aref,
stateDeactivateRef = dref,
stateTransitRef = tref,
stateVersionRef = vref }
-- | Create an agent.
newAgent :: MonadComp m => Simulation m (Agent m)
newAgent =
Simulation $ \r ->
do let s = runSession r
modeRef <- newProtoRef s CreationMode
stateRef <- newProtoRef s Nothing
stateChangedSource <- invokeSimulation r newSignalSource
mrkr <- newSessionMarker s
return Agent { agentMarker = mrkr,
agentModeRef = modeRef,
agentStateRef = stateRef,
agentStateChangedSource = stateChangedSource }
-- | Return the selected active state.
selectedState :: MonadComp m => Agent m -> Event m (Maybe (AgentState m))
selectedState agent =
Event $ \p -> readProtoRef (agentStateRef agent)
-- | Select the state. The activation and selection are repeated while
-- there is the transition state defined by 'setStateTransition'.
selectState :: MonadComp m => AgentState m -> Event m ()
selectState st =
Event $ \p ->
do let agent = stateAgent st
mode <- readProtoRef (agentModeRef agent)
case mode of
CreationMode ->
do x0 <- readProtoRef (agentStateRef agent)
invokeEvent p $ traversePath x0 st
TransientMode ->
error $
"Use the setStateTransition function to define " ++
"the transition state: activateState."
ProcessingMode ->
do x0 @ (Just st0) <- readProtoRef (agentStateRef agent)
invokeEvent p $ traversePath x0 st
-- | Set the activation computation for the specified state.
setStateActivation :: MonadComp m => AgentState m -> Event m () -> Simulation m ()
setStateActivation st action =
Simulation $ \r ->
writeProtoRef (stateActivateRef st) action
-- | Set the deactivation computation for the specified state.
setStateDeactivation :: MonadComp m => AgentState m -> Event m () -> Simulation m ()
setStateDeactivation st action =
Simulation $ \r ->
writeProtoRef (stateDeactivateRef st) 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 :: MonadComp m => AgentState m -> Event m (Maybe (AgentState m)) -> Simulation m ()
setStateTransition st action =
Simulation $ \r ->
writeProtoRef (stateTransitRef st) action
-- | Trigger the signal when the agent state changes.
triggerAgentStateChanged :: MonadComp m => Point m -> Agent m -> m ()
triggerAgentStateChanged p agent =
do st <- readProtoRef (agentStateRef agent)
invokeEvent p $ triggerSignal (agentStateChangedSource agent) st
-- | Return a signal that notifies about every change of the selected state.
selectedStateChanged :: Agent m -> Signal m (Maybe (AgentState m))
selectedStateChanged agent =
publishSignal (agentStateChangedSource agent)
-- | Return a signal that notifies about every change of the selected state.
selectedStateChanged_ :: MonadComp m => Agent m -> Signal m ()
selectedStateChanged_ agent =
mapSignal (const ()) $ selectedStateChanged agent