[译] 强化学习入门篇：Simmer 仿真平台高级使用技巧

如何与环境交互

在仿真过程中，许多 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 timeout

seize(), 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           1

continue 标记意味着不论是否 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           1

post.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

set_capacity(), set_queue_size()

set_capacity(., resource, value) 可以设置资源容量，set_queue_size(., resource, value) 则可以设置队列长度。注意，在使用这些函数之前，要记得在环境初始化时通过 add_resource 初始化资源，同样这里也支持静态和动态两种类型的赋值模式。

这些行为很有意思,它引入了动态变化的资源。例如,两个轨迹争取资源的能力:

set.seed(12345)

t1 <- trajectory() %>%
  seize("res1", 1) %>%
  set_capacity(resource = "res1", value = 1, mod="+") %>%
  set_capacity(resource = "res2", value = -1, mod="+") %>%
  timeout(function() rexp(1, 1)) %>%
  release("res1", 1)

t2 <- trajectory() %>%
  seize("res2", 1) %>%
  set_capacity(resource = "res2", value = 1, mod="+") %>%
  set_capacity(resource = "res1", value = -1, mod="+") %>%
  timeout(function() rexp(1, 1)) %>%
  release("res2", 1)

env <- simmer() %>%
  add_resource("res1", capacity = 20, queue_size = Inf) %>%
  add_resource("res2", capacity = 20, queue_size = Inf) %>%
  add_generator("t1_", t1, function() rexp(1, 1)) %>%
  add_generator("t2_", t2, function() rexp(1, 1)) %>%
  run(100)

plot(get_mon_resources(env), "usage", c("res1", "res2"), steps = TRUE)

select()

当资源在环境中事先分配时，seize(), release(), set_capacity() 和 set_queue_size() 可以顺利使用，但有时候资源也需要通过一些策略动态选择。比如下面的情况，select(., resources, policy, id)方法提供了选择资源的一种方法，根据特定策略来选择：
seize_selected(), release_selected(),set_capacity_selected(),set_queue_size_selected()。

patient_traj <- trajectory(name = "patient_trajectory") %>%
  select(resources = c("doctor1", "doctor2", "doctor3"), policy = "round-robin") %>%
  set_capacity_selected(1) %>%
  seize_selected(amount = 1) %>%
  timeout(5) %>%
  release_selected(amount = 1)

env <- simmer() %>%
  add_resource("doctor1", capacity = 0) %>%
  add_resource("doctor2", capacity = 0) %>%
  add_resource("doctor3", capacity = 0) %>%
  add_generator("patient", patient_traj, at(0, 1, 2)) %>%
  run()

get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 patient0          0        5             5     TRUE           1
#> 2 patient1          1        6             5     TRUE           1
#> 3 patient2          2        7             5     TRUE           1
get_mon_resources(env)
#>   resource time server queue capacity queue_size system limit replication
#> 1  doctor1    0      0     0        1        Inf      0   Inf           1
#> 2  doctor1    0      1     0        1        Inf      1   Inf           1
#> 3  doctor2    1      0     0        1        Inf      0   Inf           1
#> 4  doctor2    1      1     0        1        Inf      1   Inf           1
#> 5  doctor3    2      0     0        1        Inf      0   Inf           1
#> 6  doctor3    2      1     0        1        Inf      1   Inf           1
#> 7  doctor1    5      0     0        1        Inf      0   Inf           1
#> 8  doctor2    6      0     0        1        Inf      0   Inf           1
#> 9  doctor3    7      0     0        1        Inf      0   Inf           1

如果你提供给 select()提供一组动态的资源，那么后续可以通过 seize_selected()调整获取资源的策略。

patient_traj <- trajectory(name = "patient_trajectory") %>%
  set_attribute("resource", function() sample(1:3, 1)) %>%
  select(resources = function() paste0("doctor", get_attribute(env, "resource"))) %>%
  seize_selected(amount = 1) %>%
  timeout(5) %>%
  release_selected(amount = 1)

env <- simmer() %>%
  add_resource("doctor1", capacity = 1) %>%
  add_resource("doctor2", capacity = 1) %>%
  add_resource("doctor3", capacity = 1) %>%
  add_generator("patient", patient_traj, at(0, 1, 2), mon = 2)
env %>% run()
#> simmer environment: anonymous | now: 10 | next: 
#> { Monitor: in memory }
#> { Resource: doctor1 | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
#> { Resource: doctor2 | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
#> { Resource: doctor3 | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
#> { Source: patient | monitored: 2 | n_generated: 3 }

get_mon_attributes(env)
#>   time     name      key value replication
#> 1    0 patient0 resource     3           1
#> 2    1 patient1 resource     3           1
#> 3    2 patient2 resource     2           1
get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 patient0          0        5             5     TRUE           1
#> 2 patient2          2        7             5     TRUE           1
#> 3 patient1          1       10             5     TRUE           1
get_mon_resources(env)
#>   resource time server queue capacity queue_size system limit replication
#> 1  doctor3    0      1     0        1        Inf      1   Inf           1
#> 2  doctor3    1      1     1        1        Inf      2   Inf           1
#> 3  doctor2    2      1     0        1        Inf      1   Inf           1
#> 4  doctor3    5      1     0        1        Inf      1   Inf           1
#> 5  doctor2    7      0     0        1        Inf      0   Inf           1
#> 6  doctor3   10      0     0        1        Inf      0   Inf           1

activate(), deactivate()

activate(., source)和deactivate(., source) 方法能够分别按照ID来开始和暂停活动。这个名字可以提供一个字符串或一个函数返回一个字符串。在以下简单的例子中,使用这些方法通过设置固定的时间间隔 1 来体现：

t <- trajectory() %>%
  deactivate(source = "dummy") %>%
  timeout(1) %>%
  activate(source = "dummy")

simmer() %>%
  add_generator("dummy", t, function() 1) %>%
  run(10) %>%
  get_mon_arrivals()
#>     name start_time end_time activity_time finished replication
#> 1 dummy0          1        2             1     TRUE           1
#> 2 dummy1          3        4             1     TRUE           1
#> 3 dummy2          5        6             1     TRUE           1
#> 4 dummy3          7        8             1     TRUE           1

set_trajectory(), set_source()

set_trajectory(., source, trajectory)和 set_source(., source, object) 方法提供了单独地轨迹切换的方法。 source 可以是一个固定的字符串ID也可以通过函数动态生成字符串ID。

在下面的分布中，t2 切换分布到 t1，t2 只有首次到达时被执行。

t1 <- trajectory() %>%
  timeout(1)

t2 <- trajectory() %>%
  set_source("dummy", function() 1) %>%
  set_trajectory("dummy", t1) %>%
  timeout(2)

simmer() %>%
  add_generator("dummy", trajectory = t2, distribution = function() 2) %>%
  run(10) %>%
  get_mon_arrivals()
#>     name start_time end_time activity_time finished replication
#> 1 dummy0          2        4             2     TRUE           1
#> 2 dummy1          3        4             1     TRUE           1
#> 3 dummy2          4        5             1     TRUE           1
#> 4 dummy3          5        6             1     TRUE           1
#> 5 dummy4          6        7             1     TRUE           1
#> 6 dummy5          7        8             1     TRUE           1
#> 7 dummy6          8        9             1     TRUE           1

set_prioritization()

add_generator() 通过给到达流赋予优先级的方式控制。set_prioritization(., values)和 get_prioritization(.) 方法可以在轨迹中的任意一个节点中改变/获取优先级。

  set_attribute("priority", 3) %>%
  # static values
  set_prioritization(values = c(3, 7, TRUE)) %>%
  # dynamically with a function
  set_prioritization(values = function() {
    prio <- get_prioritization(env)
    attr <- get_attribute(env, "priority")
    c(attr, prio[[2]]+1, FALSE)
  })

branch()

The branch(., option, continue, ...) 提供在轨迹中️以一定概率添加替代路径的方法。下面的例子显示一个到达在轨迹中被随机分叉：

t1 <- trajectory("trajectory with a branch") %>%
  seize("server", 1) %>%
  branch(option = function() sample(1:2, 1), continue = c(T, F), 
         trajectory("branch1") %>%
           timeout(function() 1),
         trajectory("branch2") %>%
           timeout(function() rexp(1, 3)) %>%
           release("server", 1)
  ) %>%
  release("server", 1)

当到达流被分叉，第一个参数 option 是用来传后续的具体路径的概率值，因此它必须是可执行的，返回值需要是在1到n条路径之间。第二个参数 continue 表示在选择路径后是否到达必须继续执行活动。上述例子中，只有第一个路径会走到最后的 release() 流程。

有时，你可能需要统计一条确定轨迹在一个确定的分支上进入多少次，或者到达流进入那条轨迹花费了多少时间。对于这种场景，处于计数需求，可以资源容量设置为无限，如下举例：

t0 <- trajectory() %>%
  branch(function() sample(c(1, 2), 1), continue = c(T, T),
         trajectory() %>%
           seize("branch1", 1) %>%
           # do stuff here
           timeout(function() rexp(1, 1)) %>%
           release("branch1", 1),
         trajectory() %>%
           seize("branch2", 1) %>%
           # do stuff here
           timeout(function() rexp(1, 1/2)) %>%
           release("branch2", 1))

env <- simmer() %>%
  add_generator("dummy", t0, at(rep(0, 1000))) %>%
  # Resources with infinite capacity, just for accounting purposes
  add_resource("branch1", Inf) %>%
  add_resource("branch2", Inf) %>%
  run()

arrivals <- get_mon_arrivals(env, per_resource = T)

# Times that each branch was entered
table(arrivals$resource)
#> 
#> branch1 branch2 
#>     496     504

# The `activity_time` is the total time inside each branch for each arrival
# Let's see the distributions
ggplot(arrivals) + geom_histogram(aes(x=activity_time)) + facet_wrap(~resource)

rollback()

rollback(., amount, times, check) 回滚方法允许到达流轨迹回滚若干步，比如一个字符串在超时函数中被打印出来，在第一次执行后，轨迹再回滚3次（因此总共打印 "Hello" 4次）。

t0 <- trajectory() %>%
  log_("Hello!") %>%
  timeout(1) %>%
  rollback(amount = 2, times = 3)

simmer() %>%
  add_generator("hello_sayer", t0, at(0)) %>% 
  run() %>% invisible
#> 0: hello_sayer0: Hello!
#> 1: hello_sayer0: Hello!
#> 2: hello_sayer0: Hello!
#> 3: hello_sayer0: Hello!

rollback() 方法也接受一个选项 check 来覆盖默认的基于数值的行为。该方法可以传入一个返回逻辑值的函数。每次一个到达接收到活动，check 都会判断一下是否以指定步长调用 rollback()回滚：

t0 <- trajectory() %>%
  set_attribute("happiness", 0) %>%
  log_(function() {
    level <- get_attribute(env, "happiness")
    paste0(">> Happiness level is at: ", level, " -- ", 
           ifelse(level<25,"PETE: I'm feeling crappy...",
                  ifelse(level<50,"PETE: Feelin' a bit moody",
                         ifelse(level<75,"PETE: Just had a good espresso",
                                "PETE: Let's do this! (and stop this loop...)"))))
  }) %>%
  set_attribute("happiness", 25, mod="+") %>%
  rollback(amount = 2, check = function() get_attribute(env, "happiness") < 100)

env <- simmer() %>%
  add_generator("mood_swinger", t0, at(0))
env %>% run() %>% invisible()
#> 0: mood_swinger0: >> Happiness level is at: 0 -- PETE: I'm feeling crappy...
#> 0: mood_swinger0: >> Happiness level is at: 25 -- PETE: Feelin' a bit moody
#> 0: mood_swinger0: >> Happiness level is at: 50 -- PETE: Just had a good espresso
#> 0: mood_swinger0: >> Happiness level is at: 75 -- PETE: Let's do this! (and stop this loop...)

leave()

leave(., prob) 允许一个到达以一定概率离开整个轨迹：

patient_traj <- trajectory(name = "patient_trajectory") %>%
  seize("nurse", 1) %>%
  timeout(3) %>%
  release("nurse", 1) %>%
  log_("before leave") %>%
  leave(prob = 1) %>%
  log_("after leave") %>%
  # patients will never seize the doctor
  seize("doctor", 1) %>%
  timeout(3) %>%
  release("doctor", 1)

env <- simmer() %>%
  add_resource("nurse", capacity=1) %>%
  add_resource("doctor", capacity=1) %>%
  add_generator("patient", patient_traj, at(0)) %>%
  run()
#> 3: patient0: before leave

get_mon_resources(env)
#>   resource time server queue capacity queue_size system limit replication
#> 1    nurse    0      1     0        1        Inf      1   Inf           1
#> 2    nurse    3      0     0        1        Inf      0   Inf           1

当然, 概率也可以动态调整:

set.seed(1234)

patient_traj <- trajectory(name = "patient_trajectory") %>%
  seize("nurse", 1) %>%
  timeout(3) %>%
  release("nurse", 1) %>%
  log_("before leave") %>%
  leave(prob = function() runif(1) < 0.5) %>%
  log_("after leave") %>%
  # some patients will seize the doctor
  seize("doctor", 1) %>%
  timeout(3) %>%
  release("doctor", 1)

env <- simmer() %>%
  add_resource("nurse", capacity=1) %>%
  add_resource("doctor", capacity=1) %>%
  add_generator("patient", patient_traj, at(0, 1)) %>%
  run()
#> 3: patient0: before leave
#> 6: patient1: before leave
#> 6: patient1: after leave

get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 patient0          0        3             3    FALSE           1
#> 2 patient1          1        9             6     TRUE           1
get_mon_resources(env)
#>   resource time server queue capacity queue_size system limit replication
#> 1    nurse    0      1     0        1        Inf      1   Inf           1
#> 2    nurse    1      1     1        1        Inf      2   Inf           1
#> 3    nurse    3      1     0        1        Inf      1   Inf           1
#> 4    nurse    6      0     0        1        Inf      0   Inf           1
#> 5   doctor    6      1     0        1        Inf      1   Inf           1
#> 6   doctor    9      0     0        1        Inf      0   Inf           1

clone(), synchronize()

clone(., n, ...) 提供复制 n-1 次到达概率的方法来并行处理子轨迹。
synchronize(., wait, mon_all) 提供同步的方法来去除副本。默认，synchronize() 等待所有副本到达并且允许最后一个继续执行：

t <- trajectory() %>%
  clone(n = 3,
        trajectory("original") %>%
          timeout(1),
        trajectory("clone 1") %>%
          timeout(2),
        trajectory("clone 2") %>%
          timeout(3)) %>%
  synchronize(wait = TRUE) %>%
  timeout(0.5)

env <- simmer(verbose = TRUE) %>%
  add_generator("arrival", t, at(0)) %>%
  run()
#>          0 |    source: arrival          |       new: arrival0         | 0
#>          0 |   arrival: arrival0         |  activity: Clone            | 3, 3 paths
#>          0 |   arrival: arrival0         |  activity: Timeout          | 1
#>          0 |   arrival: arrival0         |  activity: Timeout          | 2
#>          0 |   arrival: arrival0         |  activity: Timeout          | 3
#>          1 |   arrival: arrival0         |  activity: Synchronize      | 1
#>          2 |   arrival: arrival0         |  activity: Synchronize      | 1
#>          3 |   arrival: arrival0         |  activity: Synchronize      | 1
#>          3 |   arrival: arrival0         |  activity: Timeout          | 0.5

get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 arrival0          0      3.5           3.5     TRUE           1

注意，参数 n 也可以是一个函数，如果有子轨迹需要clone，那么重复的子轨迹不需要反复声明。如果子轨迹数量小于 clone 数量，部分clone将直接继续下一个行动：

t <- trajectory() %>%
  clone(n = 3,
        trajectory("original") %>%
          timeout(1),
        trajectory("clone 1") %>%
          timeout(2)) %>%
  synchronize(wait = TRUE) %>%
  timeout(0.5)

env <- simmer(verbose = TRUE) %>%
  add_generator("arrival", t, at(0)) %>%
  run()
#>          0 |    source: arrival          |       new: arrival0         | 0
#>          0 |   arrival: arrival0         |  activity: Clone            | 3, 2 paths
#>          0 |   arrival: arrival0         |  activity: Timeout          | 1
#>          0 |   arrival: arrival0         |  activity: Timeout          | 2
#>          0 |   arrival: arrival0         |  activity: Synchronize      | 1
#>          1 |   arrival: arrival0         |  activity: Synchronize      | 1
#>          2 |   arrival: arrival0         |  activity: Synchronize      | 1
#>          2 |   arrival: arrival0         |  activity: Timeout          | 0.5

get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 arrival0          0      2.5           2.5     TRUE           1

如果预期为弱依赖，希望最快完成副本任务，那么 synchronize() 可以设置 wait = FALSE:

t <- trajectory() %>%
  clone(n = 3,
        trajectory("original") %>%
          timeout(1),
        trajectory("clone 1") %>%
          timeout(2),
        trajectory("clone 2") %>%
          timeout(3)) %>%
  synchronize(wait = FALSE) %>%
  timeout(0.5)

env <- simmer(verbose = TRUE) %>%
  add_generator("arrival", t, at(0)) %>%
  run()
#>          0 |    source: arrival          |       new: arrival0         | 0
#>          0 |   arrival: arrival0         |  activity: Clone            | 3, 3 paths
#>          0 |   arrival: arrival0         |  activity: Timeout          | 1
#>          0 |   arrival: arrival0         |  activity: Timeout          | 2
#>          0 |   arrival: arrival0         |  activity: Timeout          | 3
#>          1 |   arrival: arrival0         |  activity: Synchronize      | 0
#>          1 |   arrival: arrival0         |  activity: Timeout          | 0.5
#>          2 |   arrival: arrival0         |  activity: Synchronize      | 0
#>          3 |   arrival: arrival0         |  activity: Synchronize      | 0

get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 arrival0          0      1.5           1.5     TRUE           1

synchronize() 默认不记录被移除的 clone信息 (mon_all=FALSE)，但是如果需要可以通过修改 mon_all=TRUE 来实现:

t <- trajectory() %>%
  clone(n = 3,
        trajectory("original") %>%
          timeout(1),
        trajectory("clone 1") %>%
          timeout(2),
        trajectory("clone 2") %>%
          timeout(3)) %>%
  synchronize(wait = FALSE, mon_all = TRUE) %>%
  timeout(0.5)

env <- simmer(verbose = TRUE) %>%
  add_generator("arrival", t, at(0)) %>%
  run()
#>          0 |    source: arrival          |       new: arrival0         | 0
#>          0 |   arrival: arrival0         |  activity: Clone            | 3, 3 paths
#>          0 |   arrival: arrival0         |  activity: Timeout          | 1
#>          0 |   arrival: arrival0         |  activity: Timeout          | 2
#>          0 |   arrival: arrival0         |  activity: Timeout          | 3
#>          1 |   arrival: arrival0         |  activity: Synchronize      | 0
#>          1 |   arrival: arrival0         |  activity: Timeout          | 0.5
#>          2 |   arrival: arrival0         |  activity: Synchronize      | 0
#>          3 |   arrival: arrival0         |  activity: Synchronize      | 0

get_mon_arrivals(env)
#>       name start_time end_time activity_time finished replication
#> 1 arrival0          0      1.5           1.5     TRUE           1
#> 2 arrival0          0      2.0           2.0     TRUE           1
#> 3 arrival0          0      3.0           3.0     TRUE           1

batch(), separate()

batch(., n, timeout, permanent, name, rule) 提供以一定概率收集一定数量的到达流后批量处理的方法。然后，通过 separate(.) 方法来分离之前建立的临时批次。这允许我们实现一个过山车过程，举例：

有一个10人座的过山车，队列是20人排队参与，每次玩过山车持续5分钟，我们可以将问题按如下方式建模：

set.seed(1234)

t <- trajectory() %>%
  batch(10, timeout = 5, permanent = FALSE) %>%
  seize("rollercoaster", 1) %>%
  timeout(5) %>%
  release("rollercoaster", 1) %>%
  separate()

env <- simmer() %>%
  # capacity and queue_size are defined in batches of 10
  add_resource("rollercoaster", capacity = 1, queue_size = 2) %>%
  add_generator("person", t, function() rexp(1, 2)) %>%
  run(15)

get_mon_arrivals(env, per_resource = TRUE)
#>        name start_time  end_time activity_time      resource replication
#> 1   person0   3.800074  8.800074             5 rollercoaster           1
#> 2   person1   3.800074  8.800074             5 rollercoaster           1
#> 3   person2   3.800074  8.800074             5 rollercoaster           1
#> 4   person3   3.800074  8.800074             5 rollercoaster           1
#> 5   person4   3.800074  8.800074             5 rollercoaster           1
#> 6   person5   3.800074  8.800074             5 rollercoaster           1
#> 7   person6   3.800074  8.800074             5 rollercoaster           1
#> 8   person7   3.800074  8.800074             5 rollercoaster           1
#> 9   person8   3.800074  8.800074             5 rollercoaster           1
#> 10  person9   3.800074  8.800074             5 rollercoaster           1
#> 11 person10   8.800074 13.800074             5 rollercoaster           1
#> 12 person11   8.800074 13.800074             5 rollercoaster           1
#> 13 person12   8.800074 13.800074             5 rollercoaster           1
#> 14 person13   8.800074 13.800074             5 rollercoaster           1
#> 15 person14   8.800074 13.800074             5 rollercoaster           1
#> 16 person15   8.800074 13.800074             5 rollercoaster           1

这里创建了 3 个批次，前10个人都是在3.8分钟同时上车的。然后在第一波游玩结束时, 只有6个人在等待，但是 batch() 设置的计时器 timeout=5 已经到时了，另外一波游客就可以发动了。因为这个 batch设置了 (permanent=FALSE)，所以可以用 separate() 方法将队列切开。

当然具体的rule参数也可以用更精细粒度的选择哪些游客需要被组成一个批次。对于每个特定的到达，默认都是一 rule = TRUE 返回。上面的例子，也可以通过 rule = FALSE，避免和其他乘客同时玩一个过山车。

t_batch <- trajectory() %>%
  batch(10, timeout = 5, permanent = FALSE, rule = function() FALSE) %>%
  seize("rollercoaster", 1) %>%
  timeout(5) %>%
  release("rollercoaster", 1) %>%
  separate()

t_nobatch <- trajectory() %>%
  seize("rollercoaster", 1) %>%
  timeout(5) %>%
  release("rollercoaster", 1)

set.seed(1234)

env_batch <- simmer() %>%
  # capacity and queue_size are defined in batches of 10
  add_resource("rollercoaster", capacity = 1, queue_size = 2) %>%
  add_generator("person", t_batch, function() rexp(1, 2)) %>%
  run(15)

set.seed(1234)

env_nobatch <- simmer() %>%
  # capacity and queue_size are defined in batches of 10
  add_resource("rollercoaster", capacity = 1, queue_size = 2) %>%
  add_generator("person", t_nobatch, function() rexp(1, 2)) %>%
  run(15)

get_mon_arrivals(env_batch, per_resource = TRUE)
#>      name start_time  end_time activity_time      resource replication
#> 1 person0   1.250879  6.250879             5 rollercoaster           1
#> 2 person1   1.374259 11.250879             5 rollercoaster           1
get_mon_arrivals(env_nobatch, per_resource = TRUE)
#>      name start_time  end_time activity_time      resource replication
#> 1 person0   1.250879  6.250879             5 rollercoaster           1
#> 2 person1   1.374259 11.250879             5 rollercoaster           1

默认，批次的 name 参数为空，它表示每个乘客是独立的，但是，有趣的是怎么给不同轨迹赋予相同批次。比如，我们可以尝试：

t0 <- trajectory() %>%
  batch(2) %>%
  timeout(2) %>%
  separate()

t1 <- trajectory() %>%
  timeout(1) %>%
  join(t0)

env <- simmer(verbose = TRUE) %>%
  add_generator("t0_", t0, at(0)) %>%
  add_generator("t1_", t1, at(0)) %>%
  run()
#>          0 |    source: t0_              |       new: t0_0             | 0
#>          0 |   arrival: t0_0             |  activity: Batch            | 2, 0, 0, 
#>          0 |    source: t1_              |       new: t1_0             | 0
#>          0 |   arrival: t1_0             |  activity: Timeout          | 1
#>          1 |   arrival: t1_0             |  activity: Batch            | 2, 0, 0,

get_mon_arrivals(env)
#> [1] name          start_time    end_time      activity_time finished     
#> <0 rows> (or 0-length row.names)

我们没有获得预期的两个不同批次结果。t1 紧跟着 t0 到达，则意味着实际情况是下面这样：

t0 <- trajectory() %>%
  batch(2) %>%
  timeout(2) %>%
  separate()

t1 <- trajectory() %>%
  timeout(1) %>%
  batch(2) %>%
  timeout(2) %>%
  separate()

因此到达流紧随着一个不同轨迹将终止在一个不同批次上。除非，有一个方法共享 batch()的行动，现在可以通过 name 参数实现。

t0 <- trajectory() %>%
  batch(2, name = "mybatch") %>%
  timeout(2) %>%
  separate()

t1 <- trajectory() %>%
  timeout(1) %>%
  batch(2, name = "mybatch") %>%
  timeout(2) %>%
  separate()

env <- simmer(verbose = TRUE) %>%
  add_generator("t0_", t0, at(0)) %>%
  add_generator("t1_", t1, at(0)) %>%
  run()
#>          0 |    source: t0_              |       new: t0_0             | 0
#>          0 |   arrival: t0_0             |  activity: Batch            | 2, 0, 0, mybatch
#>          0 |    source: t1_              |       new: t1_0             | 0
#>          0 |   arrival: t1_0             |  activity: Timeout          | 1
#>          1 |   arrival: t1_0             |  activity: Batch            | 2, 0, 0, mybatch
#>          1 |   arrival: batch_mybatch    |  activity: Timeout          | 2
#>          3 |   arrival: batch_mybatch    |  activity: Separate         |

get_mon_arrivals(env)
#>   name start_time end_time activity_time finished replication
#> 1 t0_0          0        3             2     TRUE           1
#> 2 t1_0          0        3             3     TRUE           1
Or, equivalently,

t0 <- trajectory() %>%
  batch(2, name = "mybatch") %>%
  timeout(2) %>%
  separate()

t1 <- trajectory() %>%
  timeout(1) %>%
  join(t0)

env <- simmer(verbose = TRUE) %>%
  add_generator("t0_", t0, at(0)) %>%
  add_generator("t1_", t1, at(0)) %>%
  run()
#>          0 |    source: t0_              |       new: t0_0             | 0
#>          0 |   arrival: t0_0             |  activity: Batch            | 2, 0, 0, mybatch
#>          0 |    source: t1_              |       new: t1_0             | 0
#>          0 |   arrival: t1_0             |  activity: Timeout          | 1
#>          1 |   arrival: t1_0             |  activity: Batch            | 2, 0, 0, mybatch
#>          1 |   arrival: batch_mybatch    |  activity: Timeout          | 2
#>          3 |   arrival: batch_mybatch    |  activity: Separate         |

get_mon_arrivals(env)
#>   name start_time end_time activity_time finished replication
#> 1 t0_0          0        3             2     TRUE           1
#> 2 t1_0          0        3             3     TRUE           1

send(), trap(), untrap(), wait()

这组行动允许异步编程。通过 send(., signals, delay) 广播一个或者一组信号给到每个订阅信息的到达流。信号可以立即被触发：

t <- trajectory() %>%
  send(signals = c("signal1", "signal2"))

simmer(verbose = TRUE) %>%
  add_generator("signaler", t, at(0)) %>%
  run() %>% invisible
#>          0 |    source: signaler         |       new: signaler0        | 0
#>          0 |   arrival: signaler0        |  activity: Send             | [signal1, signal2], 0
#>          0 |      task: Broadcast        |          :                  |

或者安排在一些延迟之后：

t <- trajectory() %>%
  send(signals = c("signal1", "signal2"), delay = 3)

simmer(verbose = TRUE) %>%
  add_generator("signaler", t, at(0)) %>%
  run() %>% invisible
#>          0 |    source: signaler         |       new: signaler0        | 0
#>          0 |   arrival: signaler0        |  activity: Send             | [signal1, signal2], 3
#>          3 |      task: Broadcast        |          :                  |

注意,这两个参数,signals和delay,可以是函数,因此他们可以从到达流中获取的属性值。

如果无人监听，广播其实没意义。到达流订阅广播然后可以用 trap(., signals, handler, interruptible) 来赋予一个处理器。在下面的例子中，一个到达流订阅一个信号并且阻塞知道收到 wait(.) 方法。

t_blocked <- trajectory() %>%
  trap("you shall pass") %>%
  log_("waiting...") %>%
  wait() %>%
  log_("continuing!")

t_signaler <- trajectory() %>%
  log_("you shall pass") %>%
  send("you shall pass")

simmer() %>%
  add_generator("blocked", t_blocked, at(0)) %>%
  add_generator("signaler", t_signaler, at(5)) %>%
  run() %>% invisible
#> 0: blocked0: waiting...
#> 5: signaler0: you shall pass
#> 5: blocked0: continuing!

注意信号可以被忽略，当到达流是在资源队列中等待。相同的操作也可以在批处理中执行：所有在进入批次之前的被订阅信息都将被忽略。因此，下面的批次将被无限阻塞：

t_blocked <- trajectory() %>%
  trap("you shall pass") %>%
  log_("waiting inside a batch...") %>%
  batch(1) %>%
  wait() %>%
  log_("continuing!")

t_signaler <- trajectory() %>%
  log_("you shall pass") %>%
  send("you shall pass")

simmer() %>%
  add_generator("blocked", t_blocked, at(0)) %>%
  add_generator("signaler", t_signaler, at(5)) %>%
  run() %>% invisible
#> 0: blocked0: waiting inside a batch...
#> 5: signaler0: you shall pass
#> inf: batch0: continuing!

在接收信号,停止当前活动并执行处理程序提供。然后,执行后返回到活动中断的点:

t_worker <- trajectory() %>%
  trap("you are free to go", 
       handler = trajectory() %>%
         log_("ok, I'm packing...") %>%
         timeout(1)
  ) %>%
  log_("performing a looong task...") %>%
  timeout(100) %>%
  log_("and I'm leaving!")

t_signaler <- trajectory() %>%
  log_("you are free to go") %>%
  send("you are free to go")

simmer() %>%
  add_generator("worker", t_worker, at(0)) %>%
  add_generator("signaler", t_signaler, at(5)) %>%
  run() %>% invisible
#> 0: worker0: performing a looong task...
#> 5: signaler0: you are free to go
#> 5: worker0: ok, I'm packing...
#> 6: worker0: and I'm leaving!

最后，untrap(., signals) 来根据 signals 执行退订：

t_worker <- trajectory() %>%
  trap("you are free to go", 
       handler = trajectory() %>%
         log_("ok, I'm packing...") %>%
         timeout(1)
  ) %>%
  log_("performing a looong task...") %>%
  untrap("you are free to go") %>%
  timeout(100) %>%
  log_("and I'm leaving!")

t_signaler <- trajectory() %>%
  log_("you are free to go") %>%
  send("you are free to go")

simmer() %>%
  add_generator("worker", t_worker, at(0)) %>%
  add_generator("signaler", t_signaler, at(5)) %>%
  run() %>% invisible
#> 0: worker0: performing a looong task...
#> 5: signaler0: you are free to go
#> 100: worker0: and I'm leaving!

Signal 处理器默认是可以被打断，这意味着如果有大量频繁的请求信号，处理器会反复重启：

t_worker <- trajectory() %>%
  trap("you are free to go", 
       handler = trajectory() %>%
         log_("ok, I'm packing...") %>%
         timeout(1)
  ) %>%
  log_("performing a looong task...") %>%
  timeout(100) %>%
  log_("and I'm leaving!")

t_signaler <- trajectory() %>%
  log_("you are free to go") %>%
  send("you are free to go")

simmer() %>%
  add_generator("worker", t_worker, at(0)) %>%
  add_generator("signaler", t_signaler, from(5, function() 0.5)) %>%
  run(10) %>% invisible
#> 0: worker0: performing a looong task...
#> 5: signaler0: you are free to go
#> 5: worker0: ok, I'm packing...
#> 5.5: signaler1: you are free to go
#> 5.5: worker0: ok, I'm packing...
#> 6: signaler2: you are free to go
#> 6: worker0: ok, I'm packing...
#> 6.5: signaler3: you are free to go
#> 6.5: worker0: ok, I'm packing...
#> 7: signaler4: you are free to go
#> 7: worker0: ok, I'm packing...
#> 7.5: signaler5: you are free to go
#> 7.5: worker0: ok, I'm packing...
#> 8: signaler6: you are free to go
#> 8: worker0: ok, I'm packing...
#> 8.5: signaler7: you are free to go
#> 8.5: worker0: ok, I'm packing...
#> 9: signaler8: you are free to go
#> 9: worker0: ok, I'm packing...
#> 9.5: signaler9: you are free to go
#> 9.5: worker0: ok, I'm packing...

如果需要实现一个不能打断的处理器，可以通过设置合适的 flag 实现：

t_worker <- trajectory() %>%
  trap("you are free to go", 
       handler = trajectory() %>%
         log_("ok, I'm packing...") %>%
         timeout(1),
       interruptible = FALSE            # make it uninterruptible
  ) %>%
  log_("performing a looong task...") %>%
  timeout(100) %>%
  log_("and I'm leaving!")

t_signaler <- trajectory() %>%
  log_("you are free to go") %>%
  send("you are free to go")

simmer() %>%
  add_generator("worker", t_worker, at(0)) %>%
  add_generator("signaler", t_signaler, from(5, function() 0.5)) %>%
  run(10) %>% invisible
#> 0: worker0: performing a looong task...
#> 5: signaler0: you are free to go
#> 5: worker0: ok, I'm packing...
#> 5.5: signaler1: you are free to go
#> 6: worker0: and I'm leaving!
#> 6: signaler2: you are free to go
#> 6.5: signaler3: you are free to go
#> 7: signaler4: you are free to go
#> 7.5: signaler5: you are free to go
#> 8: signaler6: you are free to go
#> 8.5: signaler7: you are free to go
#> 9: signaler8: you are free to go
#> 9.5: signaler9: you are free to go

renege_in(), renege_if(), renege_abort()

renege_in(., t, out) 方法提供设置超时时间来出发到达流放弃轨迹的退出机制。中途退出后，到达流可以选择从一个子轨迹中出去。renege_abort(.) 方法提供了一个反悔机制。这些方法允许我们做一些事情，比如，建立有限病人的模型。下面的例子中，用户 到达银行，只有一个职员处于服务态。 客服在等待5分钟后如果还不能服务可以选择离开。

t <- trajectory(name = "bank") %>%
  log_("Here I am") %>%
  # renege in 5 minutes
  renege_in(5, 
            out = trajectory() %>%
              log_("Lost my patience. Reneging...")
  ) %>%
  seize("clerk", 1) %>%
  # stay if I'm being attended within 5 minutes
  renege_abort() %>%
  log_("I'm being attended") %>%
  timeout(10) %>%
  release("clerk", 1) %>%
  log_("Finished")

simmer() %>%
  add_resource("clerk", 1) %>%
  add_generator("customer", t, at(0, 1)) %>%
  run() %>% invisible
#> 0: customer0: Here I am
#> 0: customer0: I'm being attended
#> 1: customer1: Here I am
#> 6: customer1: Lost my patience. Reneging...
#> 10: customer0: Finished

同样也可以通过 renege_if(., signal, out) 实现，假设 在 t=5时刻， customer0 发送一个消息给 customer1:

t <- trajectory(name = "bank") %>%
  log_("Here I am") %>%
  # renege when "renege now" is received
  renege_if("renege now", 
            out = trajectory() %>%
              log_("Ok. Reneging...")
  ) %>%
  seize("clerk", 1) %>%
  # stay if I'm being attended within 5 minutes
  renege_abort() %>%
  log_("I'm being attended") %>%
  timeout(5) %>%
  log_("I say: renege now") %>%
  send("renege now") %>%
  timeout(5) %>%
  release("clerk", 1) %>%
  log_("Finished")

simmer() %>%
  add_resource("clerk", 1) %>%
  add_generator("customer", t, at(0, 1)) %>%
  run() %>% invisible
#> 0: customer0: Here I am
#> 0: customer0: I'm being attended
#> 1: customer1: Here I am
#> 5: customer0: I say: renege now
#> 5: customer1: Ok. Reneging...
#> 10: customer0: Finished

注意，和 trap() 不同的是, reneg* 是直接被触发的，即使到达流还在队列或者临时批次中。

轨迹工具箱: joining 和 subsetting

join()

join(...) 将任意多个轨迹聚合，比如：

t1 <- trajectory() %>% seize("dummy", 1)
t2 <- trajectory() %>% timeout(1)
t3 <- trajectory() %>% release("dummy", 1)

t0 <- join(t1, t2, t3)
t0
#> trajectory: anonymous, 3 activities
#> { Activity: Seize        | resource: dummy, amount: 1 }
#> { Activity: Timeout      | delay: 1 }
#> { Activity: Release      | resource: dummy, amount: 1 }

或者，它可能嵌套使用，类似另一个行为：

t0 <- trajectory() %>%
  join(t1) %>%
  timeout(1) %>%
  join(t3)
t0
#> trajectory: anonymous, 3 activities
#> { Activity: Seize        | resource: dummy, amount: 1 }
#> { Activity: Timeout      | delay: 1 }
#> { Activity: Release      | resource: dummy, amount: 1 }

参考资料

• https://r-simmer.org/referenc...
• 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
商业使用请联系作者。