From 085e2e1b2a416601ce1cfdcbc28e93257cf07776 Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 02:03:23 -0600 Subject: [PATCH 1/7] add initial draft of rename_funs --- NAMESPACE | 4 + R/experiment-helpers.R | 58 +++++ R/experiment.R | 351 +++++++++++++++++++++++++++++++ man/Experiment.Rd | 92 ++++++++ man/rename_funs.Rd | 42 ++++ tests/testthat/test-experiment.R | 92 ++++++++ 6 files changed, 639 insertions(+) create mode 100644 man/rename_funs.Rd diff --git a/NAMESPACE b/NAMESPACE index 3b98abb..2f46cb6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -72,6 +72,10 @@ export(remove_evaluator) export(remove_method) export(remove_vary_across) export(remove_visualizer) +export(rename_dgps) +export(rename_evaluators) +export(rename_methods) +export(rename_visualizers) export(render_docs) export(run_experiment) export(run_tests) diff --git a/R/experiment-helpers.R b/R/experiment-helpers.R index ecac283..e69e871 100644 --- a/R/experiment-helpers.R +++ b/R/experiment-helpers.R @@ -738,6 +738,64 @@ remove_visualizer <- function(experiment, name = NULL, ...) { experiment$remove_visualizer(name, ...) } +#' Helper functions for renaming components in an `Experiment`. +#' +#' @description Helper functions for renaming `DGPs`, +#' `Methods`, `Evaluators`, and `Visualizers` from an +#' `Experiment`. These functions will also rename these objects in the +#' cached documentation and results files. +#' +#' @inheritParams shared_experiment_helpers_args +#' @param ... Named character vector of names to rename. Use +#' `"new_name" = "old_name"` format. +#' +#' @return The original `Experiment` object passed to `remove_*`. +#' +#' @name rename_funs +#' @rdname rename_funs +#' +#' @examples +#' \dontrun{ +#' rename_dgps(experiment, "New DGP1" = "DGP1", "New DGP2" = "DGP2") +#' rename_methods(experiment, "New Method1" = "Method1") +#' rename_evaluators(experiment, "New Evaluator1" = "Evaluator1") +#' rename_visualizers(experiment, "New Visualizer1" = "Visualizer1") +#' } +#' +NULL + +#' @rdname rename_funs +#' +#' @inherit rename_funs examples +#' @export +rename_dgps <- function(experiment, ...) { + experiment$rename_dgps(...) +} + +#' @rdname rename_funs +#' +#' @inherit rename_funs examples +#' @export +rename_methods <- function(experiment, ...) { + experiment$rename_methods(...) +} + +#' @rdname rename_funs +#' +#' @inherit rename_funs examples +#' @export +rename_evaluators <- function(experiment, ...) { + experiment$rename_evaluators(...) +} + +#' @rdname rename_funs +#' +#' @inherit rename_funs examples +#' @export +rename_visualizers <- function(experiment, ...) { + experiment$rename_visualizers(...) +} + # TODO: add @details #' Helper functions for getting components in an `Experiment`. #' diff --git a/R/experiment.R b/R/experiment.R index 826bb6c..96dc5ac 100644 --- a/R/experiment.R +++ b/R/experiment.R @@ -110,6 +110,309 @@ Experiment <- R6::R6Class( } }, + .rename_objs = function(field_name, ...) { + obj_list <- private$.get_obj_list(field_name) + rename_obj_list <- rlang::list2(...) + obj_names <- unname(rename_obj_list) + new_obj_names <- names(rename_obj_list) + all_obj_names <- names(obj_list) + n_names <- length(obj_names) + field_verb <- dplyr::case_when( + field_name %in% c("dgp", "method") ~ "fit", + field_name == "evaluator" ~ "evaluate", + field_name == "visualizer" ~ "visualize" + ) + field_col <- dplyr::case_when( + field_name == "dgp" ~ ".dgp_name", + field_name == "method" ~ ".method_name", + field_name == "evaluator" ~ ".eval_name", + field_name == "visualizer" ~ ".viz_name" + ) + field_params <- dplyr::case_when( + field_name == "dgp" ~ ".dgp_params", + field_name == "method" ~ ".method_params", + field_name == "evaluator" ~ ".eval_params", + field_name == "visualizer" ~ ".viz_params" + ) + field_fun <- dplyr::case_when( + field_name == "dgp" ~ ".dgp_fun", + field_name == "method" ~ ".method_fun", + field_name == "evaluator" ~ ".eval_fun", + field_name == "visualizer" ~ ".viz_fun" + ) + list_name <- paste0(".", field_name, "_list") + + missing_obj_names <- setdiff(obj_names, all_obj_names) + if (length(missing_obj_names) > 0) { + abort( + sprintf( + paste("The name(s) '%s' do(es) not exist in the %s list.", + "Use `add_%s` instead."), + paste(missing_obj_names, collapse=", "), field_name, field_name + ), + call = rlang::caller_env() + ) + } + existing_obj_names <- intersect(new_obj_names, all_obj_names) + if (length(existing_obj_names) > 0) { + abort( + sprintf( + paste("The name(s) '%s' already exist(s) in the %s list.", + "Rename to something different."), + paste(existing_obj_names, collapse=", "), field_name + ), + call = rlang::caller_env() + ) + } + + # old results directory + if (private$.has_vary_across()) { + old_save_dir <- private$.get_vary_across_dir() + } else { + old_save_dir <- private$.save_dir + } + + # rename object + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + names(private[[list_name]])[all_obj_names == obj_name] <- new_obj_name + } + + if (field_verb == "fit") { + # rename object in vary_across_list + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + idx <- which(names(private$.vary_across_list[[field_name]]) == obj_name) + if (length(idx) > 0) { + names(private$.vary_across_list[[field_name]])[idx] <- new_obj_name + } + } + # rename .fit_params + if (nrow(private$.fit_params) > 0) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + private$.fit_params[[field_col]] <- dplyr::case_when( + private$.fit_params[[field_col]] == obj_name ~ new_obj_name, + TRUE ~ private$.fit_params[[field_col]] + ) + } + } + } + + # new results directory + if (private$.has_vary_across()) { + save_dir <- private$.get_vary_across_dir() + } else { + save_dir <- private$.save_dir + } + + # rename results directory if needed + if (!identical(old_save_dir, save_dir)) { + invisible(file.rename(old_save_dir, save_dir)) + } + + ## experiment + saveRDS(self, file.path(save_dir, "experiment.rds")) + ## experiment_cached_params + cached_params <- readRDS( + file.path(save_dir, "experiment_cached_params.rds") + ) + for (type in c("fit", "evaluate", "visualize")) { + if (!is.null(cached_params[[type]][[field_verb]])) { + if (nrow(cached_params[[type]][[field_verb]]) > 0) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + cached_params[[type]][[field_verb]][[field_col]] <- dplyr::case_when( + cached_params[[type]][[field_verb]][[field_col]] == obj_name ~ new_obj_name, + TRUE ~ cached_params[[type]][[field_verb]][[field_col]] + ) + } + if (field_verb == "fit") { + cached_params[[type]][[field_verb]][[paste0(".", field_name)]] <- purrr::map2( + cached_params[[type]][[field_verb]][[paste0(".", field_name)]], + cached_params[[type]][[field_verb]][[field_col]], + function(params_list, new_cached_name) { + params_list[[field_col]] <- new_cached_name + return(params_list) + } + ) + } else { + names(cached_params[[type]][[field_verb]][[field_params]]) <- + cached_params[[type]][[field_verb]][[field_col]] + names(cached_params[[type]][[field_verb]][[field_fun]]) <- + cached_params[[type]][[field_verb]][[field_col]] + # cached_names <- names(cached_params[[type]][[field_verb]][[field_params]]) + # names(cached_params[[type]][[field_verb]][[field_params]])[ + # cached_name == obj_name + # ] <- new_obj_name + # cached_names <- names(cached_params[[type]][[field_verb]][[field_fun]]) + # names(cached_params[[type]][[field_verb]][[field_fun]])[ + # cached_name == obj_name + # ] <- new_obj_name + } + } + } + } + saveRDS(cached_params, file.path(save_dir, "experiment_cached_params.rds")) + ## fit_results + fit_results <- NULL + if (field_verb == "fit") { + fit_results <- private$.get_cached_results("fit", verbose = 0) + if (!is.null(fit_results)) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + fit_results[[field_col]] <- dplyr::case_when( + fit_results[[field_col]] == obj_name ~ new_obj_name, + TRUE ~ fit_results[[field_col]] + ) + } + if (private$.save_in_bulk[["fit"]]) { + saveRDS(fit_results, file.path(save_dir, "fit_results.rds")) + } else { + purrr::walk( + unique(fit_results$.rep), + function(i) { + rep_results <- fit_results |> + dplyr::filter(as.numeric(.rep) == !!i) + private$.save_result( + rep_results, "fit", sprintf("fit_result%s", i) + ) + } + ) + } + } + } + ## eval_results + eval_results <- NULL + if (field_verb %in% c("fit", "evaluate")) { + eval_results <- private$.get_cached_results("eval", verbose = 0) + if (!is.null(eval_results)) { + if (field_verb == "fit") { + eval_results <- purrr::map2( + names(eval_results), eval_results, + function(eval_name, eval_result) { + if (field_col %in% colnames(eval_result)) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + eval_result[[field_col]] <- dplyr::case_when( + eval_result[[field_col]] == obj_name ~ new_obj_name, + TRUE ~ eval_result[[field_col]] + ) + } + } + if (!private$.save_in_bulk[["eval"]]) { + private$.save_result(eval_result, "eval", eval_name) + } + return(eval_result) + } + ) + if (private$.save_in_bulk[["eval"]]) { + saveRDS(eval_results, file.path(save_dir, "eval_results.rds")) + } + } else { + if (private$.save_in_bulk[["eval"]]) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + names(eval_results)[names(eval_results) == obj_name] <- new_obj_name + } + saveRDS(eval_results, file.path(save_dir, "eval_results.rds")) + } else { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + old_eval_fname <- file.path( + save_dir, "eval_results", sprintf("%s.rds", obj_name) + ) + new_eval_fname <- file.path( + save_dir, "eval_results", sprintf("%s.rds", new_obj_name) + ) + if (file.exists(old_eval_fname)) { + invisible(file.rename(old_eval_fname, new_eval_fname)) + } + } + } + } + } + } + ## viz_results + viz_results <- private$.get_cached_results("viz", verbose = 0) + if (!is.null(viz_results)) { + if (field_name == "visualizer") { + if (private$.save_in_bulk[["viz"]]) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + names(viz_results)[names(viz_results) == obj_name] <- new_obj_name + } + saveRDS(viz_results, file.path(save_dir, "viz_results.rds")) + } else { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + old_viz_fname <- file.path( + save_dir, "viz_results", sprintf("%s.rds", obj_name) + ) + new_viz_fname <- file.path( + save_dir, "viz_results", sprintf("%s.rds", new_obj_name) + ) + if (file.exists(old_viz_fname)) { + invisible(file.rename(old_viz_fname, new_viz_fname)) + } + } + } + } else { + record_time <- !is.null(attr(viz_results[[1]], ".time_taken")) + eval_cached_params <- cached_params$evaluate + viz_cached_params <- cached_params$visualize + viz_cached_params$visualize <- NULL + if (identical(eval_cached_params, viz_cached_params)) { + viz_results <- tryCatch( + self$visualize( + fit_results, eval_results, + save = TRUE, record_time = record_time, verbose = 0 + ), + error = function(e) { + warn( + "Could not automatically rename objects in cached viz_results. To update the viz_results cache, please re-run the experiment using `run_experiment()`, while setting the argument `use_cached = TRUE` in the function call." + ) + return(NULL) + } + ) + } else { + warn( + "Could not automatically rename objects in cached viz_results. To update the viz_results cache, please re-run the experiment using `run_experiment()`, while setting the argument `use_cached = TRUE` in the function call." + ) + viz_results <- NULL + } + } + } + + # rename object docs if needed + docs_dir <- file.path(save_dir, "docs") + if (file.exists(docs_dir)) { + for (i in 1:n_names) { + obj_name <- obj_names[i] + new_obj_name <- new_obj_names[i] + old_doc_fname <- file.path( + docs_dir, sprintf("%ss", field_name), sprintf("%s.md", obj_name) + ) + new_doc_fname <- file.path( + docs_dir, sprintf("%ss", field_name), sprintf("%s.md", new_obj_name) + ) + if (file.exists(old_doc_fname)) { + invisible(file.rename(old_doc_fname, new_doc_fname)) + } + } + } + }, + .throw_empty_list_error = function(field_name, action_name = "run") { abort( sprintf( @@ -1814,6 +2117,18 @@ Experiment <- R6::R6Class( invisible(self) }, + #' @description Rename [DGP] objects in the `Experiment` and in the cached + #' documentation and results. + #' + #' @param ... Named character vector of names to rename. Use + #' `"new_name" = "old_name"` format. + #' + #' @return The `Experiment` object, invisibly. + rename_dgps = function(...) { + private$.rename_objs("dgp", ...) + invisible(self) + }, + #' @description Retrieve the [DGP] objects associated with the `Experiment`. #' #' @return A named list of the `DGP` objects in the `Experiment`. @@ -1866,6 +2181,18 @@ Experiment <- R6::R6Class( invisible(self) }, + #' @description Rename [Method] objects in the `Experiment` and in the + #' cached documentation and results. + #' + #' @param ... Named character vector of names to rename. Use + #' `"new_name" = "old_name"` format. + #' + #' @return The `Experiment` object, invisibly. + rename_methods = function(...) { + private$.rename_objs("method", ...) + invisible(self) + }, + #' @description Retrieve the [Method] objects associated with the `Experiment`. #' #' @return A named list of the `Method` objects in the `Experiment`. @@ -1910,6 +2237,18 @@ Experiment <- R6::R6Class( invisible(self) }, + #' @description Rename [Evaluator] objects in the `Experiment` and in the + #' cached documentation and results. + #' + #' @param ... Named character vector of names to rename. Use + #' `"new_name" = "old_name"` format. + #' + #' @return The `Experiment` object, invisibly. + rename_evaluators = function(...) { + private$.rename_objs("evaluator", ...) + invisible(self) + }, + #' @description Retrieve the [Evaluator] objects associated with the `Experiment`. #' #' @return A named list of the `Evaluator` objects in the `Experiment`. @@ -1954,6 +2293,18 @@ Experiment <- R6::R6Class( invisible(self) }, + #' @description Rename [Visualizer] objects in the `Experiment` and in the + #' cached documentation and results. + #' + #' @param ... Named character vector of names to rename. Use + #' `"new_name" = "old_name"` format. + #' + #' @return The `Experiment` object, invisibly. + rename_visualizers = function(...) { + private$.rename_objs("visualizer", ...) + invisible(self) + }, + #' @description Retrieve the [Visualizer] objects associated with the `Experiment`. #' #' @return A named list of the `Visualizer` objects in the `Experiment`. diff --git a/man/Experiment.Rd b/man/Experiment.Rd index 2067a74..98a5e58 100644 --- a/man/Experiment.Rd +++ b/man/Experiment.Rd @@ -47,18 +47,22 @@ first argument: \code{\link[=create_experiment]{create_experiment()}}, \code{\li \item \href{#method-Experiment-add_dgp}{\code{Experiment$add_dgp()}} \item \href{#method-Experiment-update_dgp}{\code{Experiment$update_dgp()}} \item \href{#method-Experiment-remove_dgp}{\code{Experiment$remove_dgp()}} +\item \href{#method-Experiment-rename_dgps}{\code{Experiment$rename_dgps()}} \item \href{#method-Experiment-get_dgps}{\code{Experiment$get_dgps()}} \item \href{#method-Experiment-add_method}{\code{Experiment$add_method()}} \item \href{#method-Experiment-update_method}{\code{Experiment$update_method()}} \item \href{#method-Experiment-remove_method}{\code{Experiment$remove_method()}} +\item \href{#method-Experiment-rename_methods}{\code{Experiment$rename_methods()}} \item \href{#method-Experiment-get_methods}{\code{Experiment$get_methods()}} \item \href{#method-Experiment-add_evaluator}{\code{Experiment$add_evaluator()}} \item \href{#method-Experiment-update_evaluator}{\code{Experiment$update_evaluator()}} \item \href{#method-Experiment-remove_evaluator}{\code{Experiment$remove_evaluator()}} +\item \href{#method-Experiment-rename_evaluators}{\code{Experiment$rename_evaluators()}} \item \href{#method-Experiment-get_evaluators}{\code{Experiment$get_evaluators()}} \item \href{#method-Experiment-add_visualizer}{\code{Experiment$add_visualizer()}} \item \href{#method-Experiment-update_visualizer}{\code{Experiment$update_visualizer()}} \item \href{#method-Experiment-remove_visualizer}{\code{Experiment$remove_visualizer()}} +\item \href{#method-Experiment-rename_visualizers}{\code{Experiment$rename_visualizers()}} \item \href{#method-Experiment-get_visualizers}{\code{Experiment$get_visualizers()}} \item \href{#method-Experiment-add_vary_across}{\code{Experiment$add_vary_across()}} \item \href{#method-Experiment-update_vary_across}{\code{Experiment$update_vary_across()}} @@ -533,6 +537,28 @@ The \code{Experiment} object, invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Experiment-rename_dgps}{}}} +\subsection{Method \code{rename_dgps()}}{ +Rename \link{DGP} objects in the \code{Experiment} and in the cached +documentation and results. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Experiment$rename_dgps(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{Named character vector of names to rename. Use +\code{"new_name" = "old_name"} format.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{Experiment} object, invisibly. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Experiment-get_dgps}{}}} \subsection{Method \code{get_dgps()}}{ @@ -616,6 +642,28 @@ The \code{Experiment} object, invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Experiment-rename_methods}{}}} +\subsection{Method \code{rename_methods()}}{ +Rename \link{Method} objects in the \code{Experiment} and in the +cached documentation and results. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Experiment$rename_methods(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{Named character vector of names to rename. Use +\code{"new_name" = "old_name"} format.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{Experiment} object, invisibly. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Experiment-get_methods}{}}} \subsection{Method \code{get_methods()}}{ @@ -699,6 +747,28 @@ The \code{Experiment} object, invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Experiment-rename_evaluators}{}}} +\subsection{Method \code{rename_evaluators()}}{ +Rename \link{Evaluator} objects in the \code{Experiment} and in the +cached documentation and results. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Experiment$rename_evaluators(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{Named character vector of names to rename. Use +\code{"new_name" = "old_name"} format.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{Experiment} object, invisibly. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Experiment-get_evaluators}{}}} \subsection{Method \code{get_evaluators()}}{ @@ -782,6 +852,28 @@ The \code{Experiment} object, invisibly. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Experiment-rename_visualizers}{}}} +\subsection{Method \code{rename_visualizers()}}{ +Rename \link{Visualizer} objects in the \code{Experiment} and in the +cached documentation and results. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Experiment$rename_visualizers(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{Named character vector of names to rename. Use +\code{"new_name" = "old_name"} format.} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +The \code{Experiment} object, invisibly. +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Experiment-get_visualizers}{}}} \subsection{Method \code{get_visualizers()}}{ diff --git a/man/rename_funs.Rd b/man/rename_funs.Rd new file mode 100644 index 0000000..85643cc --- /dev/null +++ b/man/rename_funs.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/experiment-helpers.R +\name{rename_funs} +\alias{rename_funs} +\alias{rename_dgps} +\alias{rename_methods} +\alias{rename_evaluators} +\alias{rename_visualizers} +\title{Helper functions for renaming components in an \code{Experiment}.} +\usage{ +rename_dgps(experiment, ...) + +rename_methods(experiment, ...) + +rename_evaluators(experiment, ...) + +rename_visualizers(experiment, ...) +} +\arguments{ +\item{experiment}{An \code{Experiment} object.} + +\item{...}{Named character vector of names to rename. Use +\code{"new_name" = "old_name"} format.} +} +\value{ +The original \code{Experiment} object passed to \verb{remove_*}. +} +\description{ +Helper functions for renaming \code{DGPs}, +\code{Methods}, \code{Evaluators}, and \code{Visualizers} from an +\code{Experiment}. These functions will also rename these objects in the +cached documentation and results files. +} +\examples{ +\dontrun{ +rename_dgps(experiment, "New DGP1" = "DGP1", "New DGP2" = "DGP2") +rename_methods(experiment, "New Method1" = "Method1") +rename_evaluators(experiment, "New Evaluator1" = "Evaluator1") +rename_visualizers(experiment, "New Visualizer1" = "Visualizer1") +} + +} diff --git a/tests/testthat/test-experiment.R b/tests/testthat/test-experiment.R index f7062ca..1a42487 100644 --- a/tests/testthat/test-experiment.R +++ b/tests/testthat/test-experiment.R @@ -191,6 +191,98 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { expect_equal(experiment1_copy, experiment2_copy) }) + test_that("Renaming DGPs/Methods/Evaluators/Visualizers works properly", { + # generate data from normal distribution with n samples + dgp_fun1 <- function(x = 10) x + 1 + dgp_fun2 <- function(x = 10) x + 2 + dgp1 <- DGP$new(dgp_fun1, .name = "DGP1") + dgp2 <- DGP$new(dgp_fun2, .name = "DGP2") + method_fun1 <- function(x) x + method1 <- Method$new(method_fun1, .name = "Method1") + eval_fun1 <- function() tibble::tibble(a = 1:3) + eval1 <- Evaluator$new(eval_fun1, .name = "Evaluator1") + viz_fun1 <- function() ggplot2::ggplot() + viz1 <- Visualizer$new(viz_fun1, .name = "Visualizer1") + + experiment <- create_experiment(name = "test-rename") |> + add_dgp(dgp1) |> + add_dgp(dgp2) |> + add_method(method1) |> + add_evaluator(eval1) |> + add_visualizer(viz1) + exp <- create_experiment( + name = "test-rename-save-per-rep", save_in_bulk = FALSE + ) |> + add_dgp(dgp1) |> + add_dgp(dgp2) |> + add_method(method1) |> + add_evaluator(eval1) |> + add_visualizer(viz1) + + # remove cache + if (dir.exists(file.path("results", "test-rename"))) { + for (fname in list.files(file.path("results", "test-rename"), + recursive = TRUE, full.names = TRUE)) { + file.remove(fname) + } + } + if (dir.exists(file.path("results", "test-rename-save-per-rep"))) { + for (fname in list.files(file.path("results", "test-rename-save-per-rep"), + recursive = TRUE, full.names = TRUE)) { + file.remove(fname) + } + } + + results <- run_experiment(experiment, n_reps = 2, save = TRUE) + init_docs(experiment) + res <- run_experiment(exp, n_reps = 2, save = TRUE) + init_docs(exp) + + # error checking + expect_error( + experiment |> + rename_dgps("New DGP1" = "Non-existent DGP") + ) + expect_error( + experiment |> + rename_dgps("DGP2" = "DGP1") + ) + + # TODO: write better tests for renaming + expect_error( + experiment |> + rename_dgps( + "New DGP1" = "DGP1", + "New DGP2" = "DGP2" + ), + NA + ) + expect_error( + experiment |> + rename_methods( + "New Method1" = "Method1" + ), + NA + ) + expect_error( + experiment |> + rename_evaluators( + "New Evaluator1" = "Evaluator1" + ), + NA + ) + expect_error( + experiment |> + rename_visualizers( + "New Visualizer1" = "Visualizer1" + ), + NA + ) + #TODO: with vary across + #TODO: with save_in_bulk = FALSE + #TODO: with save_in_bulk = FALSE and vary across + }) + test_that("Running experiment works properly", { dgp_fun1 <- function(x, y = NULL) x + 1 From 2efa49e6ee101c4f157bce7b1661909b584b4fef Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 12:23:03 -0600 Subject: [PATCH 2/7] bug fixes --- R/experiment-utils.R | 22 +++++ R/experiment.R | 159 +++++++++++++------------------ tests/testthat/test-experiment.R | 114 +++++++++++++++------- 3 files changed, 168 insertions(+), 127 deletions(-) diff --git a/R/experiment-utils.R b/R/experiment-utils.R index 81b0ce9..6aee446 100644 --- a/R/experiment-utils.R +++ b/R/experiment-utils.R @@ -26,6 +26,28 @@ get_new_method_params <- function(dgp_params, new_fit_params) { } +#' @keywords internal +replace_names <- function(obj, old_names, new_names) { + for (i in 1:length(old_names)) { + old_name <- old_names[i] + new_name <- new_names[i] + names(obj)[names(obj) == old_name] <- new_name + } + return(obj) +} + + +#' @keywords internal +replace_values <- function(obj, old_values, new_values) { + for (i in 1:length(old_values)) { + old_value <- old_values[i] + new_value <- new_values[i] + obj[obj == old_value] <- new_value + } + return(obj) +} + + #' Get the size of an object, including environments. #' #' @param obj The object to measure. Default is the calling environment. diff --git a/R/experiment.R b/R/experiment.R index 96dc5ac..20ef6fb 100644 --- a/R/experiment.R +++ b/R/experiment.R @@ -128,18 +128,6 @@ Experiment <- R6::R6Class( field_name == "evaluator" ~ ".eval_name", field_name == "visualizer" ~ ".viz_name" ) - field_params <- dplyr::case_when( - field_name == "dgp" ~ ".dgp_params", - field_name == "method" ~ ".method_params", - field_name == "evaluator" ~ ".eval_params", - field_name == "visualizer" ~ ".viz_params" - ) - field_fun <- dplyr::case_when( - field_name == "dgp" ~ ".dgp_fun", - field_name == "method" ~ ".method_fun", - field_name == "evaluator" ~ ".eval_fun", - field_name == "visualizer" ~ ".viz_fun" - ) list_name <- paste0(".", field_name, "_list") missing_obj_names <- setdiff(obj_names, all_obj_names) @@ -173,30 +161,31 @@ Experiment <- R6::R6Class( } # rename object + private[[list_name]] <- replace_names( + private[[list_name]], obj_names, new_obj_names + ) for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - names(private[[list_name]])[all_obj_names == obj_name] <- new_obj_name + private[[list_name]][[new_obj_names[i]]]$name <- new_obj_names[i] } if (field_verb == "fit") { # rename object in vary_across_list - for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - idx <- which(names(private$.vary_across_list[[field_name]]) == obj_name) - if (length(idx) > 0) { - names(private$.vary_across_list[[field_name]])[idx] <- new_obj_name - } - } + private$.vary_across_list[[field_name]] <- replace_names( + private$.vary_across_list[[field_name]], obj_names, new_obj_names + ) # rename .fit_params if (nrow(private$.fit_params) > 0) { + private$.fit_params[[field_col]] <- replace_values( + private$.fit_params[[field_col]], obj_names, new_obj_names + ) for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - private$.fit_params[[field_col]] <- dplyr::case_when( - private$.fit_params[[field_col]] == obj_name ~ new_obj_name, - TRUE ~ private$.fit_params[[field_col]] + private$.fit_params[[paste0(".", field_name)]] <- purrr::map2( + private$.fit_params[[paste0(".", field_name)]], + private$.fit_params[[field_col]], + function(params_list, new_cached_name) { + params_list[[field_col]] <- new_cached_name + return(params_list) + } ) } } @@ -215,62 +204,57 @@ Experiment <- R6::R6Class( } ## experiment - saveRDS(self, file.path(save_dir, "experiment.rds")) + if (file.exists(file.path(save_dir, "experiment.rds"))) { + saveRDS(self, file.path(save_dir, "experiment.rds")) + } ## experiment_cached_params - cached_params <- readRDS( - file.path(save_dir, "experiment_cached_params.rds") - ) - for (type in c("fit", "evaluate", "visualize")) { - if (!is.null(cached_params[[type]][[field_verb]])) { - if (nrow(cached_params[[type]][[field_verb]]) > 0) { - for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - cached_params[[type]][[field_verb]][[field_col]] <- dplyr::case_when( - cached_params[[type]][[field_verb]][[field_col]] == obj_name ~ new_obj_name, - TRUE ~ cached_params[[type]][[field_verb]][[field_col]] - ) - } - if (field_verb == "fit") { - cached_params[[type]][[field_verb]][[paste0(".", field_name)]] <- purrr::map2( - cached_params[[type]][[field_verb]][[paste0(".", field_name)]], + if (file.exists(file.path(save_dir, "experiment_cached_params.rds"))) { + cached_params <- readRDS( + file.path(save_dir, "experiment_cached_params.rds") + ) + for (type in c("fit", "evaluate", "visualize")) { + if (!is.null(cached_params[[type]][[field_verb]])) { + if (nrow(cached_params[[type]][[field_verb]]) > 0) { + cached_params[[type]][[field_verb]][[field_col]] <- replace_values( cached_params[[type]][[field_verb]][[field_col]], - function(params_list, new_cached_name) { - params_list[[field_col]] <- new_cached_name - return(params_list) - } + obj_names, new_obj_names ) - } else { - names(cached_params[[type]][[field_verb]][[field_params]]) <- - cached_params[[type]][[field_verb]][[field_col]] - names(cached_params[[type]][[field_verb]][[field_fun]]) <- - cached_params[[type]][[field_verb]][[field_col]] - # cached_names <- names(cached_params[[type]][[field_verb]][[field_params]]) - # names(cached_params[[type]][[field_verb]][[field_params]])[ - # cached_name == obj_name - # ] <- new_obj_name - # cached_names <- names(cached_params[[type]][[field_verb]][[field_fun]]) - # names(cached_params[[type]][[field_verb]][[field_fun]])[ - # cached_name == obj_name - # ] <- new_obj_name + if (field_verb == "fit") { + cached_params[[type]][[field_verb]][[paste0(".", field_name)]] <- purrr::map2( + cached_params[[type]][[field_verb]][[paste0(".", field_name)]], + cached_params[[type]][[field_verb]][[field_col]], + function(params_list, new_cached_name) { + params_list[[field_col]] <- new_cached_name + return(params_list) + } + ) + } else { + field_params <- dplyr::case_when( + field_verb == "evaluate" ~ ".eval_params", + field_verb == "visualize" ~ ".viz_params" + ) + field_fun <- dplyr::case_when( + field_verb == "evaluate" ~ ".eval_fun", + field_verb == "visualize" ~ ".viz_fun" + ) + names(cached_params[[type]][[field_verb]][[field_params]]) <- + cached_params[[type]][[field_verb]][[field_col]] + names(cached_params[[type]][[field_verb]][[field_fun]]) <- + cached_params[[type]][[field_verb]][[field_col]] + } } } } + saveRDS(cached_params, file.path(save_dir, "experiment_cached_params.rds")) } - saveRDS(cached_params, file.path(save_dir, "experiment_cached_params.rds")) ## fit_results fit_results <- NULL if (field_verb == "fit") { fit_results <- private$.get_cached_results("fit", verbose = 0) if (!is.null(fit_results)) { - for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - fit_results[[field_col]] <- dplyr::case_when( - fit_results[[field_col]] == obj_name ~ new_obj_name, - TRUE ~ fit_results[[field_col]] - ) - } + fit_results[[field_col]] <- replace_values( + fit_results[[field_col]], obj_names, new_obj_names + ) if (private$.save_in_bulk[["fit"]]) { saveRDS(fit_results, file.path(save_dir, "fit_results.rds")) } else { @@ -297,14 +281,9 @@ Experiment <- R6::R6Class( names(eval_results), eval_results, function(eval_name, eval_result) { if (field_col %in% colnames(eval_result)) { - for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - eval_result[[field_col]] <- dplyr::case_when( - eval_result[[field_col]] == obj_name ~ new_obj_name, - TRUE ~ eval_result[[field_col]] - ) - } + eval_result[[field_col]] <- replace_values( + eval_result[[field_col]], obj_names, new_obj_names + ) } if (!private$.save_in_bulk[["eval"]]) { private$.save_result(eval_result, "eval", eval_name) @@ -317,11 +296,9 @@ Experiment <- R6::R6Class( } } else { if (private$.save_in_bulk[["eval"]]) { - for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - names(eval_results)[names(eval_results) == obj_name] <- new_obj_name - } + eval_results <- replace_names( + eval_results, obj_names, new_obj_names + ) saveRDS(eval_results, file.path(save_dir, "eval_results.rds")) } else { for (i in 1:n_names) { @@ -346,11 +323,9 @@ Experiment <- R6::R6Class( if (!is.null(viz_results)) { if (field_name == "visualizer") { if (private$.save_in_bulk[["viz"]]) { - for (i in 1:n_names) { - obj_name <- obj_names[i] - new_obj_name <- new_obj_names[i] - names(viz_results)[names(viz_results) == obj_name] <- new_obj_name - } + viz_results <- replace_names( + viz_results, obj_names, new_obj_names + ) saveRDS(viz_results, file.path(save_dir, "viz_results.rds")) } else { for (i in 1:n_names) { @@ -373,6 +348,8 @@ Experiment <- R6::R6Class( viz_cached_params <- cached_params$visualize viz_cached_params$visualize <- NULL if (identical(eval_cached_params, viz_cached_params)) { + fit_results <- private$.get_cached_results("fit", verbose = 0) + eval_results <- private$.get_cached_results("eval", verbose = 0) viz_results <- tryCatch( self$visualize( fit_results, eval_results, @@ -563,7 +540,7 @@ Experiment <- R6::R6Class( field_name <- match.arg(field_name, several.ok = TRUE) param_names_ls <- purrr::map(private$.vary_across_list[field_name], function(x) { - if (identical(x, list())) { + if (identical(unname(x), list())) { return(NULL) } else { return(purrr::map(x, names) |> diff --git a/tests/testthat/test-experiment.R b/tests/testthat/test-experiment.R index 1a42487..9265853 100644 --- a/tests/testthat/test-experiment.R +++ b/tests/testthat/test-experiment.R @@ -193,16 +193,16 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { test_that("Renaming DGPs/Methods/Evaluators/Visualizers works properly", { # generate data from normal distribution with n samples - dgp_fun1 <- function(x = 10) x + 1 - dgp_fun2 <- function(x = 10) x + 2 - dgp1 <- DGP$new(dgp_fun1, .name = "DGP1") - dgp2 <- DGP$new(dgp_fun2, .name = "DGP2") - method_fun1 <- function(x) x + dgp_fun1 <- function(x = 10, y = 1) x + 1 + dgp_fun2 <- function(x = 10, y = 0) x + 2 + dgp1 <- DGP$new(dgp_fun1, .name = "DGP1", y = 2) + dgp2 <- DGP$new(dgp_fun2, .name = "DGP2", y = 3) + method_fun1 <- function(x, y = NULL) x method1 <- Method$new(method_fun1, .name = "Method1") - eval_fun1 <- function() tibble::tibble(a = 1:3) - eval1 <- Evaluator$new(eval_fun1, .name = "Evaluator1") - viz_fun1 <- function() ggplot2::ggplot() - viz1 <- Visualizer$new(viz_fun1, .name = "Visualizer1") + eval_fun1 <- function(y = "eval") tibble::tibble(a = 1:3) + eval1 <- Evaluator$new(eval_fun1, .name = "Evaluator1", y = "viz") + viz_fun1 <- function(fit_results, y = "viz") fit_results + viz1 <- Visualizer$new(viz_fun1, .name = "Visualizer1", y = "eval") experiment <- create_experiment(name = "test-rename") |> add_dgp(dgp1) |> @@ -219,13 +219,33 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { add_evaluator(eval1) |> add_visualizer(viz1) + # error checking + expect_error( + experiment |> + rename_dgps("New DGP1" = "Non-existent DGP") + ) + expect_error( + experiment |> + rename_dgps("DGP2" = "DGP1") + ) + + # get original results + old_results <- run_experiment(experiment, n_reps = 2, save = TRUE) + old_experiment <- get_cached_results(experiment, "experiment") + old_experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + old_res <- run_experiment(exp, n_reps = 2, save = TRUE) + old_exp <- get_cached_results(exp, "experiment") + old_cached_exp_params <- get_cached_results(exp, "experiment_cached_params") + # remove cache + experiment$clear_cache() if (dir.exists(file.path("results", "test-rename"))) { for (fname in list.files(file.path("results", "test-rename"), recursive = TRUE, full.names = TRUE)) { file.remove(fname) } } + exp$clear_cache() if (dir.exists(file.path("results", "test-rename-save-per-rep"))) { for (fname in list.files(file.path("results", "test-rename-save-per-rep"), recursive = TRUE, full.names = TRUE)) { @@ -233,51 +253,73 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { } } - results <- run_experiment(experiment, n_reps = 2, save = TRUE) + # run experiment without saving init_docs(experiment) - res <- run_experiment(exp, n_reps = 2, save = TRUE) + results <- run_experiment(experiment, n_reps = 2, save = FALSE) init_docs(exp) + res <- run_experiment(exp, n_reps = 2, save = FALSE) - # error checking - expect_error( - experiment |> - rename_dgps("New DGP1" = "Non-existent DGP") + # check renaming without save/cached results + experiment |> rename_dgps("New DGP1" = "DGP1", "New DGP2" = "DGP2") + expect_equal( + purrr::map_chr(experiment$get_dgps(), ~ .x$name), + c("New DGP1" = "New DGP1", "New DGP2" = "New DGP2") ) - expect_error( - experiment |> - rename_dgps("DGP2" = "DGP1") + experiment |> rename_methods("New Method1" = "Method1") + expect_equal( + purrr::map_chr(experiment$get_methods(), ~ .x$name), + c("New Method1" = "New Method1") + ) + experiment |> rename_evaluators("New Evaluator1" = "Evaluator1") + expect_equal( + purrr::map_chr(experiment$get_evaluators(), ~ .x$name), + c("New Evaluator1" = "New Evaluator1") + ) + experiment |> rename_visualizers("New Visualizer1" = "Visualizer1") + expect_equal( + purrr::map_chr(experiment$get_visualizers(), ~ .x$name), + c("New Visualizer1" = "New Visualizer1") + ) + expect_equal( + list.files(experiment$get_save_dir(), pattern = ".rds", recursive = TRUE), + "experiment.rds" ) - # TODO: write better tests for renaming + # check renaming with save/cached results + init_docs(experiment) + results <- run_experiment(experiment, n_reps = 2, save = TRUE) + init_docs(exp) + res <- run_experiment(exp, n_reps = 2, save = TRUE) + + # rename DGPs expect_error( - experiment |> - rename_dgps( - "New DGP1" = "DGP1", - "New DGP2" = "DGP2" - ), + experiment |> rename_dgps("DGP1" = "New DGP1", "DGP2" = "New DGP2"), NA ) expect_error( - experiment |> - rename_methods( - "New Method1" = "Method1" - ), + experiment |> rename_methods("Method1" = "New Method1"), NA ) + experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + fit_results <- get_cached_results(experiment, "fit") + expect_equal(fit_results, old_results$fit_results) + expect_equal(experiment_cached_params$fit, old_experiment_cached_params$fit) expect_error( - experiment |> - rename_evaluators( - "New Evaluator1" = "Evaluator1" - ), + experiment |> rename_evaluators("Evaluator1" = "New Evaluator1"), NA ) + experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + eval_results <- get_cached_results(experiment, "eval") + expect_equal(eval_results, old_results$eval_results) + expect_equal(experiment_cached_params$evaluate, old_experiment_cached_params$evaluate) expect_error( - experiment |> - rename_visualizers( - "New Visualizer1" = "Visualizer1" - ), + experiment |> rename_visualizers("Visualizer1" = "New Visualizer1"), NA ) + experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + viz_results <- get_cached_results(experiment, "viz") + expect_equal(viz_results, old_results$viz_results) + expect_equal(old_experiment_cached_params, experiment_cached_params) #TODO: with vary across #TODO: with save_in_bulk = FALSE #TODO: with save_in_bulk = FALSE and vary across From ab44942c616da6522efc7b949e849619ac174df4 Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 16:55:46 -0600 Subject: [PATCH 3/7] bug fixes --- R/experiment.R | 20 ++- tests/testthat/test-experiment.R | 219 ++++++++++++++++++++++++++++++- 2 files changed, 228 insertions(+), 11 deletions(-) diff --git a/R/experiment.R b/R/experiment.R index 20ef6fb..dfbb8ac 100644 --- a/R/experiment.R +++ b/R/experiment.R @@ -200,7 +200,13 @@ Experiment <- R6::R6Class( # rename results directory if needed if (!identical(old_save_dir, save_dir)) { - invisible(file.rename(old_save_dir, save_dir)) + if (file.exists(old_save_dir)) { + if (private$.has_vary_across()) { + invisible(file.rename(dirname(old_save_dir), dirname(save_dir))) + } else { + invisible(file.rename(old_save_dir, save_dir)) + } + } } ## experiment @@ -277,9 +283,9 @@ Experiment <- R6::R6Class( eval_results <- private$.get_cached_results("eval", verbose = 0) if (!is.null(eval_results)) { if (field_verb == "fit") { - eval_results <- purrr::map2( - names(eval_results), eval_results, - function(eval_name, eval_result) { + eval_results <- purrr::imap( + eval_results, + function(eval_result, eval_name) { if (field_col %in% colnames(eval_result)) { eval_result[[field_col]] <- replace_values( eval_result[[field_col]], obj_names, new_obj_names @@ -348,8 +354,8 @@ Experiment <- R6::R6Class( viz_cached_params <- cached_params$visualize viz_cached_params$visualize <- NULL if (identical(eval_cached_params, viz_cached_params)) { - fit_results <- private$.get_cached_results("fit", verbose = 0) - eval_results <- private$.get_cached_results("eval", verbose = 0) + fit_results <- self$get_cached_results("fit", verbose = 0) + eval_results <- self$get_cached_results("eval", verbose = 0) viz_results <- tryCatch( self$visualize( fit_results, eval_results, @@ -1402,7 +1408,7 @@ Experiment <- R6::R6Class( } else { save_dir <- private$.get_vary_across_dir() } - if (!save_in_bulk) { + if (save && !save_in_bulk) { if (!dir.exists(file.path(save_dir, "fit_results"))) { dir.create(file.path(save_dir, "fit_results"), recursive = TRUE) } diff --git a/tests/testthat/test-experiment.R b/tests/testthat/test-experiment.R index 9265853..96b990f 100644 --- a/tests/testthat/test-experiment.R +++ b/tests/testthat/test-experiment.R @@ -235,7 +235,7 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { old_experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") old_res <- run_experiment(exp, n_reps = 2, save = TRUE) old_exp <- get_cached_results(exp, "experiment") - old_cached_exp_params <- get_cached_results(exp, "experiment_cached_params") + old_exp_cached_params <- get_cached_results(exp, "experiment_cached_params") # remove cache experiment$clear_cache() @@ -285,6 +285,31 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { "experiment.rds" ) + exp |> rename_dgps("New DGP1" = "DGP1", "New DGP2" = "DGP2") + expect_equal( + purrr::map_chr(exp$get_dgps(), ~ .x$name), + c("New DGP1" = "New DGP1", "New DGP2" = "New DGP2") + ) + exp |> rename_methods("New Method1" = "Method1") + expect_equal( + purrr::map_chr(exp$get_methods(), ~ .x$name), + c("New Method1" = "New Method1") + ) + exp |> rename_evaluators("New Evaluator1" = "Evaluator1") + expect_equal( + purrr::map_chr(exp$get_evaluators(), ~ .x$name), + c("New Evaluator1" = "New Evaluator1") + ) + exp |> rename_visualizers("New Visualizer1" = "Visualizer1") + expect_equal( + purrr::map_chr(exp$get_visualizers(), ~ .x$name), + c("New Visualizer1" = "New Visualizer1") + ) + expect_equal( + list.files(exp$get_save_dir(), pattern = ".rds", recursive = TRUE), + "experiment.rds" + ) + # check renaming with save/cached results init_docs(experiment) results <- run_experiment(experiment, n_reps = 2, save = TRUE) @@ -320,9 +345,195 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { viz_results <- get_cached_results(experiment, "viz") expect_equal(viz_results, old_results$viz_results) expect_equal(old_experiment_cached_params, experiment_cached_params) - #TODO: with vary across - #TODO: with save_in_bulk = FALSE - #TODO: with save_in_bulk = FALSE and vary across + + expect_error( + exp |> rename_dgps("DGP1" = "New DGP1", "DGP2" = "New DGP2"), + NA + ) + expect_error( + exp |> rename_methods("Method1" = "New Method1"), + NA + ) + exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + fit_res <- get_cached_results(exp, "fit") + expect_equal(fit_res, old_res$fit_results) + expect_equal(exp_cached_params$fit, old_exp_cached_params$fit) + expect_error( + exp |> rename_evaluators("Evaluator1" = "New Evaluator1"), + NA + ) + exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + eval_res <- get_cached_results(exp, "eval") + expect_equal(eval_res, old_res$eval_results) + expect_equal(exp_cached_params$evaluate, old_exp_cached_params$evaluate) + expect_error( + exp |> rename_visualizers("Visualizer1" = "New Visualizer1"), + NA + ) + exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + viz_res <- get_cached_results(exp, "viz") + expect_equal(viz_res, old_res$viz_results) + expect_equal(old_exp_cached_params, exp_cached_params) + + # check docs + expect_false(any(stringr::str_detect( + list.files( + file.path(experiment$get_save_dir(), "docs"), + pattern = ".md", recursive = TRUE + ), + "New" + ))) + expect_false(any(stringr::str_detect( + list.files( + file.path(exp$get_save_dir(), "docs"), + pattern = ".md", recursive = TRUE + ), + "New" + ))) + + # with vary across + experiment |> add_vary_across(.dgp = "DGP1", x = c(1, 2)) + exp |> add_vary_across(.dgp = "DGP1", x = c(1, 2)) + + # rename DGP + expect_error(experiment |> rename_dgps("DGP3" = "DGP1"), NA) + expect_equal( + experiment$get_vary_across()["dgp"], + list(dgp = list(DGP3 = list(x = 1:2))) + ) + expect_error(exp |> rename_dgps("DGP3" = "DGP1"), NA) + expect_equal( + exp$get_vary_across()["dgp"], + list(dgp = list(DGP3 = list(x = 1:2))) + ) + + # get original results + old_results <- run_experiment(experiment, n_reps = 2, save = TRUE) + old_experiment <- get_cached_results(experiment, "experiment") + old_experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + old_res <- run_experiment(exp, n_reps = 2, save = TRUE) + old_exp <- get_cached_results(exp, "experiment") + old_exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + unlink(file.path(experiment$get_save_dir(), "DGP3"), recursive = TRUE) + unlink(file.path(exp$get_save_dir(), "DGP3"), recursive = TRUE) + + # run experiment without saving + results <- run_experiment(experiment, n_reps = 2, save = FALSE) + res <- run_experiment(exp, n_reps = 2, save = FALSE) + + # check renaming without save/cached results + experiment |> rename_dgps("New DGP3" = "DGP3", "New DGP2" = "DGP2") + expect_equal( + purrr::map_chr(experiment$get_dgps(), ~ .x$name), + c("New DGP3" = "New DGP3", "New DGP2" = "New DGP2") + ) + expect_equal( + experiment$get_vary_across()["dgp"], + list(dgp = list(`New DGP3` = list(x = 1:2))) + ) + experiment |> rename_methods("New Method1" = "Method1") + expect_equal( + purrr::map_chr(experiment$get_methods(), ~ .x$name), + c("New Method1" = "New Method1") + ) + experiment |> rename_evaluators("New Evaluator1" = "Evaluator1") + expect_equal( + purrr::map_chr(experiment$get_evaluators(), ~ .x$name), + c("New Evaluator1" = "New Evaluator1") + ) + experiment |> rename_visualizers("New Visualizer1" = "Visualizer1") + expect_equal( + purrr::map_chr(experiment$get_visualizers(), ~ .x$name), + c("New Visualizer1" = "New Visualizer1") + ) + + exp |> rename_dgps("New DGP3" = "DGP3", "New DGP2" = "DGP2") + expect_equal( + purrr::map_chr(exp$get_dgps(), ~ .x$name), + c("New DGP3" = "New DGP3", "New DGP2" = "New DGP2") + ) + expect_equal( + exp$get_vary_across()["dgp"], + list(dgp = list(`New DGP3` = list(x = 1:2))) + ) + exp |> rename_methods("New Method1" = "Method1") + expect_equal( + purrr::map_chr(exp$get_methods(), ~ .x$name), + c("New Method1" = "New Method1") + ) + exp |> rename_evaluators("New Evaluator1" = "Evaluator1") + expect_equal( + purrr::map_chr(exp$get_evaluators(), ~ .x$name), + c("New Evaluator1" = "New Evaluator1") + ) + exp |> rename_visualizers("New Visualizer1" = "Visualizer1") + expect_equal( + purrr::map_chr(exp$get_visualizers(), ~ .x$name), + c("New Visualizer1" = "New Visualizer1") + ) + + # check renaming with save/cached results + results <- run_experiment(experiment, n_reps = 2, save = TRUE) + res <- run_experiment(exp, n_reps = 2, save = TRUE) + + # rename DGPs + expect_error( + experiment |> rename_dgps("DGP3" = "New DGP3", "DGP2" = "New DGP2"), + NA + ) + expect_error( + experiment |> rename_methods("Method1" = "New Method1"), + NA + ) + experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + fit_results <- get_cached_results(experiment, "fit") + expect_equal(fit_results, old_results$fit_results) + expect_equal(experiment_cached_params$fit, old_experiment_cached_params$fit) + expect_error( + experiment |> rename_evaluators("Evaluator1" = "New Evaluator1"), + NA + ) + experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + eval_results <- get_cached_results(experiment, "eval") + expect_equal(eval_results, old_results$eval_results) + expect_equal(experiment_cached_params$evaluate, old_experiment_cached_params$evaluate) + expect_error( + experiment |> rename_visualizers("Visualizer1" = "New Visualizer1"), + NA + ) + experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") + viz_results <- get_cached_results(experiment, "viz") + expect_equal(viz_results, old_results$viz_results) + expect_equal(old_experiment_cached_params, experiment_cached_params) + + expect_error( + exp |> rename_dgps("DGP3" = "New DGP3", "DGP2" = "New DGP2"), + NA + ) + expect_error( + exp |> rename_methods("Method1" = "New Method1"), + NA + ) + exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + fit_res <- get_cached_results(exp, "fit") + expect_equal(fit_res, old_res$fit_results) + expect_equal(exp_cached_params$fit, old_exp_cached_params$fit) + expect_error( + exp |> rename_evaluators("Evaluator1" = "New Evaluator1"), + NA + ) + exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + eval_res <- get_cached_results(exp, "eval") + expect_equal(eval_res, old_res$eval_results) + expect_equal(exp_cached_params$evaluate, old_exp_cached_params$evaluate) + expect_error( + exp |> rename_visualizers("Visualizer1" = "New Visualizer1"), + NA + ) + exp_cached_params <- get_cached_results(exp, "experiment_cached_params") + viz_res <- get_cached_results(exp, "viz") + expect_equal(viz_res, old_res$viz_results) + expect_equal(old_exp_cached_params, exp_cached_params) }) test_that("Running experiment works properly", { From 7bf2c40559e08de3d0aa5ac407f5998962caa276 Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 20:15:28 -0600 Subject: [PATCH 4/7] bug fixes and update tests --- R/experiment.R | 17 ++- tests/testthat/test-experiment.R | 245 +++++++++++++++++++++---------- 2 files changed, 182 insertions(+), 80 deletions(-) diff --git a/R/experiment.R b/R/experiment.R index dfbb8ac..fb202d6 100644 --- a/R/experiment.R +++ b/R/experiment.R @@ -352,8 +352,21 @@ Experiment <- R6::R6Class( record_time <- !is.null(attr(viz_results[[1]], ".time_taken")) eval_cached_params <- cached_params$evaluate viz_cached_params <- cached_params$visualize - viz_cached_params$visualize <- NULL - if (identical(eval_cached_params, viz_cached_params)) { + is_fit_cache_equal <- compare_tibble_rows( + eval_cached_params$fit |> + dplyr::arrange(.dgp_name, .method_name), + viz_cached_params$fit |> + dplyr::arrange(.dgp_name, .method_name), + op = "equal" + ) + is_eval_cache_equal <- compare_tibble_rows( + eval_cached_params$evaluate |> + dplyr::arrange(.eval_name), + viz_cached_params$evaluate |> + dplyr::arrange(.eval_name), + op = "equal" + ) + if (is_fit_cache_equal && is_eval_cache_equal) { fit_results <- self$get_cached_results("fit", verbose = 0) eval_results <- self$get_cached_results("eval", verbose = 0) viz_results <- tryCatch( diff --git a/tests/testthat/test-experiment.R b/tests/testthat/test-experiment.R index 96b990f..d84ac30 100644 --- a/tests/testthat/test-experiment.R +++ b/tests/testthat/test-experiment.R @@ -230,10 +230,10 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { ) # get original results - old_results <- run_experiment(experiment, n_reps = 2, save = TRUE) + old_results <- run_experiment(experiment, n_reps = 2, save = TRUE, verbose = 0) old_experiment <- get_cached_results(experiment, "experiment") old_experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") - old_res <- run_experiment(exp, n_reps = 2, save = TRUE) + old_res <- run_experiment(exp, n_reps = 2, save = TRUE, verbose = 0) old_exp <- get_cached_results(exp, "experiment") old_exp_cached_params <- get_cached_results(exp, "experiment_cached_params") @@ -255,9 +255,9 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { # run experiment without saving init_docs(experiment) - results <- run_experiment(experiment, n_reps = 2, save = FALSE) + results <- run_experiment(experiment, n_reps = 2, save = FALSE, verbose = 0) init_docs(exp) - res <- run_experiment(exp, n_reps = 2, save = FALSE) + res <- run_experiment(exp, n_reps = 2, save = FALSE, verbose = 0) # check renaming without save/cached results experiment |> rename_dgps("New DGP1" = "DGP1", "New DGP2" = "DGP2") @@ -312,68 +312,112 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { # check renaming with save/cached results init_docs(experiment) - results <- run_experiment(experiment, n_reps = 2, save = TRUE) + results <- run_experiment(experiment, n_reps = 2, save = TRUE, verbose = 0) init_docs(exp) - res <- run_experiment(exp, n_reps = 2, save = TRUE) + res <- run_experiment(exp, n_reps = 2, save = TRUE, verbose = 0) # rename DGPs - expect_error( - experiment |> rename_dgps("DGP1" = "New DGP1", "DGP2" = "New DGP2"), - NA - ) - expect_error( - experiment |> rename_methods("Method1" = "New Method1"), - NA - ) + experiment |> + rename_dgps("DGP1" = "New DGP1", "DGP2" = "New DGP2") |> + rename_methods("Method1" = "New Method1") experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") fit_results <- get_cached_results(experiment, "fit") expect_equal(fit_results, old_results$fit_results) - expect_equal(experiment_cached_params$fit, old_experiment_cached_params$fit) - expect_error( - experiment |> rename_evaluators("Evaluator1" = "New Evaluator1"), - NA + expect_equal( + experiment_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) + experiment |> rename_evaluators("Evaluator1" = "New Evaluator1") experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") eval_results <- get_cached_results(experiment, "eval") expect_equal(eval_results, old_results$eval_results) - expect_equal(experiment_cached_params$evaluate, old_experiment_cached_params$evaluate) - expect_error( - experiment |> rename_visualizers("Visualizer1" = "New Visualizer1"), - NA + expect_equal( + experiment_cached_params$evaluate$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$evaluate$fit |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + experiment_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) ) + experiment |> rename_visualizers("Visualizer1" = "New Visualizer1") experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") viz_results <- get_cached_results(experiment, "viz") expect_equal(viz_results, old_results$viz_results) - expect_equal(old_experiment_cached_params, experiment_cached_params) - - expect_error( - exp |> rename_dgps("DGP1" = "New DGP1", "DGP2" = "New DGP2"), - NA + expect_equal( + experiment_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) - expect_error( - exp |> rename_methods("Method1" = "New Method1"), - NA + expect_equal( + experiment_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) ) + expect_equal( + experiment_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")) + ) + + exp |> + rename_dgps("DGP1" = "New DGP1", "DGP2" = "New DGP2") |> + rename_methods("Method1" = "New Method1") exp_cached_params <- get_cached_results(exp, "experiment_cached_params") fit_res <- get_cached_results(exp, "fit") expect_equal(fit_res, old_res$fit_results) - expect_equal(exp_cached_params$fit, old_exp_cached_params$fit) - expect_error( - exp |> rename_evaluators("Evaluator1" = "New Evaluator1"), - NA + expect_equal( + exp_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) + exp |> rename_evaluators("Evaluator1" = "New Evaluator1") exp_cached_params <- get_cached_results(exp, "experiment_cached_params") eval_res <- get_cached_results(exp, "eval") expect_equal(eval_res, old_res$eval_results) - expect_equal(exp_cached_params$evaluate, old_exp_cached_params$evaluate) - expect_error( - exp |> rename_visualizers("Visualizer1" = "New Visualizer1"), - NA + expect_equal( + exp_cached_params$evaluate$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$evaluate$fit |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + exp_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) ) + exp |> rename_visualizers("Visualizer1" = "New Visualizer1") exp_cached_params <- get_cached_results(exp, "experiment_cached_params") viz_res <- get_cached_results(exp, "viz") expect_equal(viz_res, old_res$viz_results) - expect_equal(old_exp_cached_params, exp_cached_params) + expect_equal( + exp_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + exp_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + exp_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")) + ) # check docs expect_false(any(stringr::str_detect( @@ -390,6 +434,7 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { ), "New" ))) + }) # with vary across experiment |> add_vary_across(.dgp = "DGP1", x = c(1, 2)) @@ -408,18 +453,18 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { ) # get original results - old_results <- run_experiment(experiment, n_reps = 2, save = TRUE) + old_results <- run_experiment(experiment, n_reps = 2, save = TRUE, verbose = 0) old_experiment <- get_cached_results(experiment, "experiment") old_experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") - old_res <- run_experiment(exp, n_reps = 2, save = TRUE) + old_res <- run_experiment(exp, n_reps = 2, save = TRUE, verbose = 0) old_exp <- get_cached_results(exp, "experiment") old_exp_cached_params <- get_cached_results(exp, "experiment_cached_params") unlink(file.path(experiment$get_save_dir(), "DGP3"), recursive = TRUE) unlink(file.path(exp$get_save_dir(), "DGP3"), recursive = TRUE) # run experiment without saving - results <- run_experiment(experiment, n_reps = 2, save = FALSE) - res <- run_experiment(exp, n_reps = 2, save = FALSE) + results <- run_experiment(experiment, n_reps = 2, save = FALSE, verbose = 0) + res <- run_experiment(exp, n_reps = 2, save = FALSE, verbose = 0) # check renaming without save/cached results experiment |> rename_dgps("New DGP3" = "DGP3", "New DGP2" = "DGP2") @@ -473,67 +518,111 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { ) # check renaming with save/cached results - results <- run_experiment(experiment, n_reps = 2, save = TRUE) - res <- run_experiment(exp, n_reps = 2, save = TRUE) + results <- run_experiment(experiment, n_reps = 2, save = TRUE, verbose = 0) + res <- run_experiment(exp, n_reps = 2, save = TRUE, verbose = 0) # rename DGPs - expect_error( - experiment |> rename_dgps("DGP3" = "New DGP3", "DGP2" = "New DGP2"), - NA - ) - expect_error( - experiment |> rename_methods("Method1" = "New Method1"), - NA - ) + experiment |> + rename_dgps("DGP3" = "New DGP3", "DGP2" = "New DGP2") |> + rename_methods("Method1" = "New Method1") experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") fit_results <- get_cached_results(experiment, "fit") expect_equal(fit_results, old_results$fit_results) - expect_equal(experiment_cached_params$fit, old_experiment_cached_params$fit) - expect_error( - experiment |> rename_evaluators("Evaluator1" = "New Evaluator1"), - NA + expect_equal( + experiment_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) + experiment |> rename_evaluators("Evaluator1" = "New Evaluator1") experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") eval_results <- get_cached_results(experiment, "eval") expect_equal(eval_results, old_results$eval_results) - expect_equal(experiment_cached_params$evaluate, old_experiment_cached_params$evaluate) - expect_error( - experiment |> rename_visualizers("Visualizer1" = "New Visualizer1"), - NA + expect_equal( + experiment_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + experiment_cached_params$evaluate$visualize |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$evaluate$visualize |> + dplyr::select(-tidyselect::contains("_fun")) ) + experiment |> rename_visualizers("Visualizer1" = "New Visualizer1") experiment_cached_params <- get_cached_results(experiment, "experiment_cached_params") viz_results <- get_cached_results(experiment, "viz") expect_equal(viz_results, old_results$viz_results) - expect_equal(old_experiment_cached_params, experiment_cached_params) - - expect_error( - exp |> rename_dgps("DGP3" = "New DGP3", "DGP2" = "New DGP2"), - NA + expect_equal( + experiment_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) - expect_error( - exp |> rename_methods("Method1" = "New Method1"), - NA + expect_equal( + experiment_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) ) + expect_equal( + experiment_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")), + old_experiment_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")) + ) + + exp |> + rename_dgps("DGP3" = "New DGP3", "DGP2" = "New DGP2") |> + rename_methods("Method1" = "New Method1") exp_cached_params <- get_cached_results(exp, "experiment_cached_params") fit_res <- get_cached_results(exp, "fit") expect_equal(fit_res, old_res$fit_results) - expect_equal(exp_cached_params$fit, old_exp_cached_params$fit) - expect_error( - exp |> rename_evaluators("Evaluator1" = "New Evaluator1"), - NA + expect_equal( + exp_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$fit$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) + exp |> rename_evaluators("Evaluator1" = "New Evaluator1") exp_cached_params <- get_cached_results(exp, "experiment_cached_params") eval_res <- get_cached_results(exp, "eval") expect_equal(eval_res, old_res$eval_results) - expect_equal(exp_cached_params$evaluate, old_exp_cached_params$evaluate) - expect_error( - exp |> rename_visualizers("Visualizer1" = "New Visualizer1"), - NA + expect_equal( + exp_cached_params$evaluate$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$evaluate$fit |> + dplyr::select(-tidyselect::contains("_fun")) ) + expect_equal( + exp_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$evaluate$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) + ) + exp |> rename_visualizers("Visualizer1" = "New Visualizer1") exp_cached_params <- get_cached_results(exp, "experiment_cached_params") viz_res <- get_cached_results(exp, "viz") expect_equal(viz_res, old_res$viz_results) - expect_equal(old_exp_cached_params, exp_cached_params) + expect_equal( + exp_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$visualize$fit |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + exp_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$visualize$evaluate |> + dplyr::select(-tidyselect::contains("_fun")) + ) + expect_equal( + exp_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")), + old_exp_cached_params$visualize$visualize |> + dplyr::select(-tidyselect::contains("_fun")) + ) }) test_that("Running experiment works properly", { From f1bcfcecc7e9a706f3439dbcb911bb5e0fbe3489 Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 20:18:05 -0600 Subject: [PATCH 5/7] bug fix --- tests/testthat/test-experiment.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-experiment.R b/tests/testthat/test-experiment.R index d84ac30..12bcfd8 100644 --- a/tests/testthat/test-experiment.R +++ b/tests/testthat/test-experiment.R @@ -434,7 +434,6 @@ withr::with_tempdir(pattern = "simChef-test-checkpointing-temp", code = { ), "New" ))) - }) # with vary across experiment |> add_vary_across(.dgp = "DGP1", x = c(1, 2)) From d69fc99bfea05ac03aa4e4081389f1ba62c822ce Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 21:45:26 -0600 Subject: [PATCH 6/7] update pkgdown --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 65296f6..8af35ff 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -18,6 +18,7 @@ reference: - add_dgp - update_dgp - remove_dgp + - rename_dgps - get_dgps - remove_vary_across - clear_cache From fffca38b8c4cb3c23d12be5db780ec4db00b33e3 Mon Sep 17 00:00:00 2001 From: Tiffany Tang Date: Tue, 7 Jan 2025 21:48:52 -0600 Subject: [PATCH 7/7] update docs --- R/experiment.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/experiment.R b/R/experiment.R index fb202d6..182ec85 100644 --- a/R/experiment.R +++ b/R/experiment.R @@ -25,8 +25,8 @@ NULL #' [get_save_dir()], [set_save_dir()], [save_experiment()], #' [set_export_viz_options()], [export_visualizers()], [set_doc_options()], #' [`add_*()`](add_funs.html), [`update_*()`](update_funs.html), -#' [`remove_*()`](remove_funs.html), [`get_*()`](get_funs.html), and -#' [`*_vary_across()`](vary_across.html). +#' [`remove_*()`](remove_funs.html), [`rename_*()`](rename_funs.html) +#' [`get_*()`](get_funs.html), and [`*_vary_across()`](vary_across.html). #' #' @export Experiment <- R6::R6Class(