diff --git a/Simulation/Aivika/Dynamics/Agent.hs b/Simulation/Aivika/Dynamics/Agent.hs --- a/Simulation/Aivika/Dynamics/Agent.hs +++ b/Simulation/Aivika/Dynamics/Agent.hs @@ -7,8 +7,15 @@ -- Stability : experimental -- Tested with: GHC 7.6.3 -- --- This module introduces an agent-based modeling. +-- This module introduces basic entities for the agent-based modeling. -- +-- WARNING: the module is not well tested. This caution is related mainly to +-- managing the nested states. +-- +-- At the same time, the timer and timeout handlers seem to be well tested as +-- they are just light-weight wrappers creating the event handlers that are +-- already processed by the event queue. +-- module Simulation.Aivika.Dynamics.Agent (Agent, @@ -27,7 +34,10 @@ addTimeout, addTimer, stateActivation, - stateDeactivation) where + stateDeactivation, + setStateActivation, + setStateDeactivation, + setStateTransition) where import Data.IORef import Control.Monad @@ -55,7 +65,8 @@ stateParent :: Maybe AgentState, -- ^ Return the parent state or 'Nothing'. stateActivateRef :: IORef (Dynamics ()), - stateDeactivateRef :: IORef (Dynamics ()), + stateDeactivateRef :: IORef (Dynamics ()), + stateTransitRef :: IORef (Dynamics (Maybe AgentState)), stateVersionRef :: IORef Int } data AgentMode = CreationMode @@ -69,55 +80,70 @@ instance Eq AgentState where x == y = stateVersionRef x == stateVersionRef y -- unique references -findPath :: AgentState -> AgentState -> ([AgentState], [AgentState]) -findPath source target = - if stateAgent source == stateAgent target - then - partitionPath path1 path2 - else +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." - where - path1 = fullPath source [] - path2 = fullPath target [] - fullPath st acc = - case stateParent st of - Nothing -> st : acc - Just st' -> fullPath st' (st : acc) - 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) - -traversePath :: AgentState -> AgentState -> Dynamics () + | 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 source + 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 - -- it makes all timeout and timer handlers obsolete + -- it makes all timeout and timer handlers outdated modifyIORef (stateVersionRef st) (1 +) forM_ path2 $ \st -> do when (st == target) $ writeIORef (agentModeRef agent) InitialMode writeIORef (agentStateRef agent) (Just st) activate st p - when (st == target) $ - writeIORef (agentModeRef agent) ProcessingMode - unless (null path1 && null path2) $ - triggerAgentStateChanged p agent + 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 -- | Add to the state a timeout handler that will be actuated -- in the specified time period, while the state remains active. @@ -162,11 +188,13 @@ 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 } -- | Create a child state. @@ -176,11 +204,13 @@ 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 } -- | Create an agent bound with the specified event queue. @@ -207,7 +237,8 @@ m p -- ensure that the agent state is actual readIORef (agentStateRef agent) --- | Select the next downmost active state. +-- | Select the next downmost active state. The activation is repeated while +-- there is the transition state defined by 'setStateTransition'. activateState :: AgentState -> Dynamics () activateState st = Dynamics $ \p -> @@ -217,30 +248,23 @@ mode <- readIORef (agentModeRef agent) case mode of CreationMode -> - case stateParent st of - Just _ -> - error $ - "To run the agent for the first time, an initial state " ++ - "must be top-level: activateState." - Nothing -> - do writeIORef (agentModeRef agent) InitialMode - writeIORef (agentStateRef agent) (Just st) - Dynamics m <- readIORef (stateActivateRef st) - m p - writeIORef (agentModeRef agent) ProcessingMode - triggerAgentStateChanged p agent + do x0 <- readIORef (agentStateRef agent) + let Dynamics m = traversePath x0 st + m p InitialMode -> error $ - "Use the initState function during " ++ - "the state activation: activateState." + "Use the setStateTransition function to define " ++ + "the transition state: activateState." TransientMode -> error $ - "Use the initState function during " ++ - "the state activation: activateState." + "Use the setStateTransition function to define " ++ + "the transition state: activateState." ProcessingMode -> - do Just st0 <- readIORef (agentStateRef agent) - let Dynamics m = traversePath st0 st + do x0 @ (Just st0) <- readIORef (agentStateRef agent) + let Dynamics m = traversePath x0 st m p + +{-# DEPRECATED initState "Rewrite using the setStateTransition function instead." #-} -- | Activate the child state during the direct activation of -- the parent state. This call is ignored in other cases. @@ -257,8 +281,8 @@ "To run the agent for the fist time, use " ++ "the activateState function: initState." InitialMode -> - do Just st0 <- readIORef (agentStateRef agent) - let Dynamics m = traversePath st0 st + do x0 @ (Just st0) <- readIORef (agentStateRef agent) + let Dynamics m = traversePath x0 st m p TransientMode -> return () @@ -267,17 +291,37 @@ "Use the activateState function everywhere outside " ++ "the state activation: initState." +{-# DEPRECATED stateActivation "Use the setStateActivation function instead" #-} +{-# DEPRECATED stateDeactivation "Use the setStateDeactivation function instead" #-} + -- | Set the activation computation for the specified state. stateActivation :: AgentState -> Dynamics () -> Simulation () -stateActivation st action = +stateActivation = setStateActivation + +-- | Set the deactivation computation for the specified state. +stateDeactivation :: AgentState -> Dynamics () -> Simulation () +stateDeactivation = setStateDeactivation + +-- | Set the activation computation for the specified state. +setStateActivation :: AgentState -> Dynamics () -> Simulation () +setStateActivation st action = Simulation $ \r -> writeIORef (stateActivateRef st) action -- | Set the deactivation computation for the specified state. -stateDeactivation :: AgentState -> Dynamics () -> Simulation () -stateDeactivation st action = +setStateDeactivation :: AgentState -> Dynamics () -> Simulation () +setStateDeactivation st action = Simulation $ \r -> writeIORef (stateDeactivateRef st) action + +-- | Set the transition state which will be next and which is used only +-- when activating the state directly with help of 'activateState'. +-- If the state was activated intermediately, when activating directly +-- another state, then this computation is not used. +setStateTransition :: AgentState -> Dynamics (Maybe AgentState) -> Simulation () +setStateTransition st action = + Simulation $ \r -> + writeIORef (stateTransitRef st) action -- | Trigger the signal when the agent state changes. triggerAgentStateChanged :: Point -> Agent -> IO () diff --git a/aivika.cabal b/aivika.cabal --- a/aivika.cabal +++ b/aivika.cabal @@ -1,39 +1,72 @@ name: aivika -version: 0.5.4 +version: 0.6 synopsis: A multi-paradigm simulation library description: - Aivika is a small simulation library that covers many paradigms. - It allows integrating a system of ordinary differential equations. - Also it can be applied to the Discrete Event Simulation. It supports - the event-oriented, process-oriented and activity-oriented paradigms. - Aivika also supports the Agent-based Modeling. Finally, it can be applied - to System Dynamics. + Aivika is a multi-paradigm simulation library which has + the following features: . - It is possible due to using a very general approach when the basic - modeling entity is just a function of simulation time. The paradigms - are mainly distinguished by sets of the functions that are used to - model the activities. These sets are small and do not pretend - to be comprehensive. Aivika is mostly a proof-of-concept project - rather than a big library that knows everything. + * allows defining recursive stochastic differential equations of + System Dynamics (unordered as in maths via the recursive do-notation); . - The library widely uses monads. The dynamic system is represented as - a computation in the Dynamics monad. There is also the Process - monad to represent the discontinuous processes which can suspend - at any time and then resume later. There is also the Simulation monad - that represents a simulation run, in which scope the previous - two monads exist. Almost everything is expressed through these monads, - including the event handlers, agent handlers and even integrals - except for the parameters and statistics that already use the IO monad. + * has a basic support of the event-driven paradigm of + the Discrete Event Simulation (DES); . - The PDF documentation is available at - . - Please note that the documentation is outdated and it corresponds to - version 0.2 but it can still be helpful. + * has a basic support of the process-oriented paradigm of DES + with an ability to resume, suspend and cancel + the discontinuous processes; . - Also please look at other two my packages - and - - that complement the Aivika library. + * allows working with limited resources; + . + * supports the activity-oriented paradigm of DES; + . + * supports the basic constructs for the agent-based modeling; + . + * allows creating combined discrete-continuous models; + . + * the arrays of simulation variables are inherently supported + (this is mostly a feature of Haskell itself); + . + * supports the Monte-Carlo simulation; + . + * the simulation model can depend on external parameters; + . + * uses extensively the signals to notify the model about changing + the reference and variable values; + . + * allows gathering statistics in time points; + . + * hides the technical details in high-level simulation monads + (two of them support the recursive do-notation). + . + Aivika itself is a light-weight engine with minimal dependencies. + However, it has additional packages Aivika Experiment [1] and + Aivika Experiment Chart [2] that offer the following features: + . + * automating the simulation experiments; + . + * saving the results in CSV files; + . + * plotting the deviation chart by rule 3-sigma, histogram, + time series, XY chart; + . + * collecting the summary of statistical data; + . + * parallel execution of the Monte-Carlo simulation; + . + * have an extensible architecture. + . + All three libraries were tested on Linux, Windows and OS X. + . + Please read the PDF document An Introduction to + Aivika Simulation Library [3] for more details. + This document is included in the distributive of Aivika but + you can usually find a more recent version by the link provided. + . + \[1] + . + \[2] + . + \[3] . category: Simulation license: BSD3 diff --git a/doc/aivika.pdf b/doc/aivika.pdf Binary files a/doc/aivika.pdf and b/doc/aivika.pdf differ diff --git a/examples/BassDiffusion.hs b/examples/BassDiffusion.hs --- a/examples/BassDiffusion.hs +++ b/examples/BassDiffusion.hs @@ -53,14 +53,14 @@ definePerson :: Person -> Array Int Person -> Ref Int -> Ref Int -> Simulation () definePerson p ps potentialAdopters adopters = - do stateActivation (personPotentialAdopter p) $ + do setStateActivation (personPotentialAdopter p) $ do modifyRef potentialAdopters $ \a -> a + 1 -- add a timeout t <- liftIO $ exprnd advertisingEffectiveness let st = personPotentialAdopter p st' = personAdopter p addTimeout st t $ activateState st' - stateActivation (personAdopter p) $ + setStateActivation (personAdopter p) $ do modifyRef adopters $ \a -> a + 1 -- add a timer that works while the state is active let t = liftIO $ exprnd contactRate -- many times! @@ -71,9 +71,9 @@ when (st == Just (personPotentialAdopter p')) $ do b <- liftIO $ boolrnd adoptionFraction when b $ activateState (personAdopter p') - stateDeactivation (personPotentialAdopter p) $ + setStateDeactivation (personPotentialAdopter p) $ modifyRef potentialAdopters $ \a -> a - 1 - stateDeactivation (personAdopter p) $ + setStateDeactivation (personAdopter p) $ modifyRef adopters $ \a -> a - 1 definePersons :: Array Int Person -> Ref Int -> Ref Int -> Simulation () diff --git a/examples/FishBankRec.hs b/examples/FishBankRec.hs --- a/examples/FishBankRec.hs +++ b/examples/FishBankRec.hs @@ -15,12 +15,7 @@ model :: Simulation Double model = - mdo -- integrals -- - fish <- integ (fishHatchRate - fishDeathRate - totalCatchPerYear) 1000 - ships <- integ shipBuildingRate 10 - totalProfit <- integ annualProfit 0 - -- auxiliary values -- - let annualProfit = profit + mdo let annualProfit = profit area = 100 carryingCapacity = 1000 catchPerShip = @@ -36,7 +31,8 @@ (0.6, 5.118), (0.7, 5.247), (0.8, 5.849), (0.9, 6.151), (10.0, 6.194)] density = fish / area - fishDeathRate = maxDynamics 0 (fish * deathFraction) + fish <- integ (fishHatchRate - fishDeathRate - totalCatchPerYear) 1000 + let fishDeathRate = maxDynamics 0 (fish * deathFraction) fishHatchRate = maxDynamics 0 (fish * hatchFraction) fishPrice = 20 fractionInvested = 0.2 @@ -44,9 +40,11 @@ operatingCost = ships * 250 profit = revenue - operatingCost revenue = totalCatchPerYear * fishPrice - shipBuildingRate = maxDynamics 0 (profit * fractionInvested / shipCost) + ships <- integ shipBuildingRate 10 + let shipBuildingRate = maxDynamics 0 (profit * fractionInvested / shipCost) shipCost = 300 - totalCatchPerYear = maxDynamics 0 (ships * catchPerShip) + totalProfit <- integ annualProfit 0 + let totalCatchPerYear = maxDynamics 0 (ships * catchPerShip) -- results -- runDynamicsInStopTime annualProfit diff --git a/examples/MachRep1TimeDriven.hs b/examples/MachRep1TimeDriven.hs --- a/examples/MachRep1TimeDriven.hs +++ b/examples/MachRep1TimeDriven.hs @@ -101,7 +101,8 @@ m1 <- machine m2 <- machine - -- start the time-driven simulation of the machines through the event queue + -- start the time-driven simulation of the machines + -- through the event queue runDynamicsInStartTime $ do enqueueWithIntegTimes queue m1 enqueueWithIntegTimes queue m2 diff --git a/examples/MachRep2.hs b/examples/MachRep2.hs --- a/examples/MachRep2.hs +++ b/examples/MachRep2.hs @@ -71,10 +71,11 @@ (+ (finishUpTime - startUpTime)) -- check the resource availability - liftDynamics $ modifyRef nRep (+ 1) - n <- liftDynamics $ resourceCount repairPerson - when (n == 1) $ - liftDynamics $ modifyRef nImmedRep (+ 1) + liftDynamics $ + do modifyRef nRep (+ 1) + n <- resourceCount repairPerson + when (n == 1) $ + modifyRef nImmedRep (+ 1) requestResource repairPerson repairTime <- liftIO $ exprnd repairRate diff --git a/examples/MachRep3.hs b/examples/MachRep3.hs --- a/examples/MachRep3.hs +++ b/examples/MachRep3.hs @@ -66,10 +66,10 @@ nUp' <- liftDynamics $ readRef nUp if nUp' == 1 then passivateProcess - else do n <- liftDynamics $ - resourceCount repairPerson + else liftDynamics $ + do n <- resourceCount repairPerson when (n == 1) $ - liftDynamics $ reactivateProcess pid + reactivateProcess pid requestResource repairPerson repairTime <- liftIO $ exprnd repairRate