Run testthat Tests

DESCRIPTION

@@ -29,10 +29,14 @@ Imports:
     methods,
     purrr,
     R.utils,
+    assertthat,
+    usethis,
+    renv,
     R6,
     rlang,
     rmarkdown,
     stringr,
+    testthat (>= 3.1.0),
     tibble,
     tidyr,
     tidyselect,
@@ -41,6 +45,7 @@ Imports:
 Suggests:
     broom,
     callr,
+    devtools,
     fontawesome,
     fs,
     future.callr,
@@ -54,7 +59,6 @@ Suggests:
     progressr (>= 0.9.0),
     ranger,
     rstudioapi,
-    testthat (>= 3.1.0),
     vdiffr,
     withr (>= 2.5.0),
     ymlthis
@@ -79,7 +83,9 @@ Collate:
     'utils.R'
     'experiment.R'
     'globals.R'
+    'init-dir.R'
     'method.R'
+    'run-tests.R'
     'signals.R'
     'use_templates.R'
     'utils-pipe.R'

NAMESPACE

@@ -22,6 +22,7 @@ export(create_evaluator)
 export(create_experiment)
 export(create_method)
 export(create_rmd)
+export(create_sim)
 export(create_visualizer)
 export(eval_feature_importance)
 export(eval_feature_selection_curve)
@@ -48,6 +49,7 @@ export(get_vary_across)
 export(get_visualizers)
 export(init_docs)
 export(list_col_to_chr)
+export(load_all)
 export(neg)
 export(neg_vec)
 export(plot_eval_summary)
@@ -69,6 +71,7 @@ export(remove_vary_across)
 export(remove_visualizer)
 export(render_docs)
 export(run_experiment)
+export(run_tests)
 export(save_experiment)
 export(set_doc_options)
 export(set_rmd_options)
@@ -81,6 +84,7 @@ export(summarize_pred_curve)
 export(summarize_pred_err)
 export(summarize_testing_curve)
 export(summarize_testing_err)
+export(test_sim_dir)
 export(tp)
 export(tp_vec)
 export(update_dgp)

R/init-dir.R

@@ -0,0 +1,137 @@
+#' @title Create a simulation project
+#'
+#' @description \code{create_sim()} initializes a directory for your simulation
+#'   study. It wraps around \code{\link[usethis]{create_project}()}, as well as
+#'   \code{\link[usethis:use_git]{usethis::use_git}()} and
+#'   \code{\link[renv:init]{renv::init}()}.
+#'
+#' @param path A \code{character} specifying the path for your simulation
+#'   directory.
+#' @param init_git A \code{logical} indicating whether to intialize your
+#'   simulation directory as a git repository.
+#' @param init_renv A \code{logical} stating whether to initialize
+#'   \code{\link[renv:init]{renv}}. Defaults to \code{FALSE}.
+#' @param tests A \code{logical} indicating whether to generate sub-directories
+#'   for organizing unit tests. Defaults to \code{TRUE}.
+#' @param hpc A \code{logical} indicating whether to create sub-directories for
+#'   organizing files related to high-power computing environments. Defaults to
+#'   \code{FALSE}.
+#'
+#' @export
+create_sim <- function(
+  path,
+  init_git = TRUE,
+  init_renv = FALSE,
+  tests = TRUE,
+  hpc = FALSE
+) {
+
+  ## ensure arguments are appropriate
+  assertthat::assert_that(is.character(path))
+  assertthat::assert_that(is.logical(init_git))
+  assertthat::assert_that(is.logical(init_renv))
+  assertthat::assert_that(is.logical(tests))
+  assertthat::assert_that(is.logical(hpc))
+
+  ## don't overwrite existing project
+  assertthat::assert_that(
+    !dir.exists(paths = path),
+    msg = "This directory already exists. Try another."
+  )
+
+  ## intialize a project
+  usethis::create_project(
+    path = path,
+    open = FALSE
+  )
+
+  ## state the necessary directories
+  dirs <- c(
+    "R", "R/dgp", "R/method", "R/eval", "R/viz", "results"
+  )
+
+  ## add the optional directories
+  if (tests) {
+    dirs <- c(
+      dirs, "tests", "tests/testthat", "tests/testthat/dgp-tests",
+      "tests/testthat/method-tests", "tests/testthat/eval-tests",
+      "tests/testthat/viz-tests"
+    )
+  }
+  if (hpc) {
+    dirs <- c(dirs, "scripts", "logs")
+  }
+
+  ## create the specified directories
+  sapply(
+    dirs,
+    function(dir) {
+      dir.create(path = paste(path, dir, sep = "/"), showWarnings = FALSE)
+    }
+  )
+
+  ## state the necessary files
+  files <- c("README.md", "R/meal.R")
+  if (tests) {
+    files <- c(files, "tests/testthat.R")
+  }
+
+  ## create the specified files
+  file.create(paste(path, files, sep = "/"))
+
+  ## write the header of R/meal.R
+  meal_file <- file(paste(path, "R/meal.R", sep = "/"))
+  writeLines(
+    c(
+      "# load required libraries",
+      "library(simChef)",
+      "# other libraries ...",
+      "",
+      "# get simulatin'!"
+    ),
+    con = meal_file
+  )
+  close(meal_file)
+
+  ## write minimal template for README.md
+  readme_file <- file(paste(path, "README.md", sep = "/"))
+  writeLines(
+    c(
+      "# Simulation Study Title",
+      "",
+      "## Description",
+      "",
+      "What's this simulation study about?"
+    ),
+    con = readme_file
+  )
+  close(readme_file)
+
+  ## write tests/testthat.R if necessary
+  if (tests) {
+    testthat_file <- file(paste(path, "tests/testthat.R", sep = "/"))
+    writeLines(
+      c(
+        "library(simChef)",
+        "library(testthat)",
+        "# load required packages here",
+        "",
+        "load_all()",
+        "test_sim_dir()"
+      ),
+      con = testthat_file
+    )
+    close(testthat_file)
+  }
+
+  ## activate the project
+  if (rlang::is_interactive()) {
+    usethis::proj_activate(path = path)
+
+    ## initialize a git repository if asked
+    if (init_git) usethis::use_git()
+
+    ## intialize renv if desired
+    if (init_renv) renv::init()
+  }
+}

R/run-tests.R

@@ -0,0 +1,116 @@
+#' Run Tests
+#'
+#' @description \code{run_tests()} runs the tests in the `tests/` directory.
+#'   This function only works if the simulation study is set up as an R project
+#'   and if it is run when this R project is active.
+#'
+#' @export
+run_tests <- function() {
+
+  # construct path to testthat.R
+  sim_project_path <- usethis::proj_get()
+  testthat_path <- paste(sim_project_path, "tests/testthat.R", sep = "/")
+
+  # attempt to run tests
+  if (file.exists(testthat_path)) {
+    source(testthat_path)
+  } else {
+    stop(
+      "Cannot find ", testthat_path, ". Is this simulation your active project?"
+    )
+  }
+
+  invisible()
+}
+
+#' Test simChef Ingredients
+#'
+#' @description \code{test_sim_dir()} wraps around
+#'   \code{\link[testthat]{test_dir}()} to run all dgp-, method-, evaluator-,
+#'   and visualizer-related tests.
+#'
+#' @details This function only works if the simulation study is set up as an R
+#'   project and if it is run when this R project is active. Additionally, tests
+#'   must be stored in sub-directories whose names match those suggesting in the
+#'   "Setting Up Your Simulation" vignette. These details are conveniently taken
+#'   care of when a simulation study is set up using \code{\link{create_sim}()}.
+#'
+#' @export
+test_sim_dir <- function() {
+
+  # set up paths
+  path_to_tests <- paste0(usethis::proj_get(), "/tests/testthat")
+
+  # make sure that the testthat directory exists
+  assertthat::assert_that(
+    dir.exists(path_to_tests),
+     msg = paste0(
+       "Cannot find ", path_to_tests,
+       ". Is this simulation your active project?"
+     )
+  )
+
+  # make sure that subdirectories exist
+  assertthat::assert_that(
+    all(dir.exists(paste0(
+      path_to_tests,
+      c("/dgp-tests", "/method-tests", "/eval-tests", "/viz-tests")
+    ))),
+    msg = paste0("No test subdirectories found; dgp-, method-, evaluator- and ",
+                 "visualizer-related tests must be saved in",
+                 "tests/testthat/dgp-tests, tests/testthat/metod-tests, ",
+                 "tests/testthat/eval-tests and tests/testthat/viz-tests, ",
+                 "respectively.")
+  )
+
+  # test dgp-related functions
+  dgp_test_path <- paste0(path_to_tests, "/dgp-tests")
+  if (length(list.files(dgp_test_path)) > 0) {
+    cat("\n")
+    usethis::ui_line("Running dgp-related tests:")
+    testthat::test_dir(dgp_test_path)
+  }
+
+  # test method-related functions
+  method_test_path <- paste0(path_to_tests, "/method-tests")
+  if (length(list.files(method_test_path)) > 0) {
+    cat("\n")
+    usethis::ui_line("Running method-related tests:")
+    testthat::test_dir(method_test_path)
+  }
+
+  # test evaluator-related functions
+  eval_test_path <- paste0(path_to_tests, "/eval-tests")
+  if (length(list.files(eval_test_path)) > 0) {
+    cat("\n")
+    usethis::ui_line("Running evaluator-related tests:")
+    testthat::test_dir(eval_test_path)
+  }
+
+  # test visualizer-related functions
+  viz_test_path <- paste0(path_to_tests, "/viz-tests")
+  if (length(list.files(viz_test_path)) > 0) {
+    cat("\n")
+    usethis::ui_line("Running visualizer-related tests:")
+    testthat::test_dir(viz_test_path)
+  }
+
+  invisible()
+}
+
+
+#' Load All Simulation Functions in R/
+#'
+#' @description \code{load_all()} is simulation study counterpart to
+#'   \code{\link[devtools:load_all]{devtools::load_all}()} it loads all of
+#'   the functions in the \code{R/dgp}, \code{R/method}, \code{R/eval} and
+#'   \code{R/viz} directories of the current simulation study.
+#'
+#' @export
+load_all <- function() {
+  sim_functions_files <- list.files(
+    c("R/dgp", "R/method", "R/eval", "R/viz"),
+    pattern = "*.R$", full.names = TRUE, ignore.case = TRUE
+  )
+  sapply(sim_functions_files, source)
+}

_pkgdown.yml

@@ -26,6 +26,11 @@ reference:
       - set_save_dir
       - save_experiment
       - export_visualizers
+  - title: "Simulation Experiment Directory Setup"
+    desc: >
+      Functions for automatically setting up a simulation experiment directory.
+    contents:
+      - create_sim
   - title: "R Markdown Report"
     desc: >
       Functions for summarizing and visualizing results from a simulation
@@ -112,6 +117,12 @@ reference:
       A library of minimalistic templates for running common types of simulation experiments.
     contents:
       - library_templates
+  - subtitle: "Testing Functions"
+    desc: >
+      Functions for test-driven simulation studies.
+    contents:
+      - run_tests
+      - test_sim_dir
   - subtitle: "Developer Functions"
     desc: >
       Helper functions for developers to create their own simulation experiment components.
@@ -122,3 +133,4 @@ reference:
       - plot_eval_summary
       - plot_fit_results
       - list_col_to_chr
+      - load_all