Use routing logic when dispatching resources with simmer package (or an alternative)

Question

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

Answer 1

Samy's approach is fine, but I would take a slightly different one (note that this isn't tested, because I didn't write the necessary routing_logic function):

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

Note that "available_resources" (which must be a resource with a capacity equal to the number of resources you have) is like a token. Once seized, it means that there's some resource available. Otherwise, events just sit there and wait.

routing_logic() must be a function that selects a "res_id" based on some policy (e.g., first available or nearest), computes the delay and returns both values, which are stored as attributes. In that function, you may use get_capacity() to know the status of each resource without having to set t_free. You may also retrieve the position attribute for that event, which will be set automatically as follows:

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)

As you can see, I have directly connected the events data frame to the trajectory (you don't need the resource and worktime anymore; the former will be stored as the res_id attribute, and the latter will be automatically monitored by simmer and retrieved with get_mon_arrivals()). We specify that t is the time column, and the other one, position will be added to each event as an attribute, as I said before.

With this setup, you just need to redefine routing_logic() to achieve different policies and different results.