如何与环境交互
在仿真过程中，许多 activity 是以函数的形式作为参数传入的。这些函数可能与环境交互，比如 now 函数用来提取环境当前的时间，get_capacity 函数用于提取环境中 resource 对应的容量，get_n_generated函数用于获取生成器的状态，或者用 get_mon 函数直接收集的历史监测值。唯一需要注意的是，仿真环境必须要包含在轨迹之中，下面是一个错误示例：
library(simmer)
library(simmer.plot)
t <- trajectory() %>%
log_(function() as.character(now(env)))
env <- simmer() %>%
add_generator("dummy", t, function() 1) %>%
run(4)
#> 1: dummy0:
#> Error in now(env): object 'env' not found因为，env 是全局变量，它无法在运行时执行。仿真执行过程于仿真结果的赋值需要分开。在这个仿真用例中，环境 env 由轨迹 t 生成，可以通过 run()方法将整个过程分离开来：
t <- trajectory() %>%
log_(function() as.character(now(env)))
env <- simmer() %>%
add_generator("dummy", t, function() 1)
env %>% run(4) %>% invisible
#> 1: dummy0: 1
#> 2: dummy1: 2
#> 3: dummy2: 3我们获取了预期结果。但是，作为最佳实践的通用规则，还是 建议环境在最初单独初始化，这样可以避免不必要的错误，也使得代码更具有可读性：
# 首先，初始化环境
env <- simmer()
# 生成轨迹
t <- trajectory() %>%
log_(function() as.character(now(env)))
# 执行环境模拟过程
env %>%
add_generator("dummy", t, function() 1) %>%
run(4) %>% invisible
#> 1: dummy0: 1
#> 2: dummy1: 2
#> 3: dummy2: 3行动集合
当生成器创建一个到达流的时候, 它会给轨迹分配一个到达对象。轨迹在这里的定义是由一个到达对象在系统中全生命周期的一系列行为。一旦一个到达对象被分配到轨迹中，它通常会以一定的顺序开始执行轨迹中的预期行为，最后离开系统。比如:
patient_traj <- trajectory(name = "patient_trajectory") %>%
seize(resource = "doctor", amount = 1) %>%
timeout(task = 3) %>%
release(resource = "doctor", amount = 1)这里我们创建一个病人就医 3 分钟然后离开的例子。这是一个直截了当的例子，但是大部分轨迹相关的函数都在此基础上演化高级用法，下面会一一介绍。
此外, 建议你可以尝试下 simmer 的插件 simmer.bricks 包, 它封装了常用的一些轨迹。（见 simmer.bricks 入门）
log_()
log_(., message, level) 方法用来打印仿真过程中的信息以辅助 debug，通过不同的 level 可以调整打印的层次:
t <- trajectory() %>%
log_("this is always printed") %>% # level = 0 by default
log_("this is printed if `log_level>=1`", level = 1) %>%
log_("this is printed if `log_level>=2`", level = 2)
simmer() %>%
add_generator("dummy", t, at(0)) %>%
run() %>% invisible
#> 0: dummy0: this is always printed
simmer(log_level = 1) %>%
add_generator("dummy", t, at(0)) %>%
run() %>% invisible
#> 0: dummy0: this is always printed
#> 0: dummy0: this is printed if `log_level>=1`
simmer(log_level = Inf) %>%
add_generator("dummy", t, at(0)) %>%
run() %>% invisible
#> 0: dummy0: this is always printed
#> 0: dummy0: this is printed if `log_level>=1`
#> 0: dummy0: this is printed if `log_level>=2`set_attribute(), set_global()
set_attribute(., keys, values) 方法提供了设置到达流属性的方法。keys和 values 可以以向量或者函数的形式返回。但是，values只能够以数值型表示。
patient_traj <- trajectory(name = "patient_trajectory") %>%
set_attribute(keys = "my_key", values = 123) %>%
timeout(5) %>%
set_attribute(keys = "my_key", values = 456)
env <- simmer() %>%
add_generator("patient", patient_traj, at(0), mon = 2) %>%
run()
get_mon_attributes(env)
#> time name key value replication
#> 1 0 patient0 my_key 123 1
#> 2 5 patient0 my_key 456 1如上，轨迹的到达流在 0 时刻 (通过 at 函数实现)，仅包含 {my_key:123} 的属性。add_generator 的 参数 mon = 2表示对到达流的属性进行持续观察。我们可以用 get_mon_attributes 方法查看 my_key 对应的值在仿真过程中的变化。
如果你想要设置一个存在依赖链路的属性也是允许的。属性可以通过get_attribute(., keys) 的方式获取。下面是一个实际用例：
patient_traj <- trajectory(name = "patient_trajectory") %>%
set_attribute("my_key", 123) %>%
timeout(5) %>%
set_attribute("my_key", 1, mod="+") %>%
timeout(5) %>%
set_attribute("dependent_key", function() ifelse(get_attribute(env, "my_key")<=123, 1, 0)) %>%
timeout(5) %>%
set_attribute("independent_key", function() runif(1))
env<- simmer() %>%
add_generator("patient", patient_traj, at(0), mon = 2)
env %>% run()
#> simmer environment: anonymous | now: 15 | next:
#> {Monitor: in memory}
#> {Source: patient | monitored: 2 | n_generated: 1}
get_mon_attributes(env)
#> time name key value replication
#> 1 0 patient0 my_key 123.0000000 1
#> 2 5 patient0 my_key 124.0000000 1
#> 3 10 patient0 dependent_key 0.0000000 1
#> 4 15 patient0 independent_key 0.5500812 1对于每一次到达，属性只对于到达者可见，其余人不可见。
writer <- trajectory() %>%
set_attribute(keys = "my_key", values = 123)
reader <- trajectory() %>%
log_(function() paste0(get_attribute(env, "my_key")))
env <- simmer() %>%
add_generator("writer", writer, at(0), mon = 2) %>%
add_generator("reader", reader, at(1), mon = 2)
env %>% run()
#> 1: reader0: NA
#> simmer environment: anonymous | now: 1 | next:
#> {Monitor: in memory}
#> {Source: writer | monitored: 2 | n_generated: 1}
#> {Source: reader | monitored: 2 | n_generated: 1}
get_mon_attributes(env)
#> time name key value replication
#> 1 0 writer0 my_key 123 1因此，在前例中 reader 获取的返回值是缺失值。不过，属性也可以通过 set_global(., keys, values) 全局变量声明:
writer <- trajectory() %>%
set_global(keys = "my_key", values = 123)
reader <- trajectory() %>%
log_(function() paste0(get_attribute(env, "my_key"), ",",
get_global(env, "my_key")))
env <- simmer() %>%
add_generator("writer", writer, at(0), mon = 2) %>%
add_generator("reader", reader, at(1), mon = 2)
env %>% run()
#> 1: reader0: NA, 123
#> simmer environment: anonymous | now: 1 | next:
#> {Monitor: in memory}
#> {Source: writer | monitored: 2 | n_generated: 1}
#> {Source: reader | monitored: 2 | n_generated: 1}
get_mon_attributes(env)
#> time name key value replication
#> 1 0 my_key 123 1如上显示，全局变量通过 get_mon_attributes() 赋值未命名的键值对。
timeout(), timeout_from_attribute()
timeout(., task) 通过给轨迹分配一定的时间来延迟用户的到达行为，回顾之前最简单的病人看病模型，通过赋予 task参数一个固定值实现超时机制。
patient_traj <- trajectory(name = "patient_trajectory") %>%
timeout(task = 3)
env <- simmer() %>%
add_generator("patient", patient_traj, at(0)) %>%
run()
get_mon_arrivals(env)
#> name start_time end_time activity_time finished replication
#> 1 patient0 0 3 3 TRUE 1通常，超时是依赖于一个分布假设或者通过 属性进行设置的，它通过给 task 参数传入一个函数实现。
patient_traj <- trajectory(name = "patient_trajectory") %>%
set_attribute("health", function() sample(20:80, 1)) %>%
# distribution-based timeout
timeout(function() rexp(1, 10)) %>%
# attribute-dependent timeout
timeout(function() (100 - get_attribute(env, "health")) * 2)
env <- simmer() %>%
add_generator("patient", patient_traj, at(0), mon = 2)
env %>% run()
#> simmer environment: anonymous | now: 52.123429586641 | next:
#> {Monitor: in memory}
#> {Source: patient | monitored: 2 | n_generated: 1}
get_mon_arrivals(env)
#> name start_time end_time activity_time finished replication
#> 1 patient0 0 52.12343 52.12343 TRUE 1
get_mon_attributes(env)
#> time name key value replication
#> 1 0 patient0 health 74 1如果想通过 timeout() 方法动态地设置 task参数，需要通过回调函数的方式操作。比如 timeout(function() rexp(1, 10)),rexp(1, 10) 将被每次活动超时都执行。但是，如果你不通过回调函数方式操作，它只会以静态值的方式在初始化的时候执行一次，比如 timeout(rexp(1, 10))。
当然，通过回调函数的方式会使得代码实现复杂功能，比如同时要检查资源的状态，和环境中其他实体交互等等。同样地，对于其他活动类型，也都是可以以泛函的方式操作。
如果你只需要延迟设置属性值那么可以考虑 timeout_from_attribute(., key) 或者 timeout_from_global(., key), 因此，下面两个个超时写法是等价的，但是后者的显然简单很多。
traj <- trajectory() %>%
set_attribute("delay", 2) %>%
timeout(function() get_attribute(env, "delay")) %>%
log_("first timeout") %>%
timeout_from_attribute("delay") %>%
log_("second timeout")
env <- simmer() %>%
add_generator("dummy", traj, at(0))
env %>% run() %>% invisible
#> 2: dummy0: first timeout
#> 4: dummy0: second timeoutseize(), release()
seize(., resource, amount) 用于获取指定数量的资源。相反地，release(., resource, amount) 用于释放指定数量的资源。需要注意的是，为了使用这些函数来指定资源，你需要在模拟环境中通过 add_resource 函数来初始化。
patient_traj <- trajectory(name = "patient_trajectory") %>%
seize(resource = "doctor", amount = 1) %>%
timeout(3) %>%
release(resource = "doctor", amount = 1)
env <- simmer() %>%
add_resource("doctor", capacity=1, mon = 1) %>%
add_generator("patient", patient_traj, at(0)) %>%
run()
get_mon_resources(env)
#> resource time server queue capacity queue_size system limit replication
#> 1 doctor 0 1 0 1 Inf 1 Inf 1
#> 2 doctor 3 0 0 1 Inf 0 Inf 1这里 add_resource() 中的参数 mon=1 表示模拟环境监控资源使用情况。使用 get_mon_resources(env) 可以获取资源在仿真系统中的日志流水。
有时候，资源的获取和释放希望通过依赖的到达流属性进行动态调整。为了实现这个工恩呢该，你可以在 amount参数中传入 get_attribute(.) 来代替之前的固定值。
patient_traj <- trajectory(name = "patient_trajectory") %>%
set_attribute("health", function() sample(20:80, 1)) %>%
set_attribute("docs_to_seize", function() ifelse(get_attribute(env, "health")<50, 1, 2)) %>%
seize("doctor", function() get_attribute(env, "docs_to_seize")) %>%
timeout(3) %>%
release("doctor", function() get_attribute(env, "docs_to_seize"))
#> Warning in is.na(env[[name]]): is.na() applied to non-(list or vector) of
#> type 'closure'
#> Warning in is.na(amount): is.na() applied to non-(list or vector) of type
#> 'closure'
env <- simmer() %>%
add_resource("doctor", capacity = 2, mon = 1) %>%
add_generator("patient", patient_traj, at(0), mon = 2)
env %>% run()
#> simmer environment: anonymous | now: 3 | next:
#> {Monitor: in memory}
#> {Resource: doctor | monitored: 1 | server status: 0(2) | queue status: 0(Inf) }
#> {Source: patient | monitored: 2 | n_generated: 1}
get_mon_resources(env)
#> resource time server queue capacity queue_size system limit replication
#> 1 doctor 0 2 0 2 Inf 2 Inf 1
#> 2 doctor 3 0 0 2 Inf 0 Inf 1
get_mon_attributes(env)
#> time name key value replication
#> 1 0 patient0 health 80 1
#> 2 0 patient0 docs_to_seize 2 1默认情况下，seize() 失败会导致拒绝到达。下面的例子中，第二位病人尝试找仅有的一名正在给另外一位病人看病的医生看病，在没有等候区的情况下就会发生拒绝。
patient_traj <- trajectory(name = "patient_trajectory") %>%
log_("arriving...") %>%
seize("doctor", 1) %>%
# the second patient won't reach this point
log_("doctor seized") %>%
timeout(5) %>%
release("doctor", 1)
env <- simmer() %>%
add_resource("doctor", capacity = 1, queue_size = 0) %>%
add_generator("patient", patient_traj, at(0, 1)) %>%
run()
#> 0: patient0: arriving...
#> 0: patient0: doctor seized
#> 1: patient1: arriving...
get_mon_arrivals(env)
#> name start_time end_time activity_time finished replication
#> 1 patient1 1 1 0 FALSE 1
#> 2 patient0 0 5 5 TRUE 1
get_mon_resources(env)
#> resource time server queue capacity queue_size system limit replication
#> 1 doctor 0 1 0 1 0 1 1 1
#> 2 doctor 5 0 0 1 0 0 1 1有时，你不想拒绝不成功的seize(), 可以提供另外一条路径。比如在例子中，我们改为第二名病人也可以先去看看护士：
patient_traj <- trajectory(name = "patient_trajectory") %>%
log_("arriving...") %>%
seize("doctor", 1, continue = FALSE,
reject = trajectory("rejected patient") %>%
log_("rejected!") %>%
seize("nurse", 1) %>%
log_("nurse seized") %>%
timeout(2) %>%
release("nurse", 1)) %>%
# the second patient won't reach this point
log_("doctor seized") %>%
timeout(5) %>%
release("doctor", 1)
env <- simmer() %>%
add_resource("doctor", capacity = 1, queue_size = 0) %>%
add_resource("nurse", capacity = 10, queue_size = 0) %>%
add_generator("patient", patient_traj, at(0, 1)) %>%
run()
#> 0: patient0: arriving...
#> 0: patient0: doctor seized
#> 1: patient1: arriving...
#> 1: patient1: rejected!
#> 1: patient1: nurse seized
get_mon_arrivals(env)
#> name start_time end_time activity_time finished replication
#> 1 patient1 1 3 2 TRUE 1
#> 2 patient0 0 5 5 TRUE 1
get_mon_resources(env)
#> resource time server queue capacity queue_size system limit replication
#> 1 doctor 0 1 0 1 0 1 1 1
#> 2 nurse 1 1 0 10 0 1 10 1
#> 3 nurse 3 0 0 10 0 0 10 1
#> 4 doctor 5 0 0 1 0 0 1 1continue 标记意味着不论是否 reject发生，子轨迹都会紧跟着主轨迹执行。在这个例子中，continue=FALSE 意味着被拒绝的到达流获取护士和释放护士后就彻底结束了到达流的生命周期。否则，它将继续在主轨迹中执行行动。
注意第二位病人可能也会持续尝试，如果他执意想看这位医生。
patient_traj <- trajectory(name = "patient_trajectory") %>%
log_("arriving...") %>%
seize("doctor", 1, continue = FALSE,
reject = trajectory("rejected patient") %>%
log_("rejected!") %>%
# go for a walk and try again
timeout(2) %>%
log_("retrying...") %>%
rollback(amount = 4, times = Inf)) %>%
# the second patient will reach this point after a couple of walks
log_("doctor seized") %>%
timeout(5) %>%
release("doctor", 1) %>%
log_("leaving")
env <- simmer() %>%
add_resource("doctor", capacity = 1, queue_size = 0) %>%
add_generator("patient", patient_traj, at(0, 1)) %>%
run()
#> 0: patient0: arriving...
#> 0: patient0: doctor seized
#> 1: patient1: arriving...
#> 1: patient1: rejected!
#> 3: patient1: retrying...
#> 3: patient1: rejected!
#> 5: patient1: retrying...
#> 5: patient0: leaving
#> 5: patient1: doctor seized
#> 10: patient1: leaving
get_mon_arrivals(env)
#> name start_time end_time activity_time finished replication
#> 1 patient0 0 5 5 TRUE 1
#> 2 patient1 1 10 9 TRUE 1
get_mon_resources(env)
#> resource time server queue capacity queue_size system limit replication
#> 1 doctor 0 1 0 1 0 1 1 1
#> 2 doctor 5 0 0 1 0 0 1 1
#> 3 doctor 5 1 0 1 0 1 1 1
#> 4 doctor 10 0 0 1 0 0 1 1post.seize 是另一个可能的子轨迹选项，它在成功执行 seize() 后被执行。
patient_traj <- trajectory(name = "patient_trajectory") %>%
log_("arriving...") %>%
seize("doctor", 1, continue = c(TRUE, TRUE),
post.seize = trajectory("admitted patient") %>%
log_("admitted") %>%
timeout(5) %>%
release("doctor", 1),
reject = trajectory("rejected patient") %>%
log_("rejected!") %>%
seize("nurse", 1) %>%
timeout(2) %>%
release("nurse", 1)) %>%
# both patients will reach this point, as continue = c(TRUE, TRUE)
timeout(10) %>%
log_("leaving...")
env <- simmer() %>%
add_resource("doctor", capacity = 1, queue_size = 0) %>%
add_resource("nurse", capacity = 10, queue_size = 0) %>%
add_generator("patient", patient_traj, at(0, 1)) %>%
run()
#> 0: patient0: arriving...
#> 0: patient0: admitted
#> 1: patient1: arriving...
#> 1: patient1: rejected!
#> 13: patient1: leaving...
#> 15: patient0: leaving...
get_mon_arrivals(env)
#> name start_time end_time activity_time finished replication
#> 1 patient1 1 13 12 TRUE 1
#> 2 patient0 0 15 15 TRUE 1
get_mon_resources(env)
#> resource time server queue capacity queue_size system limit replication
#> 1 doctor 0 1 0 1 0 1 1 1
#> 2 nurse 1 1 0 10 0 1 10 1
#> 3 nurse 3 0 0 10 0 0 10 1
#> 4 doctor 5 0 0 1 0 0 1 1参考资料
https://r-simmer.org/articles…
原文作者：Iñaki Ucar, Bart Smeets 译者：Harry Zhu 英文原文地址:
https://r-simmer.org/articles…作为分享主义者 (sharism)，本人所有互联网发布的图文均遵从 CC 版权，转载请保留作者信息并注明作者 Harry Zhu 的 FinanceR 专栏:https://segmentfault.com/blog…，如果涉及源代码请注明 GitHub 地址：https://github.com/harryprince。微信号: harryzhustudio
商业使用请联系作者。