Nothing
## ----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)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.