4

Is there a way to use a (customized) routing engine together with the simmer package for discrete-event simulation? (or an alternative package)

Context: I'm running dicrete-event simulations (DES) with R. Till now all my simulations are built without using one of the R packages designed for DES. Since my code gets bigger and bigger (and performance worse) I'm thinking about switching to one of the R packages designed for DES.

For some portions of my code I see how I could switch it to simmer. But till now I couldn't figure out how to use a routing-logic together with resource dispatching.

Example: The following minimal example shows what kind of functionality I need (and couldn't figure out how to build with simmer).

Generate some data, events (jobs) and 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
)

Simplified version of a routing logic: calculate the route based on position of event and resources. (For the example just points on a 1-D space between 0 and 1, in the real example a customized version of OSRM algorithm together with historical data..)

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

Two versions of the simulation. sim just takes the first available resource with no thinking about the waytime. sim_nearest calculates waytimes for all free resources and dispatches to the closest one. sim_nearest is what I want in my real examples and don't know how to build using 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))
}

Simulate the two alternatives:

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

See the differences:

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

Is it possible to generate the same results with simmer (or another R DES package)?

4

3 回答 3

3

接下来，您将找到适用于该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选择acc。到您要模拟的替代方案。

    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))

希望这可以帮助。

于 2018-06-13T13:26:35.207 回答
3

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"（它必须是容量等于您拥有的资源数量的资源）就像一个令牌。一旦被抓住，就意味着有一些可用的资源。否则，事件只是坐在那里等待。

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数据框直接连接到了轨迹上（不再需要resourceand worktime，前者会作为res_id属性存储，后者会被自动监控simmer和检索get_mon_arrivals()）。正如我之前所说，我们指定这t是时间列，另一个position将作为属性添加到每个事件中。

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

于 2018-06-15T09:54:08.730 回答
2

Iñaki 的方法非常有用，因为它使用了最新 simmer 版本的功能。出于兴趣，我用路由逻辑完成了他的示例，并且 - 正如预期的那样 - 结果是相同的。感谢您的输入 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))
于 2018-06-27T06:28:44.597 回答