Используйте логику маршрутизации при распределении ресурсов с пакетом simmer (или альтернативой)
Есть ли способ использовать (настраиваемый) механизм маршрутизации вместе с simmer пакет для моделирования дискретных событий? (или альтернативный пакет)
Контекст: я запускаю имитацию двукратного события (DES) с R. До сих пор все мои симуляции построены без использования одного из пакетов R, разработанных для DES. Поскольку мой код становится все больше и больше (и производительность хуже), я думаю о переходе на один из пакетов R, предназначенных для DES.
Для некоторых частей моего кода я вижу, как я мог бы переключить его на 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, (Для примера просто указывает на 1-D пробел между 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)?
3 ответа
Подход Сэми хорош, но я бы выбрал немного другой (обратите внимание, что это не проверено, потому что я не написал необходимую 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 кадр данных к траектории (вам не нужно resource а также worktime больше; первый будет храниться как res_id атрибут, и последний будет автоматически контролироваться simmer и извлекается с get_mon_arrivals()). Мы указываем, что t это столбец времени, а другой, position будет добавлен к каждому событию в качестве атрибута, как я уже говорил.
С этой настройкой вам просто нужно переопределить routing_logic() добиться разной политики и разных результатов.
После вы найдете возможное решение для вашего минимального примера с 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 как глобальный атрибут. При первом прибытии (т = 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))
Надеюсь это поможет.
Подход Иньяки очень полезен, поскольку он использует возможности новейшей версии симмера. Из интереса я дополнил его пример логикой маршрутизации и, как и ожидалось, результаты были такими же. Спасибо за ваш вклад Иньяки.
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))