CODEWITHSUNDEEP
rsimulation
Pyrosopher
Pyrosopher

Reputation: 57

Using Simmer to build a specific model

I've got data on actual events and I need to model what might have happened if different resources were available. The next stage will be to build a "proper" simulation where events and times are created more randomly. My problem is that I can't work out how to ensure a specific activity gets assigned the start time, priority and timeout which it had in real life.

library(simmer)
set.seed(654)
env <- simmer()
workerCount <- 2

actualData <- data.frame(arrTime = c(1:10,1:5), 
priority = 1:3, duration = rnorm(15, 50, 5))

activityTraj <- trajectory() %>%
seize('worker') %>%
timeout(5) %>%
release('worker')

env %>%
add_resource('worker', workerCount, Inf, preemptive = TRUE) %>%
add_generator('worker', activityTraj, at(actualData$arrTime), 
mon = 2, priority = 2)

env %>% run(50)

What I need to do in the above is to make the priority in the generator read from the data frame (currently hard coded at 2) and the timeout (currently hard coded at 5) in the trajectory also read from the data frame. I can't see how I can ensure that the row that specifies the priority and time of the activity will also be used to specify the duration (or "timeout").

Upvotes: 0

Views: 704

Answers (1)

I&#241;aki &#218;car
I&#241;aki &#218;car

Reputation: 975

First of all, you must ensure that your actualData frame is sorted by arrTime:

actualData <- data.frame(arrTime = c(1:10,1:5), 
                         priority = 1:3, 
                         duration = rnorm(15, 50, 5)) %>%
  dplyr::arrange(arrTime)

Then, let's build a helper function to consume the columns of your actualData:

consume <- function(x, prio=FALSE) {
  i <- 0
  function() {
    i <<- i + 1
    if (prio) c(x[[i]], x[[i]], FALSE)
    else x[[i]]
  }
}

which can be applied to your trajectory as follows:

activityTraj <- trajectory() %>%
  set_prioritization(consume(actualData$priority, TRUE)) %>%
  set_attribute("duration", consume(actualData$duration)) %>%
  seize('worker') %>%
  timeout(function(attr) attr["duration"]) %>%
  release('worker')

because your arrivals are sorted. Finally, let's run the simulation:

env %>%
  add_resource('worker', workerCount, Inf, preemptive = TRUE) %>%
  add_generator('worker_', activityTraj, at(actualData$arrTime)) %>%
  run()

and check that the actual durations were ok:

activity_time <- get_mon_arrivals(env) %>%
  tidyr::separate(name, c("prefix", "n"), convert=TRUE) %>%
  dplyr::arrange(n) %>%
  dplyr::pull(activity_time)

all(activity_time == actualData$duration)
#> TRUE

UPDATE: Since simmer v3.8.0, the new data source add_dataframe greatly simplifies this kind of pattern:

library(simmer)

workerCount <- 2
actualData <- data.frame(
  time = c(1:10,1:5), priority = 1:3, service = rnorm(15, 50, 5)) %>%
  dplyr::arrange(time)

activityTraj <- trajectory() %>%
  seize('worker') %>%
  timeout_from_attribute("service") %>%
  release('worker')

env <- simmer() %>%
  add_resource('worker', workerCount, Inf, preemptive = TRUE) %>%
  add_dataframe('worker_', activityTraj, actualData, time="absolute") %>%
  run()

activity_time <- get_mon_arrivals(env) %>%
  tidyr::separate(name, c("prefix", "n"), convert=TRUE) %>%
  dplyr::arrange(n) %>%
  dplyr::pull(activity_time)

all(activity_time == actualData$duration)
#> TRUE

Upvotes: 4

Related Questions