使用 simmer 包（或替代方案）调度资源时使用路由逻辑
Use routing logic when dispatching resources with simmer package (or an alternative)
有没有办法将（定制的）路由引擎与 simmer 包一起用于离散事件模拟？ （或替代包）
上下文：我 运行 使用 R 进行离散事件模拟 (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 之间的一维 space，在实际示例中，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 包）生成相同的结果？
接下来，您将使用 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))
}}) %>%
现在定义此事件的属性：
根据当前模拟时间从数据帧events中选择event_position。
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 和 return 属性：
resource_pos <- resources$position[resources$id == my_resource]
timeout <- trunc(abs(event_position - resource_pos)*100)
return(c(event_position, my_resource, timeout))
}) %>%
Select定义的资源并抢占：
select(resources = function() paste0("res_", get_attribute(env, "my_resource"))) %>%
seize_selected(amount = 1) %>%
现在通过将 timeout 添加到当前模拟时间来覆盖该资源的 t_free。
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))
希望这对您有所帮助。
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"，计算延迟和 returns 这两个值，这些值被存储作为属性。在该函数中，您可以使用 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() 即可实现不同的策略和不同的结果。
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))
有没有办法将（定制的）路由引擎与 simmer 包一起用于离散事件模拟？ （或替代包）
上下文：我 运行 使用 R 进行离散事件模拟 (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 之间的一维 space，在实际示例中，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 包）生成相同的结果？
接下来，您将使用 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))
}}) %>%
现在定义此事件的属性：
根据当前模拟时间从数据帧events中选择event_position。
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 和 return 属性：
resource_pos <- resources$position[resources$id == my_resource]
timeout <- trunc(abs(event_position - resource_pos)*100)
return(c(event_position, my_resource, timeout))
}) %>%
Select定义的资源并抢占：
select(resources = function() paste0("res_", get_attribute(env, "my_resource"))) %>%
seize_selected(amount = 1) %>%
现在通过将 timeout 添加到当前模拟时间来覆盖该资源的 t_free。
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))
希望这对您有所帮助。
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"，计算延迟和 returns 这两个值，这些值被存储作为属性。在该函数中，您可以使用 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() 即可实现不同的策略和不同的结果。
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))