simmer generator wrong quantities

Hello,

I am currently learning about the simmer package, but I am still struggling.

  1. Question: why is the the number of generated instances not the same, as the length of the original data vectors?

  2. Question: is the running of single steps alright, as it is implemented? It is a simple version, of what i have to do later on. For the solution priorities are not suitable.

Can somebody please help me?

library(simmer)

library(parallel)

library(simmer.plot)

max<-10000
data1 <- c(1133360, 1133360, 1133360, 1133360, 1133360, 1133360, 898684, 898684, 898684, 898684, 898684, 898684, 898684, 898684, 898684, 898684, 898790, 997564, 997564, 997564, 997564, 997564, 997564, 997564, 999595, 999595, 999595, 999595, 999595, 999595, 999595)
data2 <- c(57641, 57641, 57641, 685433, 685433, 685433, 685433, 685433, 685433, 685433, 685433, 685433, 685501, 828820, 828820, 828820)
i<-0
readytraj1<-0
readytraj2<-0
env <- simmer("env")

traj1 <- trajectory("traj1") %>%
seize("res", 1) %>%
timeout(task = 10) %>%
release("res", 1)

traj2 <- trajectory("traj2") %>%
seize("res", 1) %>%
timeout(task = 10) %>%
release("res", 1)

env %>%
add_resource("res", 1) %>%
add_generator("traj1", traj1, at(c(data1)), mon=2) %>%
add_generator("traj2", traj2, at(c(data2)), mon=2)

while(max > i){

queuetraj1 <- env %>% get_n_generated("traj1")
queuetraj1 <- queuetraj1 - readytraj1
if(queuetraj1>0){
traj1
env %>%
stepn(1) %>%
print()
readytraj1<-readytraj1+1
i<-i+1
}

queuetraj2 <- env %>% get_n_generated("traj2")
queuetraj2 <- queuetraj2 - readytraj2
if(queuetraj2>0){
traj2
env %>%
stepn(1) %>%
print()
readytraj2<-readytraj2+1
i<-i+1
}
}

get_n_generated("traj1")
length(data1)
get_n_generated("traj2")
length(data2)

thank you in advance!

When I run your simulations with

env %>%
  run()

I get the 16 events from traj2 and 6 events (of the 31) from traj1.
This is caused by your use of the at function that 'generates arrivals at specific absolute times'.
Because data1[7] < data1[6] the generation of events will stop after the sixth event.

Thank you!
What can I do, to generate many arrivals, at one point of time?

You are already doing that by specifying the same start times (not arrival times) in the at function.
I find that the monitor functions gives you a good idea of what is happening in the system.
I did not work yet with the plot functions.

xx =env %>%
 get_mon_arrivals() 

yy = env %>%   
  get_mon_attributes()

zz = env %>%
  get_mon_resources()

Sorry, I do not understand your explanation.
Both datasets have the same start time.
But I want two arrivals, at the same generator, when the same number is in the data vector two times.
at(c(3, 3)) two arrivals should happen simultaneously at time unit 3, but they don´t.

See example below where I changed some of your code
(not because it would not work but just because I was trying out some changes)
At time 3 you will see starting 2 events from traj1 and one of traj3.
They will not finish at the same time because they all use resource res that has a capacity 1.

library(simmer)

# library(parallel)
# 
# library(simmer.plot)

set.seed(2020)

max<-25
data1 <- c(3,3,4)
data2 <- c(2,3,4)
i<-0
readytraj1<-0
readytraj2<-0
env <- simmer("env")

traj1 <- trajectory("traj1") %>%
seize("res", 1) %>%
timeout(task = 1) %>%
release("res", 1)

traj2 <- trajectory("traj2") %>%
seize("res", 1) %>%
timeout(task = 1) %>%
release("res", 1)

env %>%
add_resource("res", 1) %>%
add_generator("one", traj1, at(c(data1)), mon=2) %>%
add_generator("two", traj2, at(c(data2)), mon=2)
#> simmer environment: env | now: 0 | next: 0
#> { Monitor: in memory }
#> { Resource: res | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
#> { Source: one | monitored: 2 | n_generated: 0 }
#> { Source: two | monitored: 2 | n_generated: 0 }

env %>%
  run()
#> simmer environment: env | now: 8 | next: 
#> { Monitor: in memory }
#> { Resource: res | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
#> { Source: one | monitored: 2 | n_generated: 3 }
#> { Source: two | monitored: 2 | n_generated: 3 }

xx =env %>%
 get_mon_arrivals() %>%
 print()
#>   name start_time end_time activity_time finished replication
#> 1 two0          2        3             1     TRUE           1
#> 2 one0          3        4             1     TRUE           1
#> 3 one1          3        5             1     TRUE           1
#> 4 two1          3        6             1     TRUE           1
#> 5 one2          4        7             1     TRUE           1
#> 6 two2          4        8             1     TRUE           1

Created on 2020-07-14 by the reprex package (v0.3.0)

Thank you very much
This works, as I need it

At the moment, the trajectories are just execute.
In the end I want to steer with different conditions, which trajectory is run.
For example the first one should run, until the queue is empty and the the second is run, til this one is empty.
something like

ready1 <-0
ready2 <- 0
while(i<100){

queue1 <- get_mon_arrivals - ready1
if(queue1 >0){
run(traj1)
ready1 <- ready1 +1
}

queue2 <- get_mon_arrivals - ready2
if(queue2 >0){
run(traj2)
ready2 <- ready2 +1
}

i<-i+1
}

can something like this work?

I don't know a solution.
I was thinking about a variable priority (specified by a function) but am not sure if that could work.
Check out the articles on https://r-simmer.org/articles/ .
Maybe this gives you some ideas.

When you have found a solution, please let us know.

Thank you very much for your support.

I go on searching and post the solution here, when the problem is solved.

As promised, i want to post a solution here.
At the moment, it does not work properly.
Something is wrong, but I think I am on the right track.

library(simmer)
set.seed(2020)

max<-25
data1 <- c(3,3,4)
data2 <- c(2,3,4)
i<-0
readytraj1<-0
readytraj2<-0
env <- simmer("env")

loop1 <- function(){
  a <- env %>% get_mon_arrivals("traj1")
  b <- a["finished"]
  ready <- nrow(b)
  e<-env %>% get_n_generated("traj1")
  queue <- e - ready
  return(queue)
}

loop2 <- function(){
  a <- env %>% get_mon_arrivals("traj2")
  b <- a["finished"]
  ready <- nrow(b)
  e<-env %>% get_n_generated("traj2")
  queue <- e - ready
  return(queue)
}

traj1 <- trajectory("traj1") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1) %>%
  branch(option = function() {round(ifelse(runif(loop1()>0)))},
         continue=c(FALSE, TRUE), 
         join(traj1),
         join(traj2)%>%rollback(amount=7, times = 1,check = NULL)
  )

traj2 <- trajectory("traj2") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1) %>%
  branch(option = function() {round(ifelse(runif(loop2()>0)))},
         continue=c(FALSE, TRUE), 
         join(traj2),
         join(traj1)%>%rollback(amount=7, times = 1,check = NULL)
  )

env %>%
  add_resource("res", 1) %>%
  add_generator("one", traj1, at(c(data1)), mon=2) %>%
  add_generator("two", traj2, at(c(data2)), mon=2)

env %>%
  run()


env %>% get_mon_arrivals()

I will have a look at code tomorrow (late in the evening now in the Netherlands).
Maybe it gives me some ideas
Until now I came up with the following code but I am not convinced that it will always work.
Maybe it gives you some ideas.

The idea is that an arrival gets higher priority if a college (an arrival of the same source) is already using the resource res

library(simmer)

set.seed(2020)

max<-25
data1 <- c(2,3,3,4)
data2 <- c(1,2,4,12)

env <- simmer("env")

traj1 <- trajectory("traj1") %>%
  set_global('traj1P',+1, mod="+") %>%
  set_prioritization(function() {
      if ((get_global(env,'traj1P') > 1) && (get_global(env,'traj1B') > 0) )  c(1, -1, -1)
         else c(-1, -1, -1)
      }   ) %>%
  log_(function() paste('prior',get_prioritization(env)[1])) %>%
  seize("res", 1) %>%
  set_global('traj1B',1) %>%
  timeout(task = 2) %>%
  release("res", 1) %>%
  set_global('traj1B',0) %>%
  set_global('traj1P',-1, mod="+")  

traj2 <- trajectory("traj2") %>%
  set_global('traj2P',+1, mod="+") %>%
  set_prioritization(function() {
         if ((get_global(env,'traj2P') > 1) && (get_global(env,'traj2B') > 0) )  c(1, -1, -1)
         else c(-1, -1, -1)
      }   ) %>%
  log_(function() paste('prior',get_prioritization(env)[1])) %>%
  seize("res", 1) %>%
  set_global('traj2B',1) %>%
  timeout(task = 2) %>%
  release("res", 1) %>%
  set_global('traj2B',0) %>%
  set_global('traj2P',-1, mod="+")  

env <- env %>%
add_global('traj1P',0) %>%
add_global('traj2P',0) %>%
add_global('traj1B',0) %>%
add_global('traj2B',0) %>%
add_resource("res", 1) %>%
add_generator("one", traj1, at(c(data1)), mon=2) %>%
add_generator("two", traj2, at(c(data2)), mon=2)

env %>%
  run()
#> 1: two0: prior 0
#> 2: one0: prior 0
#> 2: two1: prior 1
#> 3: one1: prior 0
#> 3: one2: prior 0
#> 4: two2: prior 1
#> 4: one3: prior 0
#> 12: two3: prior 0
#> simmer environment: env | now: 17 | next: 
#> { Monitor: in memory }
#> { Resource: res | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }
#> { Source: one | monitored: 2 | n_generated: 4 }
#> { Source: two | monitored: 2 | n_generated: 4 }
#> { Global: traj1P | schedule: FALSE | initial value: 0 }
#> { Global: traj2P | schedule: FALSE | initial value: 0 }
#> { Global: traj1B | schedule: FALSE | initial value: 0 }
#> { Global: traj2B | schedule: FALSE | initial value: 0 }

xx =env %>%
 get_mon_arrivals() %>%
 print()
#>   name start_time end_time activity_time finished replication
#> 1 two0          1        3             2     TRUE           1
#> 2 two1          2        5             2     TRUE           1
#> 3 two2          4        7             2     TRUE           1
#> 4 one0          2        9             2     TRUE           1
#> 5 one1          3       11             2     TRUE           1
#> 6 one2          3       13             2     TRUE           1
#> 7 one3          4       15             2     TRUE           1
#> 8 two3         12       17             2     TRUE           1

yy = env %>%
  get_mon_attributes() %>%
 print()
#>    time name    key value replication
#> 1     0      traj1P     0           1
#> 2     0      traj2P     0           1
#> 3     0      traj1B     0           1
#> 4     0      traj2B     0           1
#> 5     1      traj2P     1           1
#> 6     1      traj2B     1           1
#> 7     2      traj1P     1           1
#> 8     2      traj2P     2           1
#> 9     3      traj2B     0           1
#> 10    3      traj2P     1           1
#> 11    3      traj1P     2           1
#> 12    3      traj1P     3           1
#> 13    3      traj2B     1           1
#> 14    4      traj2P     2           1
#> 15    4      traj1P     4           1
#> 16    5      traj2B     0           1
#> 17    5      traj2P     1           1
#> 18    5      traj2B     1           1
#> 19    7      traj2B     0           1
#> 20    7      traj2P     0           1
#> 21    7      traj1B     1           1
#> 22    9      traj1B     0           1
#> 23    9      traj1P     3           1
#> 24    9      traj1B     1           1
#> 25   11      traj1B     0           1
#> 26   11      traj1P     2           1
#> 27   11      traj1B     1           1
#> 28   12      traj2P     1           1
#> 29   13      traj1B     0           1
#> 30   13      traj1P     1           1
#> 31   13      traj1B     1           1
#> 32   15      traj1B     0           1
#> 33   15      traj1P     0           1
#> 34   15      traj2B     1           1
#> 35   17      traj2B     0           1
#> 36   17      traj2P     0           1

zz = env %>%
  get_mon_resources() %>%
 print()
#>    resource time server queue capacity queue_size system limit replication
#> 1       res    1      1     0        1        Inf      1   Inf           1
#> 2       res    2      1     1        1        Inf      2   Inf           1
#> 3       res    2      1     2        1        Inf      3   Inf           1
#> 4       res    3      1     1        1        Inf      2   Inf           1
#> 5       res    3      1     2        1        Inf      3   Inf           1
#> 6       res    3      1     3        1        Inf      4   Inf           1
#> 7       res    4      1     4        1        Inf      5   Inf           1
#> 8       res    4      1     5        1        Inf      6   Inf           1
#> 9       res    5      1     4        1        Inf      5   Inf           1
#> 10      res    7      1     3        1        Inf      4   Inf           1
#> 11      res    9      1     2        1        Inf      3   Inf           1
#> 12      res   11      1     1        1        Inf      2   Inf           1
#> 13      res   12      1     2        1        Inf      3   Inf           1
#> 14      res   13      1     1        1        Inf      2   Inf           1
#> 15      res   15      1     0        1        Inf      1   Inf           1
#> 16      res   17      0     0        1        Inf      0   Inf           1

Created on 2020-07-15 by the reprex package (v0.3.0)

Priorities are a great idea.
Seems to be a good solution.
Why aren´t you convinced?

PS: Same timezone, I´m from Germany :wink:

Not convinced because in the following situation

data1 <- c(2,3,3,4)
data2 <- c(1,3,4)

at time '3' I would like two0 be succeeded by two1 and not by one0 as in

name start_time end_time activity_time finished replication
1 two0          1        3             2     TRUE           1
2 one0          2        5             2     TRUE           1
3 one2          3        7             2     TRUE           1
4 one3          4        9             2     TRUE           1
5 one1          3       11             2     TRUE           1
6 two1          3       13             2     TRUE           1
7 two2          4       15             2     TRUE           1

Concerning your solution: I don't understand it and I can not run it in a fresh R session. See below.
Can you correct that and indicate what your are trying to achieve.
I think that the change in the trajectory that you are doing has only impact on the arrival that started it (but being a beginner in simmer I may be wrong).
But if I can run it maybe I will understand.

library(simmer)
set.seed(2020)

max<-25
data1 <- c(3,3,4)
data2 <- c(2,3,4)
i<-0
readytraj1<-0
readytraj2<-0
env <- simmer("env")

loop1 <- function(){
  a <- env %>% get_mon_arrivals("traj1")
  b <- a["finished"]
  ready <- nrow(b)
  e<-env %>% get_n_generated("traj1")
  queue <- e - ready
  return(queue)
}

loop2 <- function(){
  a <- env %>% get_mon_arrivals("traj2")
  b <- a["finished"]
  ready <- nrow(b)
  e<-env %>% get_n_generated("traj2")
  queue <- e - ready
  return(queue)
}

traj1 <- trajectory("traj1") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1) %>%
  branch(option = function() {round(ifelse(runif(loop1()>0)))},
         continue=c(FALSE, TRUE), 
         join(traj1),
         join(traj2)%>%rollback(amount=7, times = 1,check = NULL)
  )
#> Error in join(traj1): object 'traj1' not found

traj2 <- trajectory("traj2") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1) %>%
  branch(option = function() {round(ifelse(runif(loop2()>0)))},
         continue=c(FALSE, TRUE), 
         join(traj2),
         join(traj1)%>%rollback(amount=7, times = 1,check = NULL)
  )
#> Error in join(traj2): object 'traj2' not found

env %>%
  add_resource("res", 1) %>%
  add_generator("one", traj1, at(c(data1)), mon=2) %>%
  add_generator("two", traj2, at(c(data2)), mon=2)
#> Error in (function (name, env) : object 'traj1' not found

env %>%
  run()
#> simmer environment: env | now: 0 | next: 
#> { Monitor: in memory }
#> { Resource: res | monitored: TRUE | server status: 0(1) | queue status: 0(Inf) }


env %>% get_mon_arrivals()
#> [1] name          start_time    end_time      activity_time finished     
#> <0 rows> (or 0-length row.names)

Created on 2020-07-16 by the reprex package (v0.3.0)

I understand.
But at the moment, I have no solution for it.

My solution unfortunately does not run.
I improved it.
The idea is to model queues as trajectories, in front of the two trajectories.
So I can check the length of both queues and select the right trajectory.

library(simmer)
set.seed(2020)

max<-25
data1 <- c(3,3,4)
data2 <- c(2,3,4)
i<-0
readytraj1<-0
readytraj2<-0
env <- simmer("env")

env %>%
  add_resource("res", 1) %>%
  add_resource("q1", 100) %>%
  add_resource("q2", 100) %>%
  add_generator("one", traj1, at(c(data1)), mon=2) %>%
  add_generator("two", traj2, at(c(data2)), mon=2)


traj1 <- trajectory("traj1") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1)

traj2 <- trajectory("traj2") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1)


traj1 <- trajectory("traj1") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1) %>%
  branch(option = function() {round(ifelse(runif(env %>% get_queue_count("q1")>0)))},
         continue=c(FALSE, TRUE), 
         join(traj2),
         join(traj1)
  )

traj2 <- trajectory("traj2") %>%
  seize("res", 1) %>%
  timeout(task = 1) %>%
  release("res", 1) %>%
  branch(option = function() {round(ifelse(runif(env %>% get_queue_count("q2")>0)))},
         continue=c(FALSE, TRUE),
         join(traj2),
         join(traj1)
  )

queue1 <- trajectory("queue1")%>%
  seize("q1", 1)%>%
  release("q1",1)%>%
  join(traj1)

queue2 <- trajectory("queue2")%>%
  seize("q2", 1)%>%
  release("q2",1)%>%
  join(traj2)

env%>%
  stepn(1)%>%
  print()

env %>%
  run()


env %>% get_queue_count("q1")
env %>% get_queue_count_selected("res")
env %>% get_mon_arrivals()

I do not think it is an improvement: it does not run, just as the previous version. :grinning:
My advice: try to improve step by step and follow the rules of the simmer and R game:

  • for R : it is not allowed to use a variable before you have defined it so you can not use add_generator("one", traj1, at(c(data1)), mon=2) because traj1 is not defined (yet)
  • for simmer : is it allowed/meaningful to have a trajectory of a resource without a generator?
  • step by step: you use the construct
    function() {round(ifelse(runif(env %>% get_queue_count("q1")>0)))}
    If I replace the queue_count part by the constant 4 and set
    x= function() {round(ifelse(runif(4>0)))} ; x()
    I get
    Error in ifelse(runif(4 > 0)) : argument "yes" is missing, with no default
    Also the combination of the functions round, ifelse and runif does not look familiar.
    I think you made too many steps in one time.

If time permits I will have a look at the branch mechanism which is new to me.
However I don't think it can solve the problem of influencing the order of handling of other arrivals.

Thank you very much for your advise.
Its pretty helpful , to understand how the simmer works.
:slight_smile:

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.