Nothing
#' @include simulation-class.R
NULL
#' Get one or more models from a simulation
#'
#' Returns either the models themselves or references to them.
#'
#' There are two main ways to specify a subset of the models. (1) The easiest
#' way is by writing a conditional expression involving the parameters and
#' passing it through \code{...}. For example, \code{n > 100 & p <= 20}.
#' Only parameters that are length one and either numeric or character can be
#' used in these expressions. (2) The faster way to retrieve a subset of
#' models is to use the \code{subset} argument. This can be either a set of
#' numerical values (specifying which models to load based on the order in
#' which the models are stored in the simulation object. This order can be
#' ascertained by printing the simulation object.) or as a set of a character
#' vector of the model names desired.
#'
#' While approach (1) is very convenient, it requires loading all models from
#' file. This may be slow in situations in which there are a lot of models
#' and/or the models are large and thus slow to load.
#'
#' @param sim a simulation object
#' @param ... logical conditions to specify a subset of models. Conditions can
#' only involve params of model that have length 1 and are of class
#' numeric or character.
#' @param subset a vector of integers indexing the models or a vector of model
#' names. To select models based on parameter values, use \code{...}.
#' However, using \code{...} is slower than using subset.
#' @param reference whether to return the ModelRef or the Model object itself
#' @export
model <- function(sim, ..., subset = NULL, reference = FALSE) {
ii <- get_model_indices(sim, subset)
mref <- sim@model_refs[ii]
obj <- lapply(mref, function(m) {
m@dir <- normalizePath(file.path(sim@dir, m@dir), winslash = "/")
return(m)
})
if (length(obj) == 1) obj <- obj[[1]]
passed_a_condition <- length(match.call(expand.dots = FALSE)$`...`) != 0
if (!passed_a_condition) {
if (reference)
return(obj)
else
return(load(obj))
}
# if a condition was passed, we have to load the models to apply condition
obj1 <- load(obj)
model_names <- subset_models(obj1, ...)
if (length(obj1) == 1) {
if (obj1@name %in% model_names) {
if (reference) {
return(obj)
} else {
return(obj1)
}
} else {
return(list())
}
}
to_return <- unlist(lapply(mref, function(mm) mm@name %in% model_names))
if (reference)
obj <- obj[to_return]
else
obj <- obj1[to_return]
if (length(obj) == 1)
return(obj[[1]])
else
return(obj)
}
#' Get one or more draws from a simulation
#'
#' Returns either the draws objects themselves or references to them. See
#' \code{\link{model}} function for more information on the \code{...} and
#' \code{subset} arguments, which are used to specify a subset of the models.
#'
#' @param sim a simulation object
#' @param ... logical conditions to specify a subset of models. Conditions can
#' only involve params of model that have length 1 and are of class
#' numeric or character.
#' @param subset a vector of integers indexing the models or a vector of model
#' names. To select models based on parameter values, use \code{...}.
#' However, using \code{...} is slower than using subset.
#' @param index a vector of positive integers specifying which draws objects
#' are desired. If missing, then all draws' outputs are returned.
#' @param reference whether to return the ModelRef or the Model object itself
#' @export
#' @examples
#' \dontrun{
#' # suppose previously we had run the following:
#' sim <- new_simulation(name = "normal-example",
#' label = "Normal Mean Estimation",
#' dir = tempdir()) %>%
#' generate_model(make_my_example_model, n = 20) %>%
#' simulate_from_model(nsim = 50, index = 1:3)
#' # then we could get the simulated draws as follows:
#' d <- draws(sim)
#' d@draws$r1.1 # first random draw
#' }
draws <- function(sim, ..., subset = NULL, index, reference = FALSE) {
if (!missing(index))
stopifnot(is.numeric(index), index > 0, index == round(index))
if (length(sim@draws_refs) == 0) return(list())
dref <- sim@draws_refs
mref <- model(sim, ..., subset = subset, reference = TRUE)
if (length(mref) == 1) mref <- list(mref)
subset_model_names <- unlist(lapply(mref, function(ref) ref@name))
obj <- list()
for (i in seq_along(dref)) {
if (length(dref[[i]]) == 0) next # no draws are in this model
if (!(dref[[i]][[1]]@model_name %in% subset_model_names))
next # subset excluded this model
# this model's draws should be included (if they match the index)
obj[[i]] <- dref[[i]]
keep <- rep(FALSE, length(dref[[i]]))
for (j in seq_along(dref[[i]])) {
if (!missing(index)) {
if (any(dref[[i]][[j]]@index %in% index)) {
# only include the desired indices in the DrawsRef
obj[[i]][[j]]@index <- intersect(obj[[i]][[j]]@index, index)
keep[j] <- TRUE
}
}
# each object's dir should no longer be relative to sim's dir
obj[[i]][[j]]@dir <- normalizePath(file.path(sim@dir,
obj[[i]][[j]]@dir),
winslash = "/")
}
if (!missing(index)) obj[[i]] <- obj[[i]][keep]
}
if (length(obj) == 0) return(list())
obj <- obj[!unlist(lapply(obj, is.null))]
if (length(obj) == 1) obj <- obj[[1]]
if (!reference) obj <- load(obj)
return(obj)
}
#' Get one or more outputs from a simulation
#'
#' Returns either the output object itself or a reference to it.
#'
#' @param sim a simulation object
#' @param ... logical conditions to specify a subset of models. Conditions can
#' only involve params of model that have length 1 and are of class
#' numeric or character.
#' @param subset a vector of integers indexing the models or a vector of model
#' names. To select models based on parameter values, use \code{...}.
#' However, using \code{...} is slower than using subset.
#' @param index a vector of positive integers specifying which draws' objects
#' are desired. If missing, then all draws' outputs are returned.
#' @param methods character vector of method names of interest. If missing,
#' then all methods' outputs are returned
#' @param reference whether to return the ModelRef or the Model object itself
#' @export
#' @examples
#' \dontrun{
#' # suppose previously we had run the following:
#' sim <- new_simulation(name = "normal-example",
#' label = "Normal Mean Estimation",
#' dir = tempdir()) %>%
#' generate_model(make_my_example_model, n = 20) %>%
#' simulate_from_model(nsim = 50, index = 1:3) %>%
#' run_method(my_example_method)
#' # then we could get the method's output as follows:
#' o <- output(sim)
#' o@out$r1.1 # first random draw's output
#' }
output <- function(sim, ..., subset = NULL, index, methods,
reference = FALSE) {
outputs_or_evals(sim, sim@output_refs, TRUE, subset, index, methods,
reference, ...)
}
#' Get one or more evals from a simulation
#'
#' Returns either the Evals object itself or a reference to it.
#'
#' @param sim a simulation object
#' @param ... logical conditions to specify a subset of models. Conditions can
#' only involve params of model that have length 1 and are of class
#' numeric or character.
#' @param subset a vector of integers indexing the models or a vector of model
#' names. To select models based on parameter values, use \code{...}.
#' However, using \code{...} is slower than using subset.
#' @param index a vector of positive integers specifying which draws' objects
#' are desired. If missing, then all draws' evals are returned.
#' @param methods character vector of method names of interest. If missing,
#' then all methods' evals are returned
#' @param reference whether to return the ModelRef or the Model object itself
#' @export
#' @seealso \code{\link{as.data.frame}}
#' @examples
#' \dontrun{
#' # suppose previously we had run the following:
#' sim <- new_simulation(name = "normal-example",
#' label = "Normal Mean Estimation",
#' dir = tempdir()) %>%
#' generate_model(make_my_example_model, n = 20) %>%
#' simulate_from_model(nsim = 50, index = 1:3) %>%
#' run_method(my_example_method) %>%
#' evaluate(my_example_loss)
#' # then we could get the metric evaluated on the method's output:
#' e <- evals(sim)
#' # we can export it as a data.frame
#' as.data.frame(e)
#' # or we can get at a particular draw-method-metric triplet
#' e@evals$`my-method`$r1.1$myloss
#' }
evals <- function(sim, ..., subset = NULL, index, methods,
reference = FALSE) {
outputs_or_evals(sim, sim@evals_refs, FALSE, subset, index, methods,
reference, ...)
}
#' Internal function used by both outputs and evals
#'
#' @param sim simulation object
#' @param refs either sim@@output_refs or sim@@evals_refs
#' @param sort_by_method whether returned object should have each method's objects
#' in its own list or not
#' @keywords internal
outputs_or_evals <- function(sim, refs, sort_by_method,
subset, index, methods, reference, ...) {
if (!missing(index))
stopifnot(is.numeric(index), index > 0, index == round(index))
if (length(refs) == 0) return(list())
mref <- model(sim, ..., subset = subset, reference = TRUE)
if (length(mref) == 1) mref <- list(mref)
subset_model_names <- unlist(lapply(mref, function(ref) ref@name))
obj <- list()
for (i in seq_along(refs)) {
if (length(refs[[i]]) == 0) next # no outputs are in this model
if (!(refs[[i]][[1]]@model_name %in% subset_model_names)) next # subset excluded this model
# this model's outputs should be included (if they match the index and methods)
obj[[i]] <- list()
methods_in_list <- NULL
for (o in seq_along(refs[[i]])) {
if (!missing(index)) {
if (!(refs[[i]][[o]]@index %in% index)) {
# o-th ObjectRef of model i has wrong index; don't put in obj[[i]]
next
}
}
if (!missing(methods)) {
if (!(refs[[i]][[o]]@method_name %in% methods)) {
# o-th ObjectRef of model i is of wrong method; don't put in obj[[i]]
next
}
}
# made it through the the index and method screen; add to obj[[i]]
# first, each object's dir should no longer be relative to sim's dir
refs[[i]][[o]]@dir <- normalizePath(file.path(sim@dir, refs[[i]][[o]]@dir),
winslash = "/")
if (sort_by_method) {
# organize ObjectRefs by method_name
o_method_name <- refs[[i]][[o]]@method_name
obj[[i]][[o_method_name]] <- c(obj[[i]][[o_method_name]], refs[[i]][[o]])
} else {
obj[[i]] <- c(obj[[i]], refs[[i]][[o]])
}
}
if (sort_by_method) {
obj[[i]] <- unname(obj[[i]])
if (length(obj[[i]]) == 1) obj[[i]] <- obj[[i]][[1]]
}
}
if (length(obj) == 0) return(list())
obj <- obj[!unlist(lapply(obj, is.null))]
if (length(obj) == 1) obj <- obj[[1]]
if (!reference) obj <- load(obj)
return(obj)
}
#' Returns indices of a specified subset of sim@@model_refs
#'
#' See \code{\link{model}} for information about the various formats of subset.
#' @param sim a simulation object
#' @param subset a vector indicating which models should be returned.
get_model_indices <- function(sim, subset) {
num_models <- length(sim@model_refs)
if (is.null(subset)) subset = seq(num_models)
if (num_models == 0) stop("This simulation has no models.")
if (is.numeric(subset)) {
if (!all(subset == round(subset) & subset >= 1 & subset <= num_models))
stop("subset, if numeric, must be integers between 1 and num_models.")
ii <- subset
} else if (is.character(subset)) {
# subset should consist of model names
model_names <- unlist(lapply(sim@model_refs, function(m) m@name))
if (!all(subset %in% model_names))
stop("subset includes an unrecognized model name.")
ii <- match(subset, model_names)
} else stop("subset is not in a valid format.")
return(ii)
}
#' Create a simulation that is a subset of a preexisting simulation object
#'
#' Given a simulation, creates a new simulation that is a subset of the
#' preexisting simulation. Does not save this new one to file. To do so,
#' first change the name (and, potentially, label) of the simulation
#' and then use \code{\link{save_simulation}}. If you call
#' \code{\link{save_simulation}} before changing the name, you will overwrite
#' the preexisting simulation. Use \code{\link{rename}} and
#' \code{\link{relabel}}.
#'
#' @param sim a simulation object
#' @param ... logical conditions to specify a subset of models. Conditions can
#' only involve params of model that have length 1 and are of class
#' numeric or character.
#' @param subset a vector of integers indexing the models or a vector of model
#' names. To select models based on parameter values, use \code{...}.
#' However, using \code{...} is slower than using subset.
#' @param index a vector of positive integers specifying which draws' objects
#' are desired. If missing, then all draws' evals are returned.
#' @param methods character vector of method names of interest. If missing,
#' then all methods' evals are returned
#' @export
subset_simulation <- function(sim, ..., subset = NULL, index, methods) {
if (is.null(subset)) subset = seq_along(sim@model_refs)
mref <- model(sim, ..., subset = subset, reference = TRUE)
dref <- draws(sim, ..., subset = subset, index = index, reference = TRUE)
oref <- output(sim, ..., subset = subset, index = index, methods = methods,
reference = TRUE)
eref <- evals(sim, ..., subset = subset, index = index, methods = methods,
reference = TRUE)
new_simulation(name = sim@name, label = sim@label, dir = sim@dir,
refs = c(mref, dref, oref, eref), save_to_file = FALSE)
}
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.