r - 使用 simmer 包(或替代方案)调度资源时使用路由逻辑

Question

有没有办法将(定制)路由引擎与 simmer 包一起使用来进行离散事件模拟？ (或替代包)

<小时/>

上下文:我正在使用 R 运行离散事件模拟 (DES)。到目前为止，我的所有模拟都是在不使用专为 DES 设计的 R 包的情况下构建的。由于我的代码变得越来越大(并且性能越来越差)，我正在考虑切换到为 DES 设计的 R 包之一。

对于我的代码的某些部分，我了解如何将其切换到simmer。但到目前为止我还不知道如何将路由逻辑与资源调度结合使用。

<小时/>

示例:以下最小示例显示了我需要什么样的功能(并且无法弄清楚如何使用 simmer 进行构建)。

生成一些数据、事件(作业)和资源

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
)

简化版的路由逻辑:根据事件的位置和资源计算路由。 (对于示例，仅指向 0 和 1 之间的一维空间，在实际示例中，定制版本的 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

Samy 的方法很好，但我会采取稍微不同的方法(请注意，这没有经过测试，因为我没有编写必要的 routing_logic 函数):

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”(必须是容量等于您拥有的资源数量的资源)就像一个 token 。一旦被占领，就意味着有一些可用的资源。否则，事件只会坐在那里等待。

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() 即可实现不同的策略和不同的结果。