R Simmer - Использование set_attribute и get_attribute и репликация (используя lapply) - PullRequest
0 голосов
/ 16 мая 2018

Я пытаюсь объединить репликацию set_attribute и get_attribute (используя lapply) Следующий код без get_attribute работает хорошо:

library(simmer)    

SystemTime <- 200
delay= c(20,40,60,80,100,120,140,160,180,200)/60
set.seed(1234)

elevators <- simmer()

worker <-
  trajectory("elevators service") %>% #trajectory name
  log_("new worker arrived") %>% #
  set_attribute("start_time", function() {now(elevators)}) %>%
  seize("elevator",amount = 1) %>% #elevator queue and service 
  timeout(function() sample(delay,1)) %>%
  release("elevator") 


elevators <-lapply(1:100, function(i) {
  simmer("elevators") %>%
  add_generator("worker", worker, function() exp(2)) %>% 
    add_resource("elevator",capacity = 2) %>% 
  run(until = SystemTime)

})

Когда я добавляю «get_attribute», как показано ниже:

library(simmer) 

SystemTime <- 200
delay= c(20,40,60,80,100,120,140,160,180,200)/60
set.seed(1234)

elevators <- simmer()

worker <-
  trajectory("elevators service") %>% #trajectory name
  log_("new worker arrived") %>% #
  set_attribute("start_time", function() {now(elevators)}) %>%
  seize("elevator",amount = 1) %>% #elevator queue and service 
  timeout(function() sample(delay,1)) %>%
  log_(function() {paste("Waited: ", now(elevators) - get_attribute(elevators, "start_time"))}) %>%
  release("elevator") 


elevators <-lapply(1:100, function(i) {
  simmer("elevators") %>%
  add_generator("worker", worker, function() exp(2)) %>% 
    add_resource("elevator",capacity = 2) %>% 
  run(until = SystemTime)

})

Я получаю следующую ошибку:

Ошибка в run_ (private $ sim_obj, пока): ошибка оценки: есть прибытие не работает.

Нужна помощь, как решить эту проблему?

1 Ответ

0 голосов
/ 17 мая 2018

Ваш первый пример работает без ошибок, но на самом деле он работает не очень хорошо. По сути, у вас есть проблема с областью видимости. Среда моделирования должна находиться в области действия траектории, чтобы get_attributenow) могли ее видеть. Решение состоит в том, чтобы поместить все в одну и ту же функцию:

library(simmer) 

SystemTime <- 200
delay= c(20,40,60,80,100,120,140,160,180,200)/60
set.seed(1234)

elevators <-lapply(1:100, function(i) {
  elevator <- simmer("elevator")

  worker <-
    trajectory("elevator service") %>% #trajectory name
    log_("new worker arrived") %>% #
    set_attribute("start_time", function() {now(elevator)}) %>%
    seize("elevator",amount = 1) %>% #elevator queue and service 
    timeout(function() sample(delay,1)) %>%
    log_(function() {paste("Waited: ", now(elevator) - get_attribute(elevator, "start_time"))}) %>%
    release("elevator") 

  elevator %>%
    add_generator("worker", worker, function() rexp(1, 2)) %>% 
    add_resource("elevator", capacity = 2) %>% 
    run(until = SystemTime)
})

Также обратите внимание, что я заменил exp(2) на rexp(1, 2) в вашем генераторе, что, я думаю, именно то, что вы действительно хотели.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...