add export_options to Visualizer (#204)

* add export_options to Visualizer

.Rbuildignore

@@ -5,6 +5,7 @@
 ^pkgdown$
 ^LICENSE\.md$
 ^\.github$
+^results/*
 ^vignettes/results/*
 ^vignettes/example-docs/*
 ^man-roxygen

NAMESPACE

@@ -77,6 +77,7 @@ export(run_experiment)
 export(run_tests)
 export(save_experiment)
 export(set_doc_options)
+export(set_export_viz_options)
 export(set_rmd_options)
 export(set_save_dir)
 export(simplify_tibble)

R/experiment-helpers.R

@@ -1287,6 +1287,90 @@ save_experiment <- function(experiment) {
   experiment$save()
 }
 
+#' Set `ggplot2::ggsave` export options for a `Visualizer`.
+#'
+#' @name set_export_viz_options
+#' @description Set options to use in [ggplot2::ggsave()] when exporting
+#'   the `Visualizer`'s visualization with [export_visualizers()].
+#'
+#' @inheritParams shared_experiment_helpers_args
+#' @param name Name of `Visualizer` to set [ggplot2::ggsave()] options.
+#' @param ... Named options to set. See arguments of [ggplot2::ggsave()] for
+#'   possible options.
+#'
+#' @return The `Experiment` object with modified export options for the
+#'   specified `Visualizer`, invisibly.
+#'
+#' @examples
+#' ## create toy DGPs, Methods, Evaluators, and Visualizers
+#'
+#' # generate data from normal distribution with n samples
+#' normal_dgp <- create_dgp(
+#'   .dgp_fun = function(n) rnorm(n), .name = "Normal DGP", n = 100
+#' )
+#' # generate data from binomial distribution with n samples
+#' bernoulli_dgp <- create_dgp(
+#'   .dgp_fun = function(n) rbinom(n, 1, 0.5), .name = "Bernoulli DGP", n = 100
+#' )
+#'
+#' # compute mean of data
+#' mean_method <- create_method(
+#'   .method_fun = function(x) list(mean = mean(x)), .name = "Mean(x)"
+#' )
+#'
+#' # evaluate SD of mean(x) across simulation replicates
+#' sd_mean_eval <- create_evaluator(
+#'   .eval_fun = function(fit_results, vary_params = NULL) {
+#'     group_vars <- c(".dgp_name", ".method_name", vary_params)
+#'     fit_results |>
+#'       dplyr::group_by(dplyr::across(tidyselect::all_of(group_vars))) |>
+#'       dplyr::summarise(sd = sd(mean), .groups = "keep")
+#'   },
+#'   .name = "SD of Mean(x)"
+#' )
+#' # plot SD of mean(x) across simulation replicates
+#' sd_mean_plot <- create_visualizer(
+#'   .viz_fun = function(fit_results, eval_results, vary_params = NULL,
+#'                       eval_name = "SD of Mean(x)") {
+#'     if (!is.null(vary_params)) {
+#'       add_aes <- ggplot2::aes(
+#'         x = .data[[unique(vary_params)]], y = sd, color = .dgp_name
+#'       )
+#'     } else {
+#'       add_aes <- ggplot2::aes(x = .dgp_name, y = sd)
+#'     }
+#'     plt <- ggplot2::ggplot(eval_results[[eval_name]]) +
+#'       add_aes +
+#'       ggplot2::geom_point()
+#'     if (!is.null(vary_params)) {
+#'       plt <- plt + ggplot2::geom_line()
+#'     }
+#'     return(plt)
+#'   },
+#'   .name = "SD of Mean(x) Plot"
+#' )
+#'
+#' # initialize experiment with toy DGPs, Methods, Evaluators, and Visualizers
+#' # using piping |> and add_* functions
+#' experiment <- create_experiment(name = "Experiment Name") |>
+#'   add_dgp(normal_dgp) |>
+#'   add_dgp(bernoulli_dgp) |>
+#'   add_method(mean_method) |>
+#'   add_evaluator(sd_mean_eval) |>
+#'   add_visualizer(sd_mean_plot)
+#'
+#' # set export options for Visualizer
+#' experiment <- experiment |>
+#'   set_export_viz_options(
+#'     name = "SD of Mean(x) Plot",
+#'     height = 10, width = 8
+#'   )
+#'
+#' @export
+set_export_viz_options = function(experiment, name, ...) {
+  experiment$set_export_viz_options(name = name, ...)
+}
+
 #' Export cached `Visualizer` results to image.
 #'
 #' @name export_visualizers
@@ -1295,7 +1379,10 @@ save_experiment <- function(experiment) {
 #'   directory (see [get_save_dir()]).
 #'
 #' @inheritParams shared_experiment_helpers_args
-#' @param ... Additional arguments to pass to [ggplot2::ggsave()]
+#' @param device See `device` argument of [ggplot2::ggsave()].
+#' @param ... Additional arguments to pass to [ggplot2::ggsave()] to be used
+#'   for all visualizations. If not provided, the `export_options` from
+#'   each `Visualizer` will be used.
 #'
 #' @return The original `Experiment` object passed to
 #'   `export_visualizers`.
@@ -1305,6 +1392,6 @@ save_experiment <- function(experiment) {
 #' export_visualizers(experiment)}
 #'
 #' @export
-export_visualizers <- function(experiment, ...) {
-  experiment$export_visualizers(...)
+export_visualizers <- function(experiment, device = "png", ...) {
+  experiment$export_visualizers(device = device, ...)
 }

R/experiment.R

@@ -23,9 +23,10 @@ NULL
 #'   [fit_experiment()], [evaluate_experiment()], [visualize_experiment()],
 #'   [run_experiment()], [clear_cache()], [get_cached_results()],
 #'   [get_save_dir()], [set_save_dir()], [save_experiment()],
-#'   [export_visualizers()], [`add_*()`](add_funs.html),
-#'   [`update_*()`](update_funs.html), [`remove_*()`](remove_funs.html),
-#'   [`get_*()`](get_funs.html), and [`*_vary_across()`](vary_across.html).
+#'   [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).
 #'
 #' @export
 Experiment <- R6::R6Class(
@@ -2243,6 +2244,35 @@ Experiment <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description Set options to use in [ggplot2::ggsave()] when exporting
+    #'   the `Visualizer`'s visualization with [export_visualizers()].
+    #'
+    #' @param name Name of `Visualizer` to set [ggplot2::ggsave()] options.
+    #' @param ... Named options to set. See arguments of [ggplot2::ggsave()] for
+    #'   possible options.
+    #'
+    #' @return The `Experiment` object, invisibly.
+    set_export_viz_options = function(name, ...) {
+      obj_list <- private$.get_obj_list("visualizer")
+      if (!name %in% names(obj_list)) {
+        abort(
+          sprintf(
+            paste("The name '%s' isn't in the visualizer list.",
+                  "Use add_visualizer first."),
+            name
+          )
+        )
+      }
+      export_options <- rlang::list2(...)
+      if (length(export_options) > 0) {
+        for (i in 1:length(export_options)) {
+          private$.visualizer_list[[name]]$export_options[[names(export_options)[i]]] <-
+            export_options[[i]]
+        }
+      }
+      invisible(self)
+    },
+
     #' @description Get the directory in which the `Experiment`'s results and
     #'   visualizations are saved.
     #'
@@ -2298,15 +2328,13 @@ Experiment <- R6::R6Class(
     #'   `Experiment`'s results directory (see [get_save_dir()]).
     #'
     #' @param device See `device` argument of [ggplot2::ggsave()].
-    #' @param width See `width` argument of [ggplot2::ggsave()].
-    #' @param height See `height` argument of [ggplot2::ggsave()].
-    #' @param ... Additional arguments to pass to [ggplot2::ggsave()].
+    #' @param ... Additional arguments to pass to [ggplot2::ggsave()] to be used
+    #'   for all visualizations. If not provided, the `export_options` from
+    #'   each `Visualizer` will be used.
     #'
     #' @return The `Experiment` object, invisibly.
-    export_visualizers = function(device = "png", width = "auto", height = "auto",
-                                  ...) {
-      rlang::check_installed("ggplot2",
-        reason = "to export visualizers to image.")
+    export_visualizers = function(device = "png", ...) {
+      rlang::check_installed("ggplot2", reason = "to export visualizers to image.")
       viz_list <- self$get_visualizers()
       if (length(viz_list) == 0) {
         return(invisible(self))
@@ -2322,14 +2350,19 @@ Experiment <- R6::R6Class(
         dir.create(save_dir, recursive = TRUE)
       }
 
-      ggsave_args <- list(device = device, ...)
+      dots_ls <- rlang::list2(...)
       for (viz_name in names(viz_results)) {
         viz <- viz_list[[viz_name]]
-        if (identical(height, "auto")) {
-          ggsave_args[["height"]] <- viz$doc_options$height
+        ggsave_args <- viz$export_options
+        ggsave_args$device <- device
+        if (is.null(ggsave_args$height)) {
+          ggsave_args$height <- viz$doc_options$height
+        }
+        if (is.null(ggsave_args$width)) {
+          ggsave_args$width <- viz$doc_options$width
         }
-        if (identical(width, "auto")) {
-          ggsave_args[["width"]] <- viz$doc_options$width
+        for (arg_name in names(dots_ls)) {
+          ggsave_args[[arg_name]] <- dots_ls[[arg_name]]
         }
         fname <- file.path(save_dir, sprintf("%s.%s", viz_name, device))
         tryCatch({
@@ -2339,7 +2372,7 @@ Experiment <- R6::R6Class(
               ggsave_args))
         }, error = function(err) {
           rlang::warn(sprintf(
-            "Could not save %s as image using ggplot2::ggsave.", viz_name
+            "Could not save %s as image using ggplot2::ggsave. Skipping export.", viz_name
           ))
           if (file.exists(fname)) {
             file.remove(fname)

R/visualizer.R

@@ -13,6 +13,11 @@
 #'
 #' @param .viz_fun The user-defined visualization function.
 #' @param .name (Optional) The name of the `Visualizer`.
+#' @param .export_options (Optional) List of options to use in [ggplot2::ggsave()]
+#'   when exporting the `Visualizer`'s visualization to file with
+#'   `export_visualizers()`. See arguments of [ggplot2::ggsave()] for possible
+#'   options. By default, the "height" and "width" from `.doc_options` are used
+#'   alongside all other default options of [ggplot2::ggsave()].
 #' @param .doc_options (Optional) List of options to control the aesthetics of
 #'   the `Visualizer`'s visualization in the knitted R Markdown report.
 #'   Currently, possible options are "height" and "width" (in inches). The
@@ -142,9 +147,10 @@
 #' )
 #'
 #' @export
-create_visualizer <- function(.viz_fun, .name = NULL, .doc_options = list(),
-                              .doc_show = TRUE, ...) {
-  Visualizer$new(.viz_fun, .name, .doc_options, .doc_show, ...)
+create_visualizer <- function(.viz_fun, .name = NULL, .export_options = list(),
+                              .doc_options = list(), .doc_show = TRUE,
+                              ...) {
+  Visualizer$new(.viz_fun, .name, .export_options, .doc_options, .doc_show, ...)
 }
 
 #' `R6` class representing a visualizer
@@ -315,6 +321,11 @@ Visualizer <- R6::R6Class(
     #'   the visualization function.
     viz_params = NULL,
 
+    #' @field export_options List of options to use in [ggplot2::ggsave()] when
+    #'   exporting the `Visualizer`'s visualization to file with
+    #'   `export_visualizers()`.
+    export_options = list(),
+
     #' @field doc_options List of options to control the aesthetics of
     #'   the `Visualizer`'s visualization in the knitted R Markdown report.
     doc_options = list(height = 6, width = 10),
@@ -331,6 +342,11 @@ Visualizer <- R6::R6Class(
     #'
     #' @param .viz_fun The user-defined visualization function.
     #' @param .name (Optional) The name of the `Visualizer`.
+    #' @param .export_options (Optional) List of options to use in [ggplot2::ggsave()]
+    #'   when exporting the `Visualizer`'s visualization to file with
+    #'   `export_visualizers()`. See arguments of [ggplot2::ggsave()] for possible
+    #'   options. By default, the "height" and "width" from `.doc_options` are used
+    #'   alongside all other default options of [ggplot2::ggsave()].
     #' @param .doc_options (Optional) List of options to control the aesthetics of
     #'   the `Visualizer`'s visualization in the knitted R Markdown report.
     #'   Currently, possible options are "height" and "width" (in inches). The
@@ -341,10 +357,13 @@ Visualizer <- R6::R6Class(
     #' @param ... User-defined default arguments to pass into `.viz_fun()`.
     #'
     #' @return A new instance of `Visualizer`.
-    initialize = function(.viz_fun, .name = NULL, .doc_options = list(),
-                          .doc_show = TRUE, ...) {
+    initialize = function(.viz_fun, .name = NULL, .export_options = list(),
+                          .doc_options = list(), .doc_show = TRUE, ...) {
       self$viz_fun <- .viz_fun
       self$name <- .name
+      for (opt in names(.export_options)) {
+        self$export_options[[opt]] <- .export_options[[opt]]
+      }
       for (opt in names(.doc_options)) {
         self$doc_options[[opt]] <- .doc_options[[opt]]
       }
@@ -396,6 +415,9 @@ Visualizer <- R6::R6Class(
       cat("   Parameters: ")
       cat(str(self$viz_params,
         indent.str = "     ", no.list = F))
+      cat("   Export Options: ")
+      cat(str(self$export_options,
+              indent.str = "     ", no.list = F))
       cat("   R Markdown Options: ")
       cat(str(self$doc_options,
         indent.str = "     ", no.list = F))

_pkgdown.yml

@@ -25,6 +25,7 @@ reference:
       - get_save_dir
       - set_save_dir
       - save_experiment
+      - set_export_viz_options
       - export_visualizers
   - title: "Simulation Experiment Directory Setup"
     desc: >