simmer-05-simpy.R
In simmer: Discrete-Event Simulation for R

## ----cache = FALSE, include=FALSE---------------------------------------------
knitr::opts_chunk$set(collapse = T, comment = "#>",
                      fig.width = 6, fig.height = 4, fig.align = "center")

## ----message=FALSE, warning=FALSE---------------------------------------------
library(simmer)

NUM_MACHINES <- 2  # Number of machines in the carwash
WASHTIME <- 5      # Minutes it takes to clean a car
T_INTER <- 7       # Create a car every ~7 minutes
SIM_TIME <- 20     # Simulation time in minutes

# setup
set.seed(42)
env <- simmer()

## ----message=FALSE, warning=FALSE---------------------------------------------
car <- trajectory() %>%
  log_("arrives at the carwash") %>%
  seize("wash", 1) %>%
  log_("enters the carwash") %>%
  timeout(WASHTIME) %>%
  set_attribute("dirt_removed", function() sample(50:99, 1)) %>%
  log_(function() 
    paste0(get_attribute(env, "dirt_removed"), "% of dirt was removed")) %>%
  release("wash", 1) %>%
  log_("leaves the carwash")

## ----message=FALSE, warning=FALSE---------------------------------------------
env %>%
  add_resource("wash", NUM_MACHINES) %>%
  # feed the trajectory with 4 initial cars
  add_generator("car_initial", car, at(rep(0, 4))) %>%
  # new cars approx. every T_INTER minutes
  add_generator("car", car, function() sample((T_INTER-2):(T_INTER+2), 1)) %>%
  # start the simulation
  run(SIM_TIME)

## ----message=FALSE, warning=FALSE---------------------------------------------
library(simmer)

PT_MEAN <- 10.0         # Avg. processing time in minutes
PT_SIGMA <- 2.0         # Sigma of processing time
MTTF <- 300.0           # Mean time to failure in minutes
BREAK_MEAN <- 1 / MTTF  # Param. for exponential distribution
REPAIR_TIME <- 30.0     # Time it takes to repair a machine in minutes
JOB_DURATION <- 30.0    # Duration of other jobs in minutes
NUM_MACHINES <- 10      # Number of machines in the machine shop
WEEKS <- 4              # Simulation time in weeks
SIM_TIME <- WEEKS * 7 * 24 * 60  # Simulation time in minutes

# setup
set.seed(42)
env <- simmer()

## ----message=FALSE, warning=FALSE---------------------------------------------
make_parts <- function(machine)
  trajectory() %>%
    seize(machine, 1) %>%
    timeout(function() rnorm(1, PT_MEAN, PT_SIGMA)) %>%
    set_attribute("parts", 1, mod="+") %>%
    rollback(2, Inf) # go to 'timeout' over and over

## ----message=FALSE, warning=FALSE---------------------------------------------
other_jobs <- trajectory() %>%
  seize("repairman", 1) %>%
  timeout(JOB_DURATION) %>%
  rollback(1, Inf)

## ----message=FALSE, warning=FALSE---------------------------------------------
machines <- paste0("machine", 1:NUM_MACHINES-1)

failure <- trajectory() %>%
  select(machines, policy = "random") %>%
  seize_selected(1) %>%
  seize("repairman", 1) %>%
  timeout(REPAIR_TIME) %>%
  release("repairman", 1) %>%
  release_selected(1)

## ----message=FALSE, warning=FALSE---------------------------------------------
for (i in machines) env %>%
  add_resource(i, 1, 0, preemptive = TRUE) %>%
  add_generator(paste0(i, "_worker"), make_parts(i), at(0), mon = 2)

## ----message=FALSE, warning=FALSE---------------------------------------------
env %>%
  add_resource("repairman", 1, Inf, preemptive = TRUE) %>%
  add_generator("repairman_worker", other_jobs, at(0)) %>%
  invisible

## ----message=FALSE, warning=FALSE---------------------------------------------
env %>%
  add_generator("failure", failure, 
                function() rexp(1, BREAK_MEAN * NUM_MACHINES), 
                priority = 1) %>%
  run(SIM_TIME) %>% invisible

## ----message=FALSE, warning=FALSE---------------------------------------------
aggregate(value ~ name, get_mon_attributes(env), max)

## ----message=FALSE, warning=FALSE---------------------------------------------
library(simmer)

TICKETS <- 50     # Number of tickets per movie
SIM_TIME <- 120   # Simulate until
movies <- c("R Unchained", "Kill Process", "Pulp Implementation")

# setup
set.seed(42)
env <- simmer()

## ----message=FALSE, warning=FALSE---------------------------------------------
get_movie <- function() movies[get_attribute(env, "movie")]
soldout_signal <- function() paste0(get_movie(), " sold out")
check_soldout <- function() get_capacity(env, get_movie()) == 0
check_tickets_available <- function()
  get_server_count(env, get_movie()) > (TICKETS - 2)

moviegoer <- trajectory() %>%
  # select a movie
  set_attribute("movie", function() sample(3, 1)) %>%
  select(get_movie) %>%
  # set reneging condition
  renege_if(soldout_signal) %>%
  # leave immediately if the movie was already sold out
  leave(check_soldout) %>%
  # wait for my turn
  seize("counter", 1) %>%
  # buy tickets
  seize_selected(
    function() sample(6, 1), continue = FALSE,
    reject = trajectory() %>%
      timeout(0.5) %>%
      release("counter", 1)
  ) %>%
  # abort reneging condition
  renege_abort() %>%
  # check the tickets available
  branch(
    check_tickets_available, continue = TRUE,
    trajectory() %>%
      set_capacity_selected(0) %>%
      send(soldout_signal)
  ) %>%
  timeout(1) %>%
  release("counter", 1) %>%
  # watch the movie
  wait()

## ----message=FALSE, warning=FALSE---------------------------------------------
# add movies as resources with capacity TICKETS and no queue
for (i in movies) env %>%
  add_resource(i, TICKETS, 0)

# add ticket counter with capacity 1 and infinite queue
env %>% add_resource("counter", 1, Inf)

## ----message=FALSE, warning=FALSE---------------------------------------------
# add a moviegoer generator and start simulation
env %>%
  add_generator("moviegoer", moviegoer, function() rexp(1, 1 / 0.5), mon=2) %>%
  run(SIM_TIME)

## ----message=FALSE, warning=FALSE---------------------------------------------
# get the three rows with the sold out instants
sold_time <- get_mon_resources(env) %>%
  subset(resource != "counter" & capacity == 0)

# get the arrivals that left at the sold out instants
# count the number of arrivals per movie
n_reneges <- get_mon_arrivals(env) %>%
  subset(finished == FALSE & end_time %in% sold_time$time) %>%
  merge(get_mon_attributes(env)) %>%
  transform(resource = movies[value]) %>%
  aggregate(value ~ resource, data=., length)

# merge the info  and print
invisible(apply(merge(sold_time, n_reneges), 1, function(i) {
  cat("Movie '", i["resource"], "' was sold out in ", i["time"], " minutes.\n", 
      "  Number of people that left the queue: ", i["value"], "\n", sep="")
}))

## ----message=FALSE, warning=FALSE---------------------------------------------
library(simmer)

GAS_STATION_SIZE <- 200     # liters
THRESHOLD <- 10             # Threshold for calling the tank truck (in %)
FUEL_TANK_SIZE <- 50        # liters
FUEL_TANK_LEVEL <- c(5, 25) # Min/max levels of fuel tanks (in liters)
REFUELING_SPEED <- 2        # liters / second
TANK_TRUCK_TIME <- 300      # Seconds it takes the tank truck to arrive
T_INTER <- c(30, 100)       # Create a car every [min, max] seconds
SIM_TIME <- 1000            # Simulation time in seconds

# setup
set.seed(42)
env <- simmer()

## ----message=FALSE, warning=FALSE---------------------------------------------
GAS_STATION_LEVEL <- GAS_STATION_SIZE
signal <- "gas station refilled"

refuelling <- trajectory() %>%
  # check if there is enough fuel available
  branch(function() FUEL_TANK_SIZE - get_attribute(env, "level") > GAS_STATION_LEVEL, 
         continue = TRUE,
         # if not, block until the signal "gas station refilled" is received
         trajectory() %>%
           trap(signal) %>%
           wait() %>%
           untrap(signal)
  ) %>%
  # refuel
  timeout(function() {
    liters_required <- FUEL_TANK_SIZE - get_attribute(env, "level")
    GAS_STATION_LEVEL <<- GAS_STATION_LEVEL - liters_required
    return(liters_required / REFUELING_SPEED)
  })

## ----message=FALSE, warning=FALSE---------------------------------------------
car <- trajectory() %>%
  set_attribute(c("start", "level"), function() 
    c(now(env), sample(FUEL_TANK_LEVEL[1]:FUEL_TANK_LEVEL[2], 1))) %>%
  log_("arriving at gas station") %>%
  seize("pump", 1) %>%
  # 'join()' concatenates the refuelling trajectory here
  join(refuelling) %>%
  release("pump", 1) %>%
  log_(function() 
    paste0("finished refuelling in ", now(env) - get_attribute(env, "start"), " seconds"))

## ----message=FALSE, warning=FALSE---------------------------------------------
tank_truck <- trajectory() %>%
  timeout(TANK_TRUCK_TIME) %>%
  log_("tank truck arriving at gas station") %>%
  log_(function() {
    refill <- GAS_STATION_SIZE - GAS_STATION_LEVEL
    GAS_STATION_LEVEL <<- GAS_STATION_SIZE
    paste0("tank truck refilling ", refill, " liters")
  }) %>%
  send(signal)

## ----message=FALSE, warning=FALSE---------------------------------------------
controller <- trajectory() %>%
  branch(function() GAS_STATION_LEVEL / GAS_STATION_SIZE * 100 < THRESHOLD, 
         continue = TRUE,
         trajectory() %>%
           log_("calling the tank truck") %>%
           join(tank_truck)
  ) %>%
  timeout(10) %>%
  rollback(2, Inf)

## ----message=FALSE, warning=FALSE---------------------------------------------
env %>%
  add_resource("pump", 2) %>%
  add_generator("controller", controller, at(0)) %>%
  add_generator("car", car, function() sample(T_INTER[1]:T_INTER[2], 1)) %>%
  run(SIM_TIME)