Add eval_cache and viz_cache options in render_docs() (#195)

* export HTML function to fix bug in `render_docs(write_rmd = TRUE)`

* add eval_cache and viz_cache options in `render_docs()`

* change default in `export_visualizer()` from pdf to png

* update docs and tests

NAMESPACE

@@ -7,6 +7,7 @@ S3method(tp,data.frame)
 export(DGP)
 export(Evaluator)
 export(Experiment)
+export(HTML)
 export(Method)
 export(Visualizer)
 export(add_dgp)

R/docs.R

@@ -167,6 +167,17 @@ create_doc_template <- function(experiment, save_dir) {
 #' @param viz_order Vector of `Visualizer` names in their desired order for
 #'   display. By default, the report will display the `Visualizer` results
 #'   in the order that they were computed.
+#' @param eval_cache File extension of the cached evaluator results to read in.
+#'   Typically `".rds"` or `"none"`, but can be any file extension where
+#'   evaluator results are stored as `eval_results.ext` and can be read in
+#'   using `data.table::fread(eval_results.ext)`. If `"none"`, evaluator results
+#'   are computed using the experiment via [evaluate_experiment()].
+#' @param viz_cache File extension of the cached visualizer results to read in.
+#'   Typically `".rds"` or `"none"`, but can be any (image) file extension
+#'   (e.g., `"png"`, `"jpg"`) where the visualizer results have been previously
+#'   stored as separate `{visualizer_name}.ext` images (typically using
+#'   [export_visualizers()]). If `"none"`, visualizer results are computed using
+#'   the experiment via [visualize_experiment()].
 #' @param use_icons Logical indicating whether or not to use fontawesome icons.
 #' @param verbose Level of verboseness (0, 1, 2) when knitting R Markdown.
 #'   Default is 2.
@@ -189,7 +200,9 @@ render_docs <- function(experiment, save_dir, write_rmd = FALSE,
                         output_file = NULL, output_format = vthemes::vmodern(),
                         title = NULL, author = "",
                         show_code = TRUE, show_eval = TRUE, show_viz = TRUE,
-                        eval_order = NULL, viz_order = NULL, use_icons = TRUE,
+                        eval_order = NULL, viz_order = NULL,
+                        eval_cache = ".rds", viz_cache = ".rds",
+                        use_icons = TRUE,
                         quiet = TRUE, verbose = 2, ...) {
 
   if (missing(experiment) && missing(save_dir)) {
@@ -269,7 +282,9 @@ render_docs <- function(experiment, save_dir, write_rmd = FALSE,
     sim_name = title, sim_path = save_dir, author = author,
     write_filename = sprintf("%s.Rmd", output_file),
     show_code = show_code, show_eval = show_eval, show_viz = show_viz,
-    eval_order = eval_order, viz_order = viz_order, use_icons = use_icons,
+    eval_order = eval_order, viz_order = viz_order,
+    eval_cache = eval_cache, viz_cache = viz_cache,
+    use_icons = use_icons,
     use_vmodern = use_vmodern, write = write_rmd, verbose = verbose
   )
 

R/experiment.R

@@ -2005,7 +2005,7 @@ Experiment <- R6::R6Class(
     #' @param ... Additional arguments to pass to [ggplot2::ggsave()].
     #'
     #' @return The `Experiment` object, invisibly.
-    export_visualizers = function(device = "pdf", width = "auto", height = "auto",
+    export_visualizers = function(device = "png", width = "auto", height = "auto",
                                   ...) {
       rlang::check_installed("ggplot2",
         reason = "to export visualizers to image.")
@@ -2020,7 +2020,6 @@ Experiment <- R6::R6Class(
       } else {
         save_dir <- private$.get_vary_across_dir()
       }
-      save_dir <- file.path(save_dir, "viz_results")
       if (!dir.exists(save_dir)) {
         dir.create(save_dir, recursive = TRUE)
       }

R/utils.R

@@ -513,7 +513,7 @@ check_results_names <- function(names, method_name) {
 #'   `after`, and `outside` (equivalent to `before` and `end`).
 #'
 #' @returns The input `text`, but marked as HTML.
-#' @keywords internal
+#' @export
 HTML <- function(text, ..., .noWS = NULL) {
   htmlText <- c(text, as.character(rlang::dots_list(...)))
 

_pkgdown.yml

@@ -40,6 +40,7 @@ reference:
       - init_docs
       - render_docs
       - create_rmd
+      - HTML
   - title: "DGP"
     desc: >
       Functions for creating a DGP (data-generating process).

inst/rmd/results.Rmd

@@ -31,6 +31,12 @@ params:
   viz_order:
     label: "Order of Visualizers:"
     value: NULL
+  eval_cache:
+    label: "Evaluators Cache Type:"
+    value: ".rds"
+  viz_cache:
+    label: "Visualizers Cache Type:"
+    value: ".rds"
   use_icons:
     label: "Use Icons:"
     value: TRUE
@@ -338,18 +344,119 @@ show_recipe <- function(field_name = c(
 }
 
 #' Reads in file if it exists and returns NULL if the file does not exist
+#' 
+#' @description If filetype is ".rds", the file is read in using readRDS(). 
+#'   Otherwise, the file is read in using data.table::fread().
 #'
-#' @param filename name of .rds file to try reading in
-#' @return output of filename.rds if the file exists and NULL otherwise
-get_results <- function(filename) {
+#' @param filename name of file (with file extension) to try reading in
+#' @return output of filename if the file exists and NULL otherwise
+get_results <- function(filename, filetype = ".rds") {
   if (file.exists(filename)) {
-    results <- readRDS(filename)
+    if (filetype == ".rds") {
+      results <- readRDS(filename)
+    } else {
+      results <- data.table::fread(results)
+    }
   } else {
     results <- NULL
   }
   return(results)
 }
 
+#' Reads in list of image result files
+#' 
+#' @param filenames vector of filenames (without file extension) to read in
+#' @param filetype file extension
+#' @return list of image results, wrapped as knitr::include_graphics() objects
+get_image_results <- function(filenames, filetype) {
+  purrr::map(
+    filenames,
+    function(f) {
+      if (file.exists(sprintf("%s%s", f, filetype))) {
+        return(knitr::include_graphics(sprintf("%s%s", f, filetype)))
+      } else {
+        return(NULL)
+      }
+    }
+  ) |> 
+    setNames(basename(filenames)) |> 
+    purrr::compact()
+}
+
+#' Get results from experiment
+#' 
+#' @param dir_name name of directory
+#' @param show_eval logical; whether or not to show evaluators
+#' @param show_viz logical; whether or not to show visualizers
+#' @param eval_cache file extension for cached evaluator results to read in.
+#'   Typically ".rds" or "none", but can be any file extension where
+#'   evaluator results are stored as `eval_results.ext` and can be read in
+#'   using `data.table::fread(eval_results.ext)`. If "none", evaluator results
+#'   are computed using the experiment via `evaluate_experiment()`.
+#' @param viz_cache file extension for cached visualizer results to read in.
+#'   Typically ".rds" or "none", but can be any (image) file extension 
+#'   (e.g., "png", "jpg") where the visualizer results have been previously 
+#'   stored as separate `{visualizer_name}.ext` images (e.g., using
+#'   `export_visualizers()`). If "none", visualizer results are computed using
+#'   the experiment via `visualize_experiment()`.
+get_exp_results <- function(dir_name, 
+                            show_eval = TRUE, show_viz = TRUE,
+                            eval_cache = ".rds", viz_cache = ".rds") {
+  
+  exp_fname <- file.path(dir_name, "experiment.rds")
+  fit_fname <- file.path(dir_name, "fit_results.rds")
+  eval_fname <- file.path(dir_name, sprintf("eval_results%s", eval_cache))
+  viz_fname <- file.path(dir_name, sprintf("viz_results%s", viz_cache))
+
+  exp <- get_results(exp_fname)
+  fit_results <- NULL
+  eval_results <- NULL
+  viz_results <- NULL
+  if ((eval_cache != "none") && (viz_cache == ".rds")) {
+    if (show_eval) {
+      eval_results <- get_results(eval_fname, eval_cache)
+    }
+    if (show_viz) {
+      viz_results <- get_results(viz_fname, viz_cache)
+    }
+  } else {
+    if (show_eval) {
+      if (eval_cache == "none") {
+        fit_results <- get_results(fit_fname)
+        eval_results <- evaluate_experiment(exp, fit_results)
+      } else {
+        eval_results <- get_results(eval_fname, eval_cache)
+      }
+    }
+    if (show_viz) {
+      if (viz_cache == ".rds") {
+        viz_results <- get_results(viz_fname, viz_cache)
+      } else if (viz_cache == "none") {
+        if (is.null(fit_results)) {
+          fit_results <- get_results(fit_fname)
+        }
+        if (is.null(eval_results)) {
+          eval_results <- get_results(eval_fname)
+          if (is.null(eval_results)) {
+            eval_results <- evaluate_experiment(exp, fit_results)
+          }
+        }
+        viz_results <- visualize_experiment(exp, fit_results, eval_results)
+      } else {
+        viz_results <- get_image_results(
+          file.path(dir_name, names(exp$get_visualizers())), viz_cache
+        )
+      }
+    }
+  }
+  results <- list(
+    exp = exp,
+    eval_results = eval_results,
+    viz_results = viz_results
+  )
+  return(results)
+}
+
 #' Displays output (both from evaluate() and visualize()) from saved results under
 #' a specified directory
 #'
@@ -428,14 +535,26 @@ show_results <- function(dir_name, depth, base = FALSE, show_header = TRUE,
     code_label <- "Varying Parameters"
   }
 
-  exp_fname <- file.path(dir_name, "experiment.rds")
-  eval_fname <- file.path(dir_name, "eval_results.rds")
-  viz_fname <- file.path(dir_name, "viz_results.rds")
-
-  exp <- get_results(exp_fname)
-  eval_results <- get_results(eval_fname)
-  viz_results <- get_results(viz_fname)
+  exp_results <- get_exp_results(
+    dir_name, 
+    show_eval = params$show_eval, show_viz = params$show_viz,
+    eval_cache = params$eval_cache, viz_cache = params$viz_cache
+  )
+  exp <- exp_results$exp
+  eval_results <- exp_results$eval_results
+  viz_results <- exp_results$viz_results
 
+  if (write_flag && (params$show_eval || params$show_viz)) {
+    results <- sprintf(
+      "results <- get_exp_results(\n  '%s', show_eval = %s, show_viz = %s, eval_cache = '%s', viz_cache = '%s'\n)",
+      dir_name, 
+      params$show_eval, params$show_viz,
+      params$eval_cache, params$viz_cache
+    ) |>
+      write_code_chunk(chunk_args = "results = 'asis'") |>
+      write(old_text = results, write_flag = write_flag)
+  }
+  
   if (!is.null(eval_results) && params$show_eval) {
     results <- write(
       sprintf(showtype_template, evaluator_label),
@@ -471,7 +590,7 @@ show_results <- function(dir_name, depth, base = FALSE, show_header = TRUE,
         }
         if (write_flag) {
           results <- sprintf(
-            "show_results('%s', '%s', 'evaluator')", dir_name, eval_name
+            "show_results(results, '%s', 'evaluator')", eval_name
           ) |>
             write_code_chunk(chunk_args = "results = 'asis'") |>
             write(old_text = results, write_flag = write_flag)
@@ -522,7 +641,8 @@ show_results <- function(dir_name, depth, base = FALSE, show_header = TRUE,
           plt <- plts[[plt_name]]
           is_plot <- inherits(plt, "plotly") || 
             inherits(plt, "gg") || 
-            inherits(plt, "ggplot")
+            inherits(plt, "ggplot") ||
+            inherits(plt, "knit_image_paths")
           
           if (params$use_vmodern && is_plot) {
             chunk_args <- "fig.height = %s, fig.width = %s, out.width = '100%%', add.panel = TRUE"
@@ -534,7 +654,7 @@ show_results <- function(dir_name, depth, base = FALSE, show_header = TRUE,
           
           if (write_flag) {
             results <- sprintf(
-              "show_results('%s', '%s', 'visualizer')", dir_name, viz_name
+              "show_results(results, '%s', 'visualizer')", viz_name
             ) |>
               write_code_chunk(
                 chunk_args = sprintf(
@@ -567,9 +687,7 @@ show_results <- function(dir_name, depth, base = FALSE, show_header = TRUE,
         old_text = results, write_flag = write_flag
       )
       if (write_flag) {
-        results <- sprintf(
-          "show_results('%s', NULL, 'vary_params')", dir_name
-        ) |>
+        results <- c("show_results(results, NULL, 'vary_params')") |>
           write_code_chunk(chunk_args = "max.height='200px'") |>
           write(old_text = results, write_flag = write_flag)
       } else {