Why would mclapply result in "Error in eval(lhs, parent, parent) : there is no arrival running"?

[pgetty]

Greetings!

Long time enthusiast, but first time user of simmer here humbly seeking a bit of learned guidance.

I'm digging into the Bank Tutorial Part 1 (https://r-simmer.org/articles/simmer-04-bank-1.html). I've ran through the entire thing and I can get it to work. Now I'm trying to test my (mis)understanding of the tutorial by trying to combine different aspects of it (i.e., getting attributions, using multiple resources and multiple runs) in the same simulation. Below is the code I'm trying to use that gives me the error noted in the title:

library("parallel")
library("simmer")

customer<-
  trajectory("Customer's path") %>% 
  set_attribute("start_time", function(){now(bank)}) %>% 
  log_("Here I am") %>% 
  select(c("counter1", "counter2", "counter3"), policy="shortest-queue") %>% 
  seize_selected() %>% 
  log_(function(){paste("Waited: ", now(bank) - get_attribute(bank,"start_time"))}) %>% 
  timeout(function(){rexp(1,1/12)}) %>% 
  release_selected() %>% 
  log_(function(){paste("Finished: ", now(bank))})


mclapply(c(393943, 100005, 777999555, 319999772), function(the_seed){  # Note that everything below is
 set.seed(the_seed)                                                   # is encapsulated by the mclapply({})

bank<-
  simmer("bank") %>% 
  add_resource("counter1",1) %>% 
  add_resource("counter2",1) %>% 
  add_resource("counter3",1) %>% 
  add_generator("Customer",customer,function(){c(0,rexp(100,1/10),-1)})

bank %>% run(until=1000)

  results<-
    bank %>% 
  get_mon_arrivals() %>% 
  transform(waiting_time=end_time-start_time-activity_time) %>% 
  .[order(.$start_time),]
  
paste("Average wait for ", sum(results$finished), " completions was ",
      mean(results$waiting_time), "minutes.")
}) %>% unlist()                                                         # Here is the end

However, as soon as I comment out the code associated with the mclapply and multiple runs, the code works:

library("parallel")
library("simmer")

customer<-
  trajectory("Customer's path") %>% 
  set_attribute("start_time", function(){now(bank)}) %>% 
  log_("Here I am") %>% 
  select(c("counter1", "counter2", "counter3"), policy="shortest-queue") %>% 
  seize_selected() %>% 
  log_(function(){paste("Waited: ", now(bank) - get_attribute(bank,"start_time"))}) %>% 
  timeout(function(){rexp(1,1/12)}) %>% 
  release_selected() %>% 
  log_(function(){paste("Finished: ", now(bank))})


#mclapply(c(393943, 100005, 777999555, 319999772), function(the_seed){  # Note that everything below is
 #set.seed(the_seed)                                                   # is encapsulated by the mclapply({})

bank<-
  simmer("bank") %>% 
  add_resource("counter1",1) %>% 
  add_resource("counter2",1) %>% 
  add_resource("counter3",1) %>% 
  add_generator("Customer",customer,function(){c(0,rexp(100,1/10),-1)})

bank %>% run(until=1000)

  results<-
    bank %>% 
  get_mon_arrivals() %>% 
  transform(waiting_time=end_time-start_time-activity_time) %>% 
  .[order(.$start_time),]
  
paste("Average wait for ", sum(results$finished), " completions was ",
      mean(results$waiting_time), "minutes.")
#}) %>% unlist()                                                         # Here is the end


simmer environment: bank | now: 1000 | next: 1006.0309948087
{ Monitor: in memory }
{ Resource: counter1 | monitored: TRUE | server status: 1(1) | queue status: 0(Inf) }
{ Resource: counter2 | monitored: TRUE | server status: 1(1) | queue status: 0(Inf) }
{ Resource: counter3 | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
{ Source: Customer | monitored: 1 | n_generated: 101 }
> 
>   results<-
+     bank %>% 
+   get_mon_arrivals() %>% 
+   transform(waiting_time=end_time-start_time-activity_time) %>% 
+   .[order(.$start_time),]
>   
> paste("Average wait for ", sum(results$finished), " completions was ",
+       mean(results$waiting_time), "minutes.")
[1] "Average wait for  89  completions was  0.53324398904408 minutes."

So I guess my immediate question is what am I doing wrong with the mclapply? What is the correct way to use multiple resources in multiple parallel runs in the same simulation?

Thank you in advance.

Cheers!

P

[Enchufa2]

Parallelization becomes tricky when something in your trajectories references the simulation environment (now(bank) in your case). This is mainly because, internally, both trajectories and the simmer environment are pointers to internal objects. My recommendation is to define a function (e.g., simulate) encapsulating everything, and then pass that function to mclapply. You can find an example of this workflow in this vignette.

[pgetty]

Thank you very much for helping me with this. I've tried extracting the important bits from the 5G example to make this code work, but I must still be doing something wrong. I'm probably misunderstanding what you mean. Here is the closest I think I've gotten:

library("parallel")
library("simmer")

simulate<-function(){
customer<-
  trajectory("Customer's path") %>% 
  set_attribute("start_time", function(){now(bank)}) %>% 
  log_("Here I am") %>% 
  select(c("counter1", "counter2", "counter3"), policy="shortest-queue") %>% 
  seize_selected() %>% 
  log_(function(){paste("Waited: ", now(bank) - get_attribute(bank,"start_time"))}) %>% 
  timeout(function(){rexp(1,1/12)}) %>% 
  release_selected() %>% 
  log_(function(){paste("Finished: ", now(bank))})

bank<-
  simmer("bank") %>% 
  add_resource("counter1",1) %>% 
  add_resource("counter2",1) %>% 
  add_resource("counter3",1) %>% 
  add_generator("Customer",customer,function(){c(0,rexp(100,1/10),-1)})

bank %>% run(until=1000)%>% 

results<-
 bank %>% 
  get_mon_arrivals() %>% 
  transform(waiting_time=end_time-start_time-activity_time) %>% 
  .[order(.$start_time),]

paste("Average wait for ", sum(results$finished), " completions was ",
      mean(results$waiting_time), "minutes.")
                                                        # Here is the end
} 
system.time({
  banks<-parallel::mclapply(c(393943, 100005, 777999555, 319999772), function(the_seed){  # Note that everything below is
    set.seed(the_seed) },
    Simulate)})

I believe I have encapsulated everything and then passed it to mclapply to apply the different seeds. But I must not be because I get the following error message:

Error in FUN(X[[i]], ...) : unused argument (function () 
{
    customer <- trajectory("Customer's path") %>% set_attribute("start_time", function() {
        now(bank)
    }) %>% log_("Here I am") %>% select(c("counter1", "counter2", "counter3"), policy = "shortest-queue") %>% seize_selected() %>% log_(function() {
        paste("Waited: ", now(bank) - get_attribute(bank, "start_time"))
    }) %>% timeout(function() {
        rexp(1, 1/12)
    }) %>% release_selected() %>% log_(function() {
        paste("Finished: ", now(bank))
    })
    bank <- simmer("bank") %>% add_resource("counter1", 1) %>% add_resource("counter2", 1) %>% add_resource("counter3", 1) %>% add_generator("Customer", customer, function() {
        c(0, rexp(100, 1/10), -1)
    })
    bank %>% run(until = 1000) %>% results <- bank %>% get_mon_arrivals() %>% transform(waiting_time = end_time - start_time - activity_time) %>% .[order(.$start_time), ]
    paste("Average wait for ", sum(results$finished), " completions was ", mean(results Timing stopped at: 0 0 0

Any clues as to what I'm doing wrong here? DES with Simmer is really cool and very applicable to my work and could bring our modeling to the next level. So I can't thank you enough for taking the time to help me work through these novice difficulties.

Cheers!--Sincerely!

Phil

[Enchufa2]

I would integrate the seed into the simulate function, and return the bank object for further analyses:

library("parallel")
library("simmer")

simulate<-function(seed){
  set.seed(seed)
  
  customer<-
    trajectory("Customer's path") %>% 
    set_attribute("start_time", function(){now(bank)}) %>% 
    log_("Here I am") %>% 
    select(c("counter1", "counter2", "counter3"), policy="shortest-queue") %>% 
    seize_selected() %>% 
    log_(function(){paste("Waited: ", now(bank) - get_attribute(bank,"start_time"))}) %>% 
    timeout(function(){rexp(1,1/12)}) %>% 
    release_selected() %>% 
    log_(function(){paste("Finished: ", now(bank))})
  
  bank<-
    simmer("bank") %>% 
    add_resource("counter1",1) %>% 
    add_resource("counter2",1) %>% 
    add_resource("counter3",1) %>% 
    add_generator("Customer",customer,function(){c(0,rexp(100,1/10),-1)})
  
  bank %>%
    run(until=1000) %>%
    wrap() # You need to return your objects wrapped for further analysis
}

seeds <- c(393943, 100005, 777999555, 319999772)
banks <- parallel::mclapply(seeds, simulate)

banks %>% 
  get_mon_arrivals() %>%
  dplyr::group_by(replication) %>%
  dplyr::summarise(
    completions = sum(finished),
    avg_waiting_time = mean(end_time-start_time-activity_time)
  )
#> # A tibble: 4 x 3
#>   replication completions avg_waiting_time
#>         <int>       <int>            <dbl>
#> 1           1         101            3.31 
#> 2           2          86            0.446
#> 3           3          95            0.965
#> 4           4         101            0.905

[pgetty]

This is great! Very cool. I can't thank you enough for this. Cheers!