Question

有没有办法将（自定义的）路由引擎与simmer包一起用于离散事件模拟？（或替代方案）

上下文：我正在使用R运行dicrete-event simulations（DES）。现在我所有的模拟都是在没有使用为DES设计的R包之一的情况下构建的。由于我的代码越来越大（性能越来越差），我正在考虑切换到为DES设计的R软件包之一。

对于我的代码的某些部分，我看到如何将其切换为simmer。但到目前为止，我还无法弄清楚如何将路由逻辑与资源调度一起使用。

示例：以下最小示例显示了我需要哪种功能（并且无法弄清楚如何使用simmer构建）。

生成一些数据，events（作业）和resources

set.seed(1)

events <- data.frame(
  id = 1:3L,
  t = sort(trunc(rexp(3) * 100)),
  position = runif(3),
  resource = NA,
  worktime = NA
)

resources <- data.frame(
  id = 1:2L,
  position = c(0.2, 0.8),
  t_free = 0
)

路由逻辑的简化版本：根据event和resources的位置计算路线。（对于该示例，仅指向介于0和1之间的1-D空间，在实际示例中为OSRM算法的自定义版本以及历史数据..）

waytime <- function(events, resources, i) {
  trunc(abs(events$position[i] - resources$position[resources$id == events$resource[i]]) * 100)
}

两个版本的模拟。 sim只占用第一个可用资源而不考虑waytime。 sim_nearest计算所有免费资源的waytimes并将其发送给最近的资源。 sim_nearest是我在实际示例中所需要的，并且不知道如何使用simmer进行构建。

sim <- function(events, resources) {
  for (i in 1:nrow(events)) {
    # Default dispatching: Use the first free vehicle
    events$resource[i] <- resources$id[resources$t_free <= events$t[i]][1]
    # Simulate event
    events$worktime[i] <- waytime(events, resources, i)
    resources$t_free[events$resource[i]] <- events$t[i] + events$worktime[i]
  }
  return(list(events = events, resources = resources))
}

sim_use_nearest <- function(events, resources) {
  for (i in 1:nrow(events)) {
    # Dispatching by position: Use the nearest free resource
    ids_free <- resources$id[resources$t_free <= events$t[i]]
    events$resource[i] <- resources$id[which.min(abs(resources$position[ids_free] - events$position[i]))]
    # Simulate event
    events$worktime[i] <- waytime(events, resources, i)
    resources$t_free[events$resource[i]] <- events$t[i] + events$worktime[i]
  }
  return(list(events = events, resources = resources))
}

模拟两种选择：

res <- sim(events, resources)
res_use_nearest <- sim_use_nearest(events, resources)

看到差异：

res$events
# id   t  position resource worktime
#  1  14 0.9082078        1       70
#  2  75 0.2016819        2       59
#  3 118 0.8983897        1       69
res$resources
# id position t_free
#  1      0.2    187
#  2      0.8    134
res_use_nearest$events
# id   t  position resource worktime
#  1  14 0.9082078        2       10
#  2  75 0.2016819        1        0
#  3 118 0.8983897        2        9
res_use_nearest$resources
# id position t_free
#  1      0.2     75
#  2      0.8    127

是否可以使用simmer（或其他R DES包）生成相同的结果？

Answer 1

关注您，使用simmer软件包为您的最小示例找到可能的解决方案。

首先，我们选择了以后在set_attribute中使用的模拟替代方案：

sim_first_available <- T
sim_use_nearest <- F

像以前一样生成events和resources数据。

set.seed(1)

events <- data.frame(
  id = 1:3L,
  t = sort(trunc(rexp(3) * 100)),
  position = runif(3),
  resource = NA,
  worktime = NA
)

resources <- data.frame(
  id = 1:2L,
  position = c(0.2, 0.8),
  t_free = 0
)

使用轨迹simmer开始sim。

library(simmer)

sim <- trajectory() %>%

然后将t_free设置为全局属性。在第一次到达时（t = 14），您可以使用资源数据中的t_free进行初始化。在以后到达时，使用get_global获取特定资源的当前t_free。

  set_global(paste0("t_free_res_", resources$id), function() {
    if (now(env) == 14) {return(resources$t_free) # Initialize parameters when first event arrives
    } else {
      get_global(env, paste0("t_free_res_", resources$id))
    }}) %>%

现在定义此事件的属性：

根据当前模拟时间，从数据框event_position中选择events。

  set_attribute(c("event_position","my_resource", "timeout"), function() {
    t <- now(env)
    event_position <- events$position[events$t == t]

选择

my_resource。到您想要模拟的替代方案。

    t_free <- get_global(env, paste0("t_free_res_", resources$id))
    if (sim_first_available & !sim_use_nearest) {
      my_resource <- resources$id[t_free <= now(env)][1]
    } else if (!sim_first_available & sim_use_nearest){
      ids_free <- resources$id[t_free <= now(env)]
      my_resource <- resources$id[which.min(abs(resources$position[ids_free] - event_position))]
    }

基于resource_pos计算该资源的timeout并返回属性：

resource_pos <- resources$position[resources$id == my_resource]
        timeout <- trunc(abs(event_position - resource_pos)*100)

        return(c(event_position, my_resource, timeout))
      }) %>%

选择已定义的资源并抓住它：

  select(resources = function() paste0("res_", get_attribute(env, "my_resource"))) %>%
  seize_selected(amount = 1) %>%

现在通过将t_free添加到当前模拟时间来覆盖该资源的timeout。

  set_global(function() {
    paste0("t_free_res_", get_attribute(env, "my_resource"))
  }, function() {
    return(now(env) + get_attribute(env, "timeout"))
  }) %>%

将计算的超时时间设置为资源并再次释放。

  timeout(function() get_attribute(env, "timeout")) %>% 
  release_selected(amount = 1)

最后在事件中定义的时间间隔生成轨迹sim的事件，添加资源并运行模拟。

env <- simmer()  %>%
  add_generator("event_", sim, at(events$t), mon = 2) %>%
  add_resource("res_1", capacity = 1) %>%
  add_resource("res_2", capacity = 1)

env %>% run()

print(get_mon_attributes(env))
print(get_mon_arrivals(env))
print(get_mon_resources(env))

希望这有帮助。

Answer 2

Samy的方法很好，但我会稍微不同一些（请注意，这并没有经过测试，因为我没有编写必要的routing_logic函数）：< / p>

library(simmer)

env <- simmer()

t <- trajectory() %>%
  seize("available_resources") %>%
  set_attribute(c("res_id", "delay"), routing_logic) %>%
  select(function() paste0("res_", get_attribute(env, "res_id"))) %>%
  seize_selected() %>%
  timeout_from_attribute("delay") %>%
  release_selected() %>%
  release("available_resources")

请注意，"available_resources"（必须是容量等于您拥有的资源数量的资源）就像一个令牌。一旦抓住，这意味着有一些资源可用。否则，事件只是坐在那里等待。

routing_logic()必须是根据某个策略选择"res_id"的函数（例如，第一个可用或最近），计算延迟并返回两个值，这些值存储为属性。在该函数中，您可以使用get_capacity()来了解每个资源的状态，而无需设置t_free。您还可以检索该事件的position属性，该属性将自动设置如下：

set.seed(1)

events <- data.frame(
  t = sort(trunc(rexp(3) * 100)),
  position = runif(3)
)

resources <- data.frame(
  id = 1:2L,
  position = c(0.2, 0.8)
)

env %>% 
  add_dataframe("event_", t, events, mon=2, col_time="t", time="absolute") %>%
  add_resource("available_resources", capacity=nrow(resources))

for (id in resources$id) env %>%
  add_resource(paste0("res_", id), capacity=1, queue_size=0)

如您所见，我已将events数据框直接连接到轨迹（您不再需要resource和worktime;前者将被存储作为res_id属性，后者将由simmer自动监控并使用get_mon_arrivals()检索。我们指定t是时间列，另一个position将作为属性添加到每个事件中，如前所述。

使用此设置，您只需重新定义routing_logic()即可实现不同的政策和不同的结果。

Answer 3

Iñaki的方法非常有用，因为它使用了最新的慢炖版本的功能。出于兴趣，我用路由逻辑完成了他的示例，并且-如预期的那样-结果是相同的。感谢您的输入Iñaki。

library(simmer)

env <- simmer()

t <- trajectory() %>%
  seize("available_resources") %>%
  set_attribute(c("res_id", "delay"), function() {
    # find available resources
    capacities <- numeric(nrow(resources))
    for (i in 1:length(capacities)) {
      capacities[i] <- get_server_count(env, paste0("res_", resources$id[i]))
    }
    available <- ifelse(capacities == 0, T, F)
    index_available <- which(available)
    # calculate the delay for available resources
    event_position <- get_attribute(env, "position")
    delay <- trunc(abs(event_position - resources$position[available])*100)
    # take the nearest available resource. 
    index <- index_available[which.min(delay)]
    return(c(index,min(delay)))
  }) %>%
  select(function() paste0("res_", get_attribute(env, "res_id"))) %>%
  seize_selected() %>%
  timeout_from_attribute("delay") %>%
  release_selected() %>%
  release("available_resources")
# --------------------------------------------------------------------
set.seed(1)

events <- data.frame(
  t = sort(trunc(rexp(3) * 100)),
  position = runif(3)
)

resources <- data.frame(
  id = 1:2L,
  position = c(0.2, 0.8)
)

env %>% 
  add_dataframe("event_", t, events, mon=2, col_time="t", time="absolute") %>%
  add_resource("available_resources", capacity=nrow(resources))
for (id in resources$id) env %>%
  add_resource(paste0("res_", id), capacity=1, queue_size=0)

env %>% run()
# --------------------------------------------------------------------
library(simmer.plot)
print(plot(get_mon_resources(env), metric = "usage", c("available_resources", "res_1", "res_2"), items = "server", steps = TRUE))

使用simmer包（或替代方案）

3 个答案: