# Copyright (C) 2014-2015 Bart Smeets
# Copyright (C) 2015-2016 Bart Smeets and Iñaki Ucar
# Copyright (C) 2016-2024 Iñaki Ucar
#
# This file is part of simmer.
#
# simmer is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# simmer is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with simmer. If not, see <http://www.gnu.org/licenses/>.
#' Create a Simulator
#'
#' This method initialises a simulation environment.
#'
#' @param name the name of the simulator.
#' @param verbose enable showing activity information.
#' @param mon monitor (in memory by default); see \code{\link{monitor}} for
#' other options.
#' @param log_level debugging level (see \code{\link{log_}}).
#'
#' @return Returns a simulation environment.
#' @seealso
#' Available methods by category:
#' \itemize{
#'
#' \item Simulation control: \code{\link{stepn}}, \code{\link{run}},
#' \code{\link{now}}, \code{\link{peek}}, \code{\link{reset}}
#'
#' \item Resources: \code{\link{add_resource}}, \code{\link{get_resources}},
#' \code{\link{get_capacity}}, \code{\link{get_capacity_selected}},
#' \code{\link{get_queue_size}}, \code{\link{get_queue_size_selected}},
#' \code{\link{get_server_count}}, \code{\link{get_server_count_selected}},
#' \code{\link{get_queue_count}}, \code{\link{get_queue_count_selected}},
#' \code{\link{get_seized}}, \code{\link{get_seized_selected}},
#' \code{\link{get_activity_time}}, \code{\link{get_activity_time_selected}},
#' \code{\link{get_selected}}
#'
#' \item Sources: \code{\link{add_generator}}, \code{\link{add_dataframe}},
#' \code{\link{get_sources}}, \code{\link{get_n_generated}},
#' \code{\link{get_trajectory}}
#'
#' \item Arrivals: \code{\link{get_name}}, \code{\link{get_start_time}},
#' \code{\link{get_attribute}}, \code{\link{get_prioritization}},
#' \code{\link{get_batch_size}}
#'
#' \item Globals: \code{\link{add_global}}, \code{\link{get_global}}
#'
#' \item Data retrieval: \code{\link{get_mon_arrivals}},
#' \code{\link{get_mon_attributes}}, \code{\link{get_mon_resources}}
#'
#' }
#'
#' @export
#'
#' @examples
#' ## a simple trajectory that prints a message
#' t0 <- trajectory("my trajectory") %>%
#' log_("arrival generated")
#'
#' ## create an empty simulation environment
#' env <- simmer("SuperDuperSim")
#' env
#'
#' ## add a generator and attach it to the trajectory above
#' env %>% add_generator("dummy", t0, function() 1)
#'
#' ## run for some time
#' env %>% run(until=4.5)
#' env %>% now() # current simulation time
#' env %>% peek() # time for the next event
#' env %>% stepn() # execute next event
#'
simmer <- function(name="anonymous", verbose=FALSE, mon=monitor_mem(), log_level=0) {
check_args(name="character", verbose="flag", mon="monitor", log_level="numeric")
env <- list2env(list(
name=name, mon=mon, resources=list(), sources=list(), globals=list(),
sim_obj=Simulator__new(name, verbose, mon$xptr, positive(log_level))
), parent = asNamespace("simmer"))
class(env) <- "simmer"
env
}
#' @export
print.simmer <- function(x, ...) {
cat(paste0(
"simmer environment: ", x$name,
" | now: ", now(x), " | next: ", peek(x), "\n",
"{ Monitor: ", x$mon$name, " }\n"
))
for (name in names(x$mon$handlers)) cat(paste0(
" { ", name, ": ", x$mon$handlers[[name]], " }\n"
))
for (name in names(x$resources)) cat(paste0(
"{ Resource: ", name,
" | monitored: ", x$resources[[name]][["mon"]],
" | server status: ", get_server_count(x, name),
"(", get_capacity(x, name), ")",
" | queue status: ", get_queue_count(x, name),
"(", get_queue_size(x, name), ") }\n"
))
for (name in names(x$sources)) cat(paste0(
"{ Source: ", name,
" | monitored: ", x$sources[[name]][["mon"]],
" | n_generated: ", get_n_generated(x, name), " }\n"
))
for (name in names(x$globals)) {
value <- x$globals[[name]]
is_schedule <- inherits(value, "schedule")
if (is_schedule) value <- value$schedule$init
cat(paste0(
"{ Global: ", name, " | schedule: ", is_schedule,
" | initial value: ", value, " }\n"
))
}
invisible(x)
}
#' Reset a Simulator
#'
#' Reset the following components of a simulation environment:
#' time, event queue, resources, sources and statistics.
#'
#' @param .env the simulation environment.
#'
#' @return Returns the simulation environment.
#' @seealso \code{\link{stepn}}, \code{\link{run}}.
#' @export
reset <- function(.env) UseMethod("reset")
#' @export
reset.simmer <- function(.env) {
reset_(.env$sim_obj)
.env
}
#' Run a Simulation
#'
#' Execute steps until a given criterion.
#'
#' @inheritParams reset
#' @param until stop time.
#' @param progress optional callback to show the progress of the simulation. The
#' completed ratio is periodically passed as argument to the callback.
#' @param steps number of steps to show as progress (it takes effect only if
#' \code{progress} is provided).
#'
#' @examples
#' ## show the progress just printing the steps
#' simmer() %>%
#' run(progress=message, steps=5)
#'
#' ## using the 'progress' package
#' \dontrun{
#' mm1 <- trajectory() %>%
#' seize("server", 1) %>%
#' timeout(function() rexp(1, 66)) %>%
#' release("server", 1)
#'
#' simmer() %>%
#' add_resource("server", 1) %>%
#' add_generator("customer", mm1, function() rexp(100, 60)) %>%
#' run(3000, progress=progress::progress_bar$new()$update)
#' }
#'
#' @return Returns the simulation environment.
#' @seealso \code{\link{reset}}.
#' @export
run <- function(.env, until=Inf, progress=NULL, steps=10) UseMethod("run")
#' @export
run.simmer <- function(.env, until=Inf, progress=NULL, steps=10) {
check_args(until="numeric", progress=c("function", "NULL"), steps="numeric")
until <- positive(until)
steps <- positive(steps)
if (is.function(progress)) {
progress(0)
for (i in seq(until/steps, until, until/steps)) {
run_(.env$sim_obj, i)
progress(i/until)
}
} else run_(.env$sim_obj, until)
.env
}
#' @rdname run
#' @param n number of events to simulate.
#' @export
stepn <- function(.env, n=1) UseMethod("stepn")
#' @export
stepn.simmer <- function(.env, n=1) {
stepn_(.env$sim_obj, n)
.env
}
#' Simulation Time
#'
#' Get the current simulation time.
#'
#' @inheritParams reset
#'
#' @return Returns a numeric value.
#' @seealso \code{\link{peek}}.
#' @export
now <- function(.env) UseMethod("now")
#' @export
now.simmer <- function(.env) now_(.env$sim_obj)
#' Peek Next Events
#'
#' Look for future events in the event queue and (optionally) obtain info about them.
#'
#' @inheritParams reset
#' @param steps number of steps to peek.
#' @param verbose show additional information (i.e., the name of the process)
#' about future events.
#'
#' @return Returns numeric values if \code{verbose=F} and a data frame otherwise.
#' @seealso \code{\link{now}}.
#' @export
peek <- function(.env, steps=1, verbose=FALSE) UseMethod("peek")
#' @export
peek.simmer <- function(.env, steps=1, verbose=FALSE) {
check_args(steps="numeric", verbose="flag")
ret <- peek_(.env$sim_obj, positive(steps))
if (!verbose) ret$time
else ret # nocov
}
#' Add a Resource
#'
#' Define a new resource in a simulation environment. Resources are conceived
#' with queuing systems in mind, and therefore they comprise two internal
#' self-managed parts: a \emph{server}, which is the active part, with a
#' specified capacity that can be seized and released (see \code{\link{seize}});
#' and a priority \emph{queue} of a certain size, in which arrivals may wait for
#' the server to be available.
#'
#' @inheritParams reset
#' @param name the name of the resource. If several names are provided, several
#' resources will be defined with the same parameters.
#' @param capacity the capacity of the server, either an integer or a
#' \code{\link{schedule}}, so that the value may change during the simulation.
#' @param queue_size the size of the queue, either an integer or a
#' \code{\link{schedule}}, so that the value may change during the simulation.
#' @param mon whether the simulator must monitor this resource or not.
#' @param preemptive whether arrivals in the server can be preempted or not based
#' on seize priorities.
#' @param preempt_order if \code{preemptive=TRUE} and several arrivals are
#' preempted, this parameter defines which arrival should be preempted first.
#' Either \code{fifo} (First In First Out: older preemptible tasks are preempted
#' first) or \code{lifo} (Last In First Out: newer preemptible tasks are
#' preempted first).
#' @param queue_size_strict whether the \code{queue_size} is a hard limit (see
#' details).
#' @param queue_priority the priority range required to be able to access the
#' queue if there is no room in the server (if a single value is provided, it is
#' treated as the minimum priority). By default, all arrivals can be enqueued.
#'
#' @details An entity trying to seize a resource (see \code{\link{seize}}) may
#' 1) access the server straightaway if there is enough capacity, 2) wait in the
#' queue if there is no room in the server but there is room in the queue, or 3)
#' rejected if there is no room in the queue either.
#'
#' There are two special situations regarding queue management: 1) the
#' \code{queue_size} is shrinked below the actual number of items waiting, and
#' 2) preemption occurs, and an item previously in the server goes to the queue.
#' By default in both cases, the excess of items in the queue is allowed.
#' However, with \code{queue_size_strict=TRUE}, the maximum \code{queue_size} is
#' guaranteed, and thus some entities will be rejected (dropped) by the resource.
#'
#' Whenever an arrival is rejected (due to a server drop or a queue drop), it
#' will set the \code{finished} flag to \code{FALSE} in the output of
#' \code{\link{get_mon_arrivals}}. Unfinished arrivals can be handled with a
#' drop-out trajectory that can be set using the \code{\link{handle_unfinished}}
#' activity.
#'
#' @return Returns the simulation environment.
#' @seealso Convenience functions: \code{\link{schedule}}.
#' @export
add_resource <- function(.env, name, capacity=1, queue_size=Inf, mon=TRUE,
preemptive=FALSE, preempt_order=c("fifo", "lifo"),
queue_size_strict=FALSE, queue_priority=c(0, Inf))
UseMethod("add_resource")
#' @export
add_resource.simmer <- function(.env, name, capacity=1, queue_size=Inf, mon=TRUE,
preemptive=FALSE, preempt_order=c("fifo", "lifo"),
queue_size_strict=FALSE, queue_priority=c(0, Inf))
{
check_args(
name="character", capacity=c("numeric", "schedule"),
queue_size=c("numeric", "schedule"), mon="flag", preemptive="flag",
queue_size_strict="flag", queue_priority="numeric")
preempt_order <- match.arg(preempt_order)
if (length(queue_priority) == 1)
queue_priority <- c(queue_priority, Inf)
queue_priority <- positive(queue_priority)
if (length(queue_priority) != 2 ||
!(queue_priority[2] < 0 || queue_priority[2]-queue_priority[1] >= 0))
stop(get_caller(), ": 'queue_priority' is not a valid numeric range", call.=FALSE)
if (inherits(capacity, "schedule")) {
capacity_schedule <- capacity
capacity <- NA
} else capacity_schedule <- NA
if (inherits(queue_size, "schedule")) {
queue_size_schedule <- queue_size
queue_size <- NA
} else queue_size_schedule <- NA
for (i in name) {
ret <- add_resource_(.env$sim_obj, i, positive(capacity), positive(queue_size),
mon, preemptive, preempt_order, queue_size_strict,
queue_priority[1], queue_priority[2])
if (ret) .env$resources[[i]] <- c(mon=mon, preemptive=preemptive)
if (inherits(capacity_schedule, "schedule"))
add_resource_manager_(.env$sim_obj, i, "capacity",
positive(capacity_schedule$schedule$init),
capacity_schedule$schedule$intervals,
capacity_schedule$schedule$values,
capacity_schedule$schedule$period)
if (inherits(queue_size_schedule, "schedule"))
add_resource_manager_(.env$sim_obj, i, "queue_size",
positive(queue_size_schedule$schedule$init),
queue_size_schedule$schedule$intervals,
queue_size_schedule$schedule$values,
queue_size_schedule$schedule$period)
}
.env
}
#' Add a Generator
#'
#' Attach a new source of arrivals to a trajectory from a generator function.
#'
#' @inheritParams reset
#' @param name_prefix the name prefix of the generated arrivals. If several
#' names are provided, several generators will be defined with the same parameters.
#' @param trajectory the trajectory that the generated arrivals will follow (see
#' \code{\link{trajectory}}).
#' @param distribution a function modelling the interarrival times (returning a
#' negative value or a missing value stops the generator).
#' @param mon whether the simulator must monitor the generated arrivals or not
#' (0 = no monitoring, 1 = simple arrival monitoring, 2 = level 1 + arrival
#' attribute monitoring)
#' @param priority the priority of each arrival (a higher integer equals higher
#' priority; defaults to the minimum priority, which is 0).
#' @param preemptible if a seize occurs in a preemptive resource, this parameter
#' establishes the minimum incoming priority that can preempt these arrivals (an
#' arrival with a priority greater than \code{preemptible} gains the resource). In
#' any case, \code{preemptible} must be equal or greater than \code{priority}, and
#' thus only higher priority arrivals can trigger preemption.
#' @param restart whether the activity must be restarted after being preempted.
#'
#' @return Returns the simulation environment.
#' @seealso Convenience functions: \code{\link{at}}, \code{\link{from}},
#' \code{\link{to}}, \code{\link{from_to}}, \code{\link{when_activated}}.
#'
#' Other sources: \code{\link{add_dataframe}}.
#' @export
add_generator <- function(.env, name_prefix, trajectory, distribution, mon=1,
priority=0, preemptible=priority, restart=FALSE)
UseMethod("add_generator")
#' @export
add_generator.simmer <- function(.env, name_prefix, trajectory, distribution, mon=1,
priority=0, preemptible=priority, restart=FALSE)
{
check_args(name_prefix="character", trajectory="trajectory",
distribution="function", mon="flag", priority="numeric",
preemptible="numeric", restart="flag")
trajectory <- trajectory[]
distribution <- make_resetable(distribution)
for (i in name_prefix) {
ret <- add_generator_(.env$sim_obj, i, trajectory, distribution, mon,
positive(priority), positive(preemptible), restart)
if (ret) .env$sources[[i]] <- c(mon=mon)
}
.env
}
#' Add a Data Frame
#'
#' Attach a new source of arrivals to a trajectory from a data frame.
#'
#' @inheritParams add_generator
#' @param name_prefix the name prefix of the generated arrivals.
#' @param data a data frame with, at least, a column of (inter)arrival times (see details).
#' @param batch number of arrivals generated at a time. Arrivals are read from
#' the data frame and attached to the trajectory in batches depending on this
#' value. In general, it should not be changed.
#' @param col_time name of the time column in the data frame.
#' @param time type of time column: \emph{interarrival}, if the time column
#' contains interarrival times, or \emph{absolute}, if the time column contains
#' absolute arrival times.
#' @param col_attributes vector of names of the attributes columns (see details).
#' @param col_priority name of the priority column.
#' @param col_preemptible name of the preemptible column.
#' @param col_restart name of the restart column.
#'
#' @return Returns the simulation environment.
#'
#' @details The data frame provided must have, at least, a column of (inter)arrival
#' times. This method will look for it under the name \code{"time"} by default,
#' although this can be changed with the \code{col_time} parameter.
#'
#' If there is any column named \code{col_priority="priority"},
#' \code{col_preemptible=priority} or \code{col_restart="restart"}, they will be
#' used to set the prioritization values for each arrival (see \code{\link{add_generator}}).
#'
#' If there are additional columns (with \code{col_attributes=NULL}, by default),
#' they will be assigned to arrival attributes named after each column name. All
#' these columns must be numeric (or logical). Otherwise, if a vector of column
#' names is specified, only these will be assigned as attributes and the rest of
#' the columns will be ignored.
#'
#' A value of \code{batch=Inf} means that the whole data frame will be attached
#' at the beginning of the simulation. This is not desirable in general, because
#' the performance of the event queue is degraded when it is populated with too
#' many events. On the other hand, a low value results in an increased overhead
#' due to many function calls. The default value has been tested to provide a
#' good trade-off.
#'
#' @seealso Other sources: \code{\link{add_generator}}.
#' @export
add_dataframe <- function(.env, name_prefix, trajectory, data, mon=1, batch=50,
col_time="time", time=c("interarrival", "absolute"),
col_attributes=NULL, col_priority="priority",
col_preemptible=col_priority, col_restart="restart")
UseMethod("add_dataframe")
#' @export
add_dataframe.simmer <- function(.env, name_prefix, trajectory, data, mon=1, batch=50,
col_time="time", time=c("interarrival", "absolute"),
col_attributes=NULL, col_priority="priority",
col_preemptible=col_priority, col_restart="restart")
{
check_args(
name_prefix="character", trajectory="trajectory", data="data.frame",
mon="flag", batch="numeric", col_time="character",
col_attributes=c("character", "NULL"), col_priority=c("character", "NULL"),
col_preemptible=c("character", "NULL"), col_restart=c("character", "NULL"))
time <- match.arg(time)
col_attributes <- as.character(col_attributes)
col_priority <- intersect(col_priority, names(data))
col_preemptible <- intersect(col_preemptible, names(data))
col_restart <- intersect(col_restart, names(data))
col_names <- c(col_time, col_priority, col_preemptible, col_restart, col_attributes)
col_undef <- setdiff(col_names, names(data))
if (length(col_undef))
stop(get_caller(), ": columns '", paste0(col_undef, collapse="', '"),
"' are not defined in ", as.character(substitute(data)), call.=FALSE)
if (!length(col_attributes)) {
col_attributes <- setdiff(names(data), col_names)
col_names <- c(col_names, col_attributes)
}
for (col_name in col_names) {
if (!(is.numeric(data[[col_name]]) || is.logical(data[[col_name]])))
stop(get_caller(), ": column '", col_name, "' is not numeric", call.=FALSE)
}
if (any(is.na(data[[col_time]])) || any(data[[col_time]] < 0))
stop(get_caller(), ": time must be positive", call.=FALSE)
if (time == "absolute") {
if (is.unsorted(data[[col_time]]))
stop(get_caller(), ": unsorted absolute time provided", call.=FALSE)
data[[col_time]] <- c(data[[col_time]][1], diff(data[[col_time]]))
}
ret <- add_dataframe_(
.env$sim_obj, name_prefix, trajectory[], data, mon, positive(batch),
col_time, col_attributes, col_priority, col_preemptible, col_restart)
if (ret) .env$sources[[name_prefix]] <- c(mon=mon)
.env
}
#' Add a Global Attribute
#'
#' Attach a global variable to the simulation.
#'
#' @inheritParams reset
#' @param key the attribute name.
#' @param value the value to set, either a numeric or a \code{\link{schedule}},
#' so that the global may change during the simulation.
#'
#' @return Returns the simulation environment.
#' @seealso Convenience functions: \code{\link{schedule}}.
#' @export
add_global <- function(.env, key, value) UseMethod("add_global")
#' @export
add_global.simmer <- function(.env, key, value) {
check_args(key="character", value=c("numeric", "schedule"))
intervals <- values <- numeric(0); period <- -1
if (inherits(value, "schedule")) {
intervals <- value$schedule$intervals
values <- value$schedule$values
period <- value$schedule$period
value <- value$schedule$init
}
ret <- add_global_manager_(.env$sim_obj, key, value, intervals, values, period)
if (ret) .env$globals[[key]] <- value
.env
}
#' Monitoring Statistics
#'
#' Getters for obtaining monitored data (if any) about arrivals, attributes and resources.
#'
#' @param .envs the simulation environment (or a list of environments).
#' @param per_resource if \code{TRUE}, statistics will be reported on a per-resource basis.
#' @param ongoing if \code{TRUE}, ongoing arrivals will be reported. The columns
#' \code{end_time} and \code{finished} of these arrivals are reported as \code{NA}s.
#'
#' @return Returns a data frame.
#' @name get_mon
#' @export
get_mon_arrivals <- function(.envs, per_resource=FALSE, ongoing=FALSE)
UseMethod("get_mon_arrivals", unlist(list(.envs))[[1]])
#' @export
get_mon_arrivals.simmer <- function(.envs, per_resource=FALSE, ongoing=FALSE) {
envs_apply(.envs, function(x) {
out <- x$mon$get_arrivals(per_resource)
if (ongoing)
out <- rbind(out, get_ongoing_(x$sim_obj, per_resource))
out
})
}
#' @rdname get_mon
#' @export
get_mon_attributes <- function(.envs)
UseMethod("get_mon_attributes", unlist(list(.envs))[[1]])
#' @export
get_mon_attributes.simmer <- function(.envs) {
envs_apply(.envs, function(x) x$mon$get_attributes())
}
#' @rdname get_mon
#' @export
get_mon_resources <- function(.envs)
UseMethod("get_mon_resources", unlist(list(.envs))[[1]])
#' @export
get_mon_resources.simmer <- function(.envs) {
envs_apply(.envs, function(x) {
monitor_data <- x$mon$get_resources()
monitor_data$capacity <-
replace(monitor_data$capacity, monitor_data$capacity == -1, Inf)
monitor_data$queue_size <-
replace(monitor_data$queue_size, monitor_data$queue_size == -1, Inf)
monitor_data$system <- monitor_data$server + monitor_data$queue
monitor_data$limit <- monitor_data$capacity + monitor_data$queue_size
monitor_data
})
}
#' Get Sources and Resources Defined
#'
#' Get a list of names of sources or resources defined in a simulation environment.
#'
#' @inheritParams reset
#'
#' @return A character vector.
#' @export
get_sources <- function(.env) UseMethod("get_sources")
#' @export
get_sources.simmer <- function(.env) names(.env$sources)
#' @rdname get_sources
#' @export
get_resources <- function(.env) UseMethod("get_resources")
#' @export
get_resources.simmer <- function(.env) names(.env$resources)
#' Get Process Parameters
#'
#' Getters for processes (sources and arrivals) number of arrivals generated
#' by a source, the name of the active arrival, an attribute from the active
#' arrival or a global one, prioritization values, or the number of arrivals
#' in an active batch.
#'
#' @inheritParams reset
#' @param sources one or more resource names.
#'
#' @details \code{get_n_generated} returns the number of arrivals generated by
#' the given sources. \code{get_trajectory} returns the trajectory to which they
#' are attached (as a list).
#'
#' \code{get_name} returns the number of the running arrival.
#' \code{get_start_time} returns the start time of the running arrival.
#' \code{get_attribute} returns a running arrival's attributes.
#' If a provided key was not previously set, it returns a missing value.
#' \code{get_global} returns a global attribute.
#' \code{get_prioritization} returns a running arrival's prioritization values.
#' \code{get_name}, \code{get_start_time}, \code{get_attribute} and
#' \code{get_prioritization} are meant to be used inside a trajectory; otherwise,
#' there will be no arrival running and these functions will throw an error.
#'
#' @seealso \code{\link{get_sources}}, \code{\link{set_trajectory}},
#' \code{\link{set_attribute}}, \code{\link{set_global}},
#' \code{\link{set_prioritization}}, \code{\link{batch}}.
#' @export
get_n_generated <- function(.env, sources) UseMethod("get_n_generated")
#' @export
get_n_generated.simmer <- function(.env, sources) {
get_n_generated_(.env$sim_obj, sources)
}
#' @rdname get_n_generated
#' @export
get_trajectory <- function(.env, sources) UseMethod("get_trajectory")
#' @export
get_trajectory.simmer <- function(.env, sources) {
lapply(get_trajectory_(.env$sim_obj, sources), "[")
}
#' @rdname get_n_generated
#' @export
get_name <- function(.env) UseMethod("get_name")
#' @export
get_name.simmer <- function(.env) get_name_(.env$sim_obj)
#' @rdname get_n_generated
#' @export
get_start_time <- function(.env) UseMethod("get_start_time")
#' @export
get_start_time.simmer <- function(.env) get_start_time_(.env$sim_obj)
#' @param keys the attribute name(s).
#' @inheritParams set_attribute
#'
#' @rdname get_n_generated
#' @export
get_attribute <- function(.env, keys) UseMethod("get_attribute")
#' @export
get_attribute.simmer <- function(.env, keys) {
get_attribute_(.env$sim_obj, keys, FALSE)
}
#' @rdname get_n_generated
#' @export
get_global <- function(.env, keys) UseMethod("get_global")
#' @export
get_global.simmer <- function(.env, keys) {
get_attribute_(.env$sim_obj, keys, TRUE)
}
#' @rdname get_n_generated
#' @export
get_prioritization <- function(.env) UseMethod("get_prioritization")
#' @export
get_prioritization.simmer <- function(.env) get_prioritization_(.env$sim_obj)
#' @rdname get_n_generated
#' @export
get_batch_size <- function(.env) UseMethod("get_batch_size")
#' @export
get_batch_size.simmer <- function(.env) get_batch_size_(.env$sim_obj)
#' Get Resource Parameters
#'
#' Getters for resources: server capacity/count and queue size/count, seized
#' amount, activity time, and selected resources.
#'
#' @inheritParams reset
#' @inheritParams select
#' @param resources one or more resource names.
#'
#' @details If no resources are provided to \code{get_activity_time}, the
#' overall activity time is reported.
#'
#' @return Return a vector (character for \code{get_selected}, numeric for the
#' rest of them).
#' @seealso \code{\link{get_resources}}, \code{\link{set_capacity}},
#' \code{\link{set_queue_size}}, \code{\link{seize}}, \code{\link{timeout}}.
#' @export
get_capacity <- function(.env, resources) UseMethod("get_capacity")
#' @export
get_capacity.simmer <- function(.env, resources) {
ret <- get_capacity_(.env$sim_obj, resources)
replace(ret, ret < 0, Inf)
}
#' @rdname get_capacity
#' @export
get_capacity_selected <- function(.env, id=0) UseMethod("get_capacity_selected")
#' @export
get_capacity_selected.simmer <- function(.env, id=0) {
ret <- get_capacity_selected_(.env$sim_obj, id)
replace(ret, ret < 0, Inf)
}
#' @rdname get_capacity
#' @export
get_queue_size <- function(.env, resources) UseMethod("get_queue_size")
#' @export
get_queue_size.simmer <- function(.env, resources) {
ret <- get_queue_size_(.env$sim_obj, resources)
replace(ret, ret < 0, Inf)
}
#' @rdname get_capacity
#' @export
get_queue_size_selected <- function(.env, id=0) UseMethod("get_queue_size_selected")
#' @export
get_queue_size_selected.simmer <- function(.env, id=0) {
ret <- get_queue_size_selected_(.env$sim_obj, id)
replace(ret, ret < 0, Inf)
}
#' @rdname get_capacity
#' @export
get_server_count <- function(.env, resources) UseMethod("get_server_count")
#' @export
get_server_count.simmer <- function(.env, resources) {
get_server_count_(.env$sim_obj, resources)
}
#' @rdname get_capacity
#' @export
get_server_count_selected <- function(.env, id=0) UseMethod("get_server_count_selected")
#' @export
get_server_count_selected.simmer <- function(.env, id=0) {
get_server_count_selected_(.env$sim_obj, id)
}
#' @rdname get_capacity
#' @export
get_queue_count <- function(.env, resources) UseMethod("get_queue_count")
#' @export
get_queue_count.simmer <- function(.env, resources) {
get_queue_count_(.env$sim_obj, resources)
}
#' @rdname get_capacity
#' @export
get_queue_count_selected <- function(.env, id=0) UseMethod("get_queue_count_selected")
#' @export
get_queue_count_selected.simmer <- function(.env, id=0) {
get_queue_count_selected_(.env$sim_obj, id)
}
#' @rdname get_capacity
#' @export
get_seized <- function(.env, resources) UseMethod("get_seized")
#' @export
get_seized.simmer <- function(.env, resources) {
get_seized_(.env$sim_obj, resources)
}
#' @rdname get_capacity
#' @export
get_seized_selected <- function(.env, id=0) UseMethod("get_seized_selected")
#' @export
get_seized_selected.simmer <- function(.env, id=0) {
get_seized_selected_(.env$sim_obj, id)
}
#' @rdname get_capacity
#' @export
get_activity_time <- function(.env, resources) UseMethod("get_activity_time")
#' @export
get_activity_time.simmer <- function(.env, resources) {
if (missing(resources))
resources <- character(0)
get_activity_time_(.env$sim_obj, resources)
}
#' @rdname get_capacity
#' @export
get_activity_time_selected <- function(.env, id=0) UseMethod("get_activity_time_selected")
#' @export
get_activity_time_selected.simmer <- function(.env, id=0) {
get_activity_time_selected_(.env$sim_obj, id)
}
#' @rdname get_capacity
#' @export
get_selected <- function(.env, id=0) UseMethod("get_selected")
#' @export
get_selected.simmer <- function(.env, id=0) get_selected_(.env$sim_obj, id)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.