Allow for easy insertion of ggplot plots in a table column via a formatter

NAMESPACE

@@ -33,6 +33,7 @@ export(fmt)
 export(fmt_currency)
 export(fmt_date)
 export(fmt_datetime)
+export(fmt_ggplot)
 export(fmt_missing)
 export(fmt_number)
 export(fmt_passthrough)

R/format_data.R

@@ -1384,6 +1384,68 @@ fmt_missing <- function(data,
       ))
 }
 
+#' Format ggplot cells
+#'
+#' It's possible to include \pkg{ggplot2} plots within a list column of the
+#' input table data. The common pattern toward obtaining these plots is through
+#' mutation of a list column containing all the \code{data} required for a
+#' plot (e.g., \code{<data> %>% dplyr::group_by(<var>) %>%
+#' tidyr::nest(.key = plot) %>%
+#' dplyr::mutate(plot = purrr::map(plot, <ggplot code>))}). While \pkg{gt} will
+#' automatically format columns containing \pkg{ggplot2} plots, using the
+#' \code{fmt_ggplot()} function allows us to specify specific \code{rows} and
+#' set options for the plots' \code{height} and \code{aspect_ratio}.
+#'
+#' Targeting of values is done through \code{columns} and additionally by
+#' \code{rows} (if nothing is provided for \code{rows} then entire columns are
+#' selected). A number of helper functions exist to make targeting more
+#' effective. Conditional formatting is possible by providing a conditional
+#' expression to the \code{rows} argument. See the Arguments section for more
+#' information on this.
+#'
+#' @inheritParams fmt_number
+#' @inheritParams ggplot_image
+#' @return an object of class \code{gt_tbl}.
+#' @export
+fmt_ggplot <- fmt_gg <- function(data,
+                                 columns,
+                                 rows = NULL,
+                                 height = 100,
+                                 aspect_ratio = 1.0) {
+
+  # Capture expression in `rows`
+  rows <- rlang::enquo(rows)
+
+  # Pass `data`, `columns`, `rows`, and the formatting
+  # functions (as a function list) to `fmt()`
+  fmt(data = data,
+      columns = columns,
+      rows = !!rows,
+      fns = list(
+        html = function(x) {
+
+          map(
+            x,
+            ggplot_image,
+            height = height,
+            aspect_ratio = aspect_ratio
+          )
+
+        },
+        latex = function(x) {
+
+          stop("This formatter is not yet implemented for LaTeX output.",
+               call. = FALSE)
+        },
+        default = function(x) {
+
+          stop("This formatter is not yet implemented.",
+               call. = FALSE)
+        }
+      ))
+
+}
+
 #' Set a column format with a formatter function
 #'
 #' The \code{fmt()} function provides greater control in formatting raw data

R/utils_render_common.R

@@ -83,22 +83,32 @@ migrate_unformatted_to_output <- function(data_df,
 
     if (inherits(data_df[[colname]], "list")) {
 
+
       # Use `lapply()` so that all values could be treated independently
       output_df[[colname]][row_index] <-
         lapply(
           data_df[[colname]][row_index],
           function(x) {
-            x %>%
-              format(
-                drop0trailing = FALSE,
-                trim = TRUE,
-                justify = "none") %>%
-              tidy_gsub("\\s+$", "") %>%
-              process_text(context) %>%
-              paste(collapse = ", ")
+
+            if (inherits(x, "gg") && context == "html") {
+
+              x %>% ggplot_image()
+
+            } else {
+
+              x %>%
+                format(
+                  drop0trailing = FALSE,
+                  trim = TRUE,
+                  justify = "none") %>%
+                tidy_gsub("\\s+$", "") %>%
+                process_text(context) %>%
+                paste(collapse = ", ")
+            }
           }
         )
 
+
     } else {
 
       # No `lapply()` used: all values will be treated cohesively