module Simulation.Aivika.Dynamics.Agent
(Agent,
AgentState,
newAgent,
newState,
newSubstate,
agentQueue,
agentState,
agentStateChanged,
agentStateChanged_,
activateState,
initState,
stateAgent,
stateParent,
addTimeout,
addTimer,
stateActivation,
stateDeactivation,
setStateActivation,
setStateDeactivation,
setStateTransition) where
import Data.IORef
import Control.Monad
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import Simulation.Aivika.Dynamics.EventQueue
import Simulation.Aivika.Dynamics.Internal.Signal
data Agent = Agent { agentQueue :: EventQueue,
agentModeRef :: IORef AgentMode,
agentStateRef :: IORef (Maybe AgentState),
agentStateChangedSource :: SignalSource (Maybe AgentState),
agentStateUpdatedSource :: SignalSource (Maybe AgentState) }
data AgentState = AgentState { stateAgent :: Agent,
stateParent :: Maybe AgentState,
stateActivateRef :: IORef (Dynamics ()),
stateDeactivateRef :: IORef (Dynamics ()),
stateTransitRef :: IORef (Dynamics (Maybe AgentState)),
stateVersionRef :: IORef Int }
data AgentMode = CreationMode
| InitialMode
| TransientMode
| ProcessingMode
instance Eq Agent where
x == y = agentStateRef x == agentStateRef y
instance Eq AgentState where
x == y = stateVersionRef x == stateVersionRef y
fullPath :: AgentState -> [AgentState] -> [AgentState]
fullPath st acc =
case stateParent st of
Nothing -> st : acc
Just st' -> fullPath st' (st : acc)
partitionPath :: [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
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 :: Maybe AgentState -> AgentState -> ([AgentState], [AgentState])
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 :: Maybe AgentState -> AgentState -> Dynamics ()
traversePath source target =
let (path1, path2) = findPath source target
agent = stateAgent target
activate st p =
do Dynamics m <- readIORef (stateActivateRef st)
m p
deactivate st p =
do Dynamics m <- readIORef (stateDeactivateRef st)
m p
transit st p =
do Dynamics m <- readIORef (stateTransitRef st)
m p
continue st p =
do let Dynamics m = traversePath (Just target) st
m p
in Dynamics $ \p ->
unless (null path1 && null path2) $
do writeIORef (agentModeRef agent) TransientMode
forM_ path1 $ \st ->
do writeIORef (agentStateRef agent) (Just st)
deactivate st p
modifyIORef (stateVersionRef st) (1 +)
forM_ path2 $ \st ->
do when (st == target) $
writeIORef (agentModeRef agent) InitialMode
writeIORef (agentStateRef agent) (Just st)
activate st p
writeIORef (agentModeRef agent) TransientMode
st' <- transit target p
case st' of
Nothing ->
do writeIORef (agentModeRef agent) ProcessingMode
triggerAgentStateChanged p agent
Just st' ->
continue st' p
addTimeout :: AgentState -> Double -> Dynamics () -> Dynamics ()
addTimeout st dt (Dynamics action) =
Dynamics $ \p ->
do let q = agentQueue (stateAgent st)
Dynamics m0 = runQueueSync q
m0 p
v <- readIORef (stateVersionRef st)
let m1 = Dynamics $ \p ->
do
v' <- readIORef (stateVersionRef st)
when (v == v') $ action p
Dynamics m2 = enqueue q (pointTime p + dt) m1
m2 p
addTimer :: AgentState -> Dynamics Double -> Dynamics () -> Dynamics ()
addTimer st (Dynamics dt) (Dynamics action) =
Dynamics $ \p ->
do let q = agentQueue (stateAgent st)
Dynamics m0 = runQueueSync q
m0 p
v <- readIORef (stateVersionRef st)
let m1 = Dynamics $ \p ->
do
v' <- readIORef (stateVersionRef st)
when (v == v') $ do { m2 p; action p }
Dynamics m2 =
Dynamics $ \p ->
do dt' <- dt p
let Dynamics m3 = enqueue q (pointTime p + dt') m1
m3 p
m2 p
newState :: Agent -> Simulation AgentState
newState agent =
Simulation $ \r ->
do aref <- newIORef $ return ()
dref <- newIORef $ return ()
tref <- newIORef $ return Nothing
vref <- newIORef 0
return AgentState { stateAgent = agent,
stateParent = Nothing,
stateActivateRef = aref,
stateDeactivateRef = dref,
stateTransitRef = tref,
stateVersionRef = vref }
newSubstate :: AgentState -> Simulation AgentState
newSubstate parent =
Simulation $ \r ->
do let agent = stateAgent parent
aref <- newIORef $ return ()
dref <- newIORef $ return ()
tref <- newIORef $ return Nothing
vref <- newIORef 0
return AgentState { stateAgent = agent,
stateParent = Just parent,
stateActivateRef= aref,
stateDeactivateRef = dref,
stateTransitRef = tref,
stateVersionRef = vref }
newAgent :: EventQueue -> Simulation Agent
newAgent queue =
Simulation $ \r ->
do modeRef <- newIORef CreationMode
stateRef <- newIORef Nothing
let Simulation m1 = newSignalSourceUnsafe
Simulation m2 = newSignalSourceWithUpdate $ runQueue queue
stateChangedSource <- m1 r
stateUpdatedSource <- m2 r
return Agent { agentQueue = queue,
agentModeRef = modeRef,
agentStateRef = stateRef,
agentStateChangedSource = stateChangedSource,
agentStateUpdatedSource = stateUpdatedSource }
agentState :: Agent -> Dynamics (Maybe AgentState)
agentState agent =
Dynamics $ \p ->
do let Dynamics m = runQueueSync $ agentQueue agent
m p
readIORef (agentStateRef agent)
activateState :: AgentState -> Dynamics ()
activateState st =
Dynamics $ \p ->
do let agent = stateAgent st
Dynamics m = runQueueSync $ agentQueue agent
m p
mode <- readIORef (agentModeRef agent)
case mode of
CreationMode ->
do x0 <- readIORef (agentStateRef agent)
let Dynamics m = traversePath x0 st
m p
InitialMode ->
error $
"Use the setStateTransition function to define " ++
"the transition state: activateState."
TransientMode ->
error $
"Use the setStateTransition function to define " ++
"the transition state: activateState."
ProcessingMode ->
do x0 @ (Just st0) <- readIORef (agentStateRef agent)
let Dynamics m = traversePath x0 st
m p
initState :: AgentState -> Dynamics ()
initState st =
Dynamics $ \p ->
do let agent = stateAgent st
Dynamics m = runQueueSync $ agentQueue agent
m p
mode <- readIORef (agentModeRef agent)
case mode of
CreationMode ->
error $
"To run the agent for the fist time, use " ++
"the activateState function: initState."
InitialMode ->
do x0 @ (Just st0) <- readIORef (agentStateRef agent)
let Dynamics m = traversePath x0 st
m p
TransientMode ->
return ()
ProcessingMode ->
error $
"Use the activateState function everywhere outside " ++
"the state activation: initState."
stateActivation :: AgentState -> Dynamics () -> Simulation ()
stateActivation = setStateActivation
stateDeactivation :: AgentState -> Dynamics () -> Simulation ()
stateDeactivation = setStateDeactivation
setStateActivation :: AgentState -> Dynamics () -> Simulation ()
setStateActivation st action =
Simulation $ \r ->
writeIORef (stateActivateRef st) action
setStateDeactivation :: AgentState -> Dynamics () -> Simulation ()
setStateDeactivation st action =
Simulation $ \r ->
writeIORef (stateDeactivateRef st) action
setStateTransition :: AgentState -> Dynamics (Maybe AgentState) -> Simulation ()
setStateTransition st action =
Simulation $ \r ->
writeIORef (stateTransitRef st) action
triggerAgentStateChanged :: Point -> Agent -> IO ()
triggerAgentStateChanged p agent =
do st <- readIORef (agentStateRef agent)
let Dynamics m = triggerSignal (agentStateChangedSource agent) st
m p
agentStateChanged :: Agent -> Signal (Maybe AgentState)
agentStateChanged v = merge2Signals m1 m2
where m1 = publishSignal (agentStateUpdatedSource v)
m2 = publishSignal (agentStateChangedSource v)
agentStateChanged_ :: Agent -> Signal ()
agentStateChanged_ agent =
mapSignal (const ()) $ agentStateChanged agent