diff --git a/R/simulate.R b/R/simulate.R index 8952070..77cc519 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -114,8 +114,22 @@ with_params <- function(..., .censor = NA, .aggregate = NULL) { #' used in the [simulate_process()]. The value should be returned from calling #' [with_params()]. #' @param .seed An optional seed value. +#' @param .nsim The number of times to simulate data. +#' @examples +#' design() %>% +#' set_units(unit = 4) %>% +#' set_trts(trt = 2) %>% +#' allot_table(trt ~ unit) %>% +#' set_rcrds(y = unit) %>% +#' simulate_process(y = function() { +#' res <- rnorm(n()) +#' res +#'. }) %>% +#' simulate_rcrds(y = with_params(), .nsim = 3) +#' +#' #' @export -simulate_rcrds <- function(.data, ..., .seed = NULL) { +simulate_rcrds <- function(.data, ..., .seed = NULL, .nsim = 1L) { dots <- list2(...) prov <- activate_provenance(.data) prov$save_seed(.seed, type = "simulate_rcrds") @@ -127,30 +141,35 @@ simulate_rcrds <- function(.data, ..., .seed = NULL) { .combine_words(srcrds[duplicated(srcrds)], fun = cli::col_blue), " in multiple processes. The values will be overwritten.")) - - for(aprocess in prnames) { - process <- prov$get_simulate(aprocess)$process - if(is_null(process)) abort(paste0("The supplied process, ", cli::col_blue(aprocess), ", doesn't exist")) - srcrds <- prov$get_simulate(aprocess)$rcrds - body(process) <- patch_function(process, patch = sprintf(" list2env(setNames(list(mget(ls())), '%s'), envir = result_env)", aprocess), - position = length(as.list(body(process))) - 1) - - y <- eval_tidy(do.call(process, dots[[aprocess]]$params), data = .data) - - # now assign the values to the data, but apply aggregation then censorship - if(grepl("^[.]", aprocess)) { - for(acol in colnames(y)) { - .data[[acol]] <- get_rcrd_values(acol, prov, dots[[aprocess]]$aggregate, - .data, y[[acol]], dots[[aprocess]]$censor) + data_ret <- .data[0, ] + for(isim in seq(.nsim)) { + data <- .data + for(aprocess in prnames) { + process <- prov$get_simulate(aprocess)$process + if(is_null(process)) abort(paste0("The supplied process, ", cli::col_blue(aprocess), ", doesn't exist")) + srcrds <- prov$get_simulate(aprocess)$rcrds + body(process) <- patch_function(process, patch = sprintf(" list2env(setNames(list(mget(ls())), '%s_%d'), envir = result_env)", aprocess, isim), + position = length(as.list(body(process))) - 1) + + y <- eval_tidy(do.call(process, dots[[aprocess]]$params), data = data) + + # now assign the values to the data, but apply aggregation then censorship + if(grepl("^[.]", aprocess)) { + for(acol in colnames(y)) { + data[[acol]] <- get_rcrd_values(acol, prov, dots[[aprocess]]$aggregate, + data, y[[acol]], dots[[aprocess]]$censor) + } + } else { + # there should be only one record if it is not a process name + arcrd <- srcrds[1] + data[[arcrd]] <- get_rcrd_values(arcrd, prov, dots[[aprocess]]$aggregate, + data, unname(y), dots[[aprocess]]$censor) } - } else { - # there should be only one record if it is not a process name - arcrd <- srcrds[1] - .data[[arcrd]] <- get_rcrd_values(arcrd, prov, dots[[aprocess]]$aggregate, - .data, unname(y), dots[[aprocess]]$censor) } + data$.sim <- isim + data_ret <- rbind(data_ret, data) } - return_edibble_with_graph(.data, prov) + return_edibble_with_graph(data_ret, prov) } get_rcrd_values <- function(rname, prov, aggfn, .data, y, censor) { @@ -497,6 +516,7 @@ effects_code <- function(dep_fcts, .data, nlevels = 1) { #' @param data An edibble data frame. #' @param process The process name. Typically the name of the process. If unknown, #' leave this empty. +#' @param sim The simulation number. Default is 1. #' @export examine_process <- function(data, process = NULL) { prov <- activate_provenance(data) @@ -514,15 +534,18 @@ examine_process <- function(data, process = NULL) { #' @rdname examine_process #' @export -examine_process_values <- function(data, process = NULL) { +examine_process_values <- function(data, process = NULL, sim = 1L) { prov <- activate_provenance(data) - res <- prov$get_simulate_result_env(process) + if(is.null(process)) pname <- NULL else pname <- paste0(process, "_", sim) + res <- prov$get_simulate_result_env(pname) if(is_null(res)) { warning("There is no simulation process stored.") NULL } else if(is.environment(res)) { + pnames <- ls(envir = res, all.names = TRUE) + pnames <- unique(gsub("_[0-9]+$", "", pnames)) abort(paste0("You need to specify a process name. The available process names are: ", - .combine_words(ls(envir = res, all.names = TRUE), fun = cli::col_blue), ".")) + .combine_words(pnames, fun = cli::col_blue), ".")) } else { res } diff --git a/man/examine_process.Rd b/man/examine_process.Rd index 883fc97..197b1e5 100644 --- a/man/examine_process.Rd +++ b/man/examine_process.Rd @@ -7,13 +7,15 @@ \usage{ examine_process(data, process = NULL) -examine_process_values(data, process = NULL) +examine_process_values(data, process = NULL, sim = 1L) } \arguments{ \item{data}{An edibble data frame.} \item{process}{The process name. Typically the name of the process. If unknown, leave this empty.} + +\item{sim}{The simulation number. Default is 1.} } \description{ Examine the simulation process diff --git a/man/simulate_rcrds.Rd b/man/simulate_rcrds.Rd index c33e21a..3f60122 100644 --- a/man/simulate_rcrds.Rd +++ b/man/simulate_rcrds.Rd @@ -4,7 +4,7 @@ \alias{simulate_rcrds} \title{Simulate records} \usage{ -simulate_rcrds(.data, ..., .seed = NULL) +simulate_rcrds(.data, ..., .seed = NULL, .nsim = 1L) } \arguments{ \item{.data}{An edibble data} @@ -14,7 +14,23 @@ used in the \code{\link[=simulate_process]{simulate_process()}}. The value shoul \code{\link[=with_params]{with_params()}}.} \item{.seed}{An optional seed value.} + +\item{.nsim}{The number of times to simulate data.} } \description{ Simulate records } +\examples{ +design() \%>\% + set_units(unit = 4) \%>\% + set_trts(trt = 2) \%>\% + allot_table(trt ~ unit) \%>\% + set_rcrds(y = unit) \%>\% + simulate_process(y = function() { + res <- rnorm(n()) + res +. }) \%>\% + simulate_rcrds(y = with_params(), .nsim = 3) + + +}