-- |
-- Module     : Simulation.Aivika.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.Agent
       (Agent,
        AgentState,
        newAgent,
        newState,
        newSubstate,
        selectedState,
        selectedStateChanged,
        selectedStateChanged_,
        selectState,
        stateAgent,
        stateParent,
        addTimeout,
        addTimer,
        setStateActivation,
        setStateDeactivation,
        setStateTransition) where

import Data.IORef
import Control.Monad

import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Signal

--
-- Agent-based Modeling
--

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

-- | Represents the agent state.
data AgentState = AgentState { AgentState -> Agent
stateAgent         :: Agent,
                               -- ^ Return the corresponded agent.
                               AgentState -> Maybe AgentState
stateParent        :: Maybe AgentState,
                               -- ^ Return the parent state or 'Nothing'.
                               AgentState -> IORef (Event ())
stateActivateRef   :: IORef (Event ()),
                               AgentState -> IORef (Event ())
stateDeactivateRef :: IORef (Event ()),
                               AgentState -> IORef (Event (Maybe AgentState))
stateTransitRef    :: IORef (Event (Maybe AgentState)),
                               AgentState -> IORef Int
stateVersionRef    :: IORef Int }
                  
data AgentMode = CreationMode
               | TransientMode
               | ProcessingMode
                      
instance Eq Agent where
  Agent
x == :: Agent -> Agent -> Bool
== Agent
y = Agent -> IORef (Maybe AgentState)
agentStateRef Agent
x forall a. Eq a => a -> a -> Bool
== Agent -> IORef (Maybe AgentState)
agentStateRef Agent
y      -- unique references
  
instance Eq AgentState where
  AgentState
x == :: AgentState -> AgentState -> Bool
== AgentState
y = AgentState -> IORef Int
stateVersionRef AgentState
x forall a. Eq a => a -> a -> Bool
== AgentState -> IORef Int
stateVersionRef AgentState
y  -- unique references

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

partitionPath :: [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath :: [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath [AgentState]
path1 [AgentState]
path2 =
  case ([AgentState]
path1, [AgentState]
path2) of
    (AgentState
h1 : [AgentState]
t1, [AgentState
h2]) | AgentState
h1 forall a. Eq a => a -> a -> Bool
== AgentState
h2 -> 
      (forall a. [a] -> [a]
reverse [AgentState]
path1, [AgentState]
path2)
    (AgentState
h1 : [AgentState]
t1, AgentState
h2 : [AgentState]
t2) | AgentState
h1 forall a. Eq a => a -> a -> Bool
== AgentState
h2 -> 
      [AgentState] -> [AgentState] -> ([AgentState], [AgentState])
partitionPath [AgentState]
t1 [AgentState]
t2
    ([AgentState], [AgentState])
_ ->
      (forall a. [a] -> [a]
reverse [AgentState]
path1, [AgentState]
path2)

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

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

-- | Add to the state a timeout handler that will be actuated 
-- in the specified time period if the state will remain active.
addTimeout :: AgentState -> Double -> Event () -> Event ()
addTimeout :: AgentState -> Double -> Event () -> Event ()
addTimeout AgentState
st Double
dt Event ()
action =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
v <- forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
     let m1 :: Event ()
m1 = forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Int
v' <- forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v forall a. Eq a => a -> a -> Bool
== Int
v') forall a b. (a -> b) -> a -> b
$
                forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
action
         m2 :: Event ()
m2 = Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p forall a. Num a => a -> a -> a
+ Double
dt) Event ()
m1
     forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
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 :: AgentState -> Event Double -> Event () -> Event ()
addTimer :: AgentState -> Event Double -> Event () -> Event ()
addTimer AgentState
st Event Double
dt Event ()
action =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  do Int
v <- forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
     let m1 :: Event ()
m1 = forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Int
v' <- forall a. IORef a -> IO a
readIORef (AgentState -> IORef Int
stateVersionRef AgentState
st)
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
v forall a. Eq a => a -> a -> Bool
== Int
v') forall a b. (a -> b) -> a -> b
$
                do forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m2
                   forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
action
         m2 :: Event ()
m2 = forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
           do Double
dt' <- forall a. Point -> Event a -> IO a
invokeEvent Point
p Event Double
dt
              forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ Double -> Event () -> Event ()
enqueueEvent (Point -> Double
pointTime Point
p forall a. Num a => a -> a -> a
+ Double
dt') Event ()
m1
     forall a. Point -> Event a -> IO a
invokeEvent Point
p Event ()
m2

-- | Create a new state.
newState :: Agent -> Simulation AgentState
newState :: Agent -> Simulation AgentState
newState Agent
agent =
  forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do IORef (Event ())
aref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event ())
dref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event (Maybe AgentState))
tref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     IORef Int
vref <- forall a. a -> IO (IORef a)
newIORef Int
0
     forall (m :: * -> *) a. Monad m => a -> m a
return AgentState { stateAgent :: Agent
stateAgent = Agent
agent,
                         stateParent :: Maybe AgentState
stateParent = forall a. Maybe a
Nothing,
                         stateActivateRef :: IORef (Event ())
stateActivateRef = IORef (Event ())
aref,
                         stateDeactivateRef :: IORef (Event ())
stateDeactivateRef = IORef (Event ())
dref,
                         stateTransitRef :: IORef (Event (Maybe AgentState))
stateTransitRef = IORef (Event (Maybe AgentState))
tref,
                         stateVersionRef :: IORef Int
stateVersionRef = IORef Int
vref }

-- | Create a child state.
newSubstate :: AgentState -> Simulation AgentState
newSubstate :: AgentState -> Simulation AgentState
newSubstate AgentState
parent =
  forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do let agent :: Agent
agent = AgentState -> Agent
stateAgent AgentState
parent 
     IORef (Event ())
aref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event ())
dref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
     IORef (Event (Maybe AgentState))
tref <- forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
     IORef Int
vref <- forall a. a -> IO (IORef a)
newIORef Int
0
     forall (m :: * -> *) a. Monad m => a -> m a
return AgentState { stateAgent :: Agent
stateAgent = Agent
agent,
                         stateParent :: Maybe AgentState
stateParent = forall a. a -> Maybe a
Just AgentState
parent,
                         stateActivateRef :: IORef (Event ())
stateActivateRef= IORef (Event ())
aref,
                         stateDeactivateRef :: IORef (Event ())
stateDeactivateRef = IORef (Event ())
dref,
                         stateTransitRef :: IORef (Event (Maybe AgentState))
stateTransitRef = IORef (Event (Maybe AgentState))
tref,
                         stateVersionRef :: IORef Int
stateVersionRef = IORef Int
vref }

-- | Create an agent.
newAgent :: Simulation Agent
newAgent :: Simulation Agent
newAgent =
  forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
  do IORef AgentMode
modeRef  <- forall a. a -> IO (IORef a)
newIORef AgentMode
CreationMode
     IORef (Maybe AgentState)
stateRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     SignalSource (Maybe AgentState)
stateChangedSource <- forall a. Run -> Simulation a -> IO a
invokeSimulation Run
r forall a. Simulation (SignalSource a)
newSignalSource
     forall (m :: * -> *) a. Monad m => a -> m a
return Agent { agentModeRef :: IORef AgentMode
agentModeRef = IORef AgentMode
modeRef,
                    agentStateRef :: IORef (Maybe AgentState)
agentStateRef = IORef (Maybe AgentState)
stateRef, 
                    agentStateChangedSource :: SignalSource (Maybe AgentState)
agentStateChangedSource = SignalSource (Maybe AgentState)
stateChangedSource }

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

-- | Set the activation computation for the specified state.
setStateActivation :: AgentState -> Event () -> Event ()
setStateActivation :: AgentState -> Event () -> Event ()
setStateActivation AgentState
st Event ()
action =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  forall a. IORef a -> a -> IO ()
writeIORef (AgentState -> IORef (Event ())
stateActivateRef AgentState
st) Event ()
action
  
-- | Set the deactivation computation for the specified state.
setStateDeactivation :: AgentState -> Event () -> Event ()
setStateDeactivation :: AgentState -> Event () -> Event ()
setStateDeactivation AgentState
st Event ()
action =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  forall a. IORef a -> a -> IO ()
writeIORef (AgentState -> IORef (Event ())
stateDeactivateRef AgentState
st) Event ()
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 :: AgentState -> Event (Maybe AgentState) -> Event ()
setStateTransition :: AgentState -> Event (Maybe AgentState) -> Event ()
setStateTransition AgentState
st Event (Maybe AgentState)
action =
  forall a. (Point -> IO a) -> Event a
Event forall a b. (a -> b) -> a -> b
$ \Point
p ->
  forall a. IORef a -> a -> IO ()
writeIORef (AgentState -> IORef (Event (Maybe AgentState))
stateTransitRef AgentState
st) Event (Maybe AgentState)
action
  
-- | Trigger the signal when the agent state changes.
triggerAgentStateChanged :: Point -> Agent -> IO ()
triggerAgentStateChanged :: Point -> Agent -> IO ()
triggerAgentStateChanged Point
p Agent
agent =
  do Maybe AgentState
st <- forall a. IORef a -> IO a
readIORef (Agent -> IORef (Maybe AgentState)
agentStateRef Agent
agent)
     forall a. Point -> Event a -> IO a
invokeEvent Point
p forall a b. (a -> b) -> a -> b
$ forall a. SignalSource a -> a -> Event ()
triggerSignal (Agent -> SignalSource (Maybe AgentState)
agentStateChangedSource Agent
agent) Maybe AgentState
st

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

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