convert ggplot to png

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(apply_scale,default)
 S3method(apply_scale,gt_group)
 S3method(apply_scale,gt_tbl)
+S3method(apply_scale,list)
 S3method(fancywrap,default)
 S3method(fancywrap,docorator)
 S3method(fancywrap,fancyfoot)

NEWS.md

@@ -3,11 +3,13 @@ Improvements
 * Added Word (.docx) output support with the new render_docx() engine. (#97)
 * Convert all gt_groups to lists of gt_tbls interally for easier handling across render functions (#113)
 * `doc_pagenum()` updated to support different output formats (#107)
+* Convert all ggplots to PNGs interally for consistency across output formats (#84)
 
 Bug Fixes
 * Fix issue where pdf render fails for gt_groups due to duplicate caption ids (#79)
 * Removed an unnecessary RTF warning related to the gt package version (#100)
 * Fix bug where chars argument wasnt passed through fancywrap.docorator correctly (#109)
+* Pass height and width through to gt::fmt_image for dynamic image sizing in RTF output (#103)
 
 
 # docorator 0.6.0

R/docorate.R

@@ -111,6 +111,7 @@ docorate <- function(
 #'   package. Accepts a named list. Default is `geom_set()`.
 #' @param fig_dim vector containing figure height and width in inches. Defaults
 #'   to `c(5,8)`
+#' @param convert_ggplot Boolean for whether or not to convert ggplot objects to PNG files to preserve scaling for all render engines. Defaults to TRUE.
 #' @param tbl_scale Boolean for whether or not to automatically scale table columns to fit display area. Defaults to TRUE. Note that this will overwrite scaling set in the table directly unless set to FALSE.
 #' @param tbl_stub_pct percent of total width that should be dedicated to stub column(s). If more than 1 stub column then this is the total for both.
 #'
@@ -154,6 +155,7 @@ as_docorator <- function(
   fontsize = 10,
   geometry = geom_set(),
   fig_dim = c(5, 8),
+  convert_ggplot = TRUE,
   tbl_scale = TRUE,
   tbl_stub_pct = 0.3
 ) {
@@ -181,12 +183,11 @@ as_docorator <- function(
   check_fancyhdr(header, chr_ok = TRUE)
   check_fancyhdr(footer)
 
-  # convert any gt_groups to a list
-  x <- convert_list_displays(x)
-
-  # notify user about any possible scaling issues
-  x <- apply_scale(
+  # prep displays for render
+  x <- prep_display(
     x,
+    fig_dim = fig_dim,
+    convert_ggplot = convert_ggplot,
     fontsize = fontsize,
     tbl_scale = tbl_scale,
     tbl_stub_pct = tbl_stub_pct
@@ -202,6 +203,7 @@ as_docorator <- function(
       fontsize = fontsize,
       geometry = geometry,
       fig_dim = fig_dim,
+      convert_ggplot = convert_ggplot,
       session_info = utils::sessionInfo()
     ),
     class = "docorator"

R/prep_obj_docx.R

@@ -33,7 +33,7 @@ prep_obj_docx.PNG <- function(x, ...) {
   # temporarily store png
   temp <- tempfile(fileext = ".png", tmpdir = tempdir())
   png::writePNG(x$display$png, temp)
-  polish::polish_content_word(polish::as_file(temp))
+  polish::polish_content_word(polish::as_file(temp), width = x$fig_dim[2], height = x$fig_dim[1])
 }
 
 #' @rdname prep_obj_docx

R/scale_gt.R

@@ -67,6 +67,26 @@ apply_scale.gt_group <- function(x, fontsize, tbl_scale, tbl_stub_pct) {
   x
 }
 
+#' @name apply_scale
+#' @export
+#' @keywords internal
+apply_scale.list <- function(x, fontsize, tbl_scale, tbl_stub_pct) {
+  x <- lapply(
+    seq_along(x),
+    FUN = function(i) {
+      x[[i]] <- apply_scale(
+        x[[i]],
+        fontsize = fontsize,
+        tbl_scale = tbl_scale,
+        tbl_stub_pct = tbl_stub_pct
+      )
+      x[[i]]
+    }
+  )
+  x
+}
+
+
 #' Scale gt table contents for document
 #'
 #' @param x table of class `gt_tbl`

R/utils.R

@@ -171,13 +171,21 @@ create_chunk <- function(x, id = 1, transform) {
     }
   ), collapse = '')
 
+  # set figure output args
+  if(isTRUE(x$convert_ggplot)){
+    size_args <- paste0("out.height='", x$fig_dim[1], "in', out.width='", x$fig_dim[2], "in',")
+  } else {
+    size_args <- ""
+  }
+
   new_chunk <- paste0("
-  `","``{r new_chunk", id, ", fig.height=", x$fig_dim[1], ", fig.width=", x$fig_dim[2], ", echo=FALSE, results='asis', output='asis'}",
-                      "\n(",
-                      deparsed
-                      , ")()",
-                      "\n  `","``
-  ")
+  `","``{r new_chunk", id, ", fig.height=", x$fig_dim[1], ", fig.width=", x$fig_dim[2], ",", size_args, " echo=FALSE, results='asis', output='asis'}",
+                       "\n(",
+                       deparsed
+                       , ")()",
+                       "\n  `","``
+   ")
+
 
   cat(knitr::knit(text = knitr::knit_expand(text = new_chunk), quiet = TRUE))
 }
@@ -275,5 +283,67 @@ convert_list_displays <- function(x) {
     })
     x <- unlist(x, recursive = FALSE)
   }
+  x
+}
+
+
+#' convert all the ggplots in a display or list of displays to png objects
+#' @param x display object
+#' @param fig_dim figure dimensions
+#' @param convert_ggplot Boolean for whether or not to convert ggplot objects to PNG files to preserve scaling for all render engines. Defaults to TRUE.
+#' @return display object with ggplots converted to png objects
+#' @noRd
+#' @keywords internal
+gg_to_PNG <- function(x, fig_dim = c(5,8), convert_ggplot = TRUE) {
+  # if not a list convert to one 
+  if(!identical(class(x), "list")){
+    x <- list(x)
+  }
+
+  x <- lapply(
+    seq_along(x),
+    FUN = function(i) {
+      if (inherits(x[[i]], "ggplot") && convert_ggplot) {
+        filepath <- gg_to_image(x[[i]], fig_dim, path = tempdir())
+        x[[i]] <- png_path(filepath)
+      }
+      x[[i]]
+    }
+  )
+
+  # if the list has only one element, return the element instead of a list
+  if(length(x) == 1){
+    x <- x[[1]]
+  }
+
+  x
+}
+
+
+#' prep display for rendering, convert display type where appropriate, apply scaling
+#' @param x display object
+#' @param fig_dim figure dimensions
+#' @param convert_ggplot Boolean for whether or not to convert ggplot objects to PNG files to preserve scaling for all render engines. Defaults to TRUE.
+#' @param fontsize font size for scaling
+#' @param tbl_scale Boolean for whether or not to scale tables
+#' @param tbl_stub_pct percentage of table stub to scale
+#' @return display object ready for rendering
+#' @noRd
+#' @keywords internal
+prep_display <- function(x, fig_dim = c(5,8), convert_ggplot = TRUE, fontsize = 10, tbl_scale = TRUE, tbl_stub_pct = 0.3) {
+
+  # convert gt_groups if appropriate
+  x <- convert_list_displays(x)
+  # convert ggplot to png if appropriate
+  x <- gg_to_PNG(x, fig_dim, convert_ggplot)
+
+  # notify user about any possible scaling issues
+  x <- apply_scale(
+    x,
+    fontsize = fontsize,
+    tbl_scale = tbl_scale,
+    tbl_stub_pct = tbl_stub_pct
+  )
+
   x
 }

R/utils_gt.R

@@ -213,7 +213,7 @@ png_to_gt <- function(x){
   # convert to gt
   gt <- dplyr::tibble(ggplot =  temp_png) |>
     gt::gt() |>
-    gt::fmt_image(columns = dplyr::everything(), sep = ",", width = "6in") |>
+    gt::fmt_image(columns = dplyr::everything(), sep = ",", height = paste0(x$fig_dim[1], "in"), width = paste0(x$fig_dim[2], "in")) |>
     # remove column headers and borders
     gt::tab_options(
       column_labels.hidden = TRUE,
@@ -296,7 +296,7 @@ gg_to_image <- function(plot_object, fig_dim = c(5,8), path = NULL) {
         create.dir = TRUE,
         plot = plot_object[[x]],
         device = "png",
-        dpi = 100,
+        dpi = 300,
         width = fig_dim[2],
         height = fig_dim[1],
         units = "in"

tests/testthat/test-prep_obj_rtf.R

@@ -15,7 +15,9 @@ test_that("prep_obj_rtf - ggplot", {
                        fancyrow(center = "this is the subtitle2")),
     footer = fancyfoot(fancyrow(left = "this is the docorator footnote")),
     display_name = "mytbl",
-    save_object = FALSE)
+    save_object = FALSE,
+    convert_ggplot = FALSE
+  )
 
   gt_display <- prep_obj_rtf(docorator)
 
@@ -38,6 +40,40 @@ test_that("prep_obj_rtf - ggplot", {
   expect_equal(gt_2$`_heading`$title, "this is the title")
   expect_equal(as.character(gt_2$`_heading`$subtitle), "this is the subtitle1<br>this is the subtitle2<br>title2<br>subtitle2<br>tag2")
 
+
+  # converted to png 
+
+  # list of ggplots
+  docorator <- as_docorator(
+    x = list(ggplot1, ggplot2),
+    header = fancyhead(fancyrow(center = "this is the title"),
+                       fancyrow(center = "this is the subtitle1"),
+                       fancyrow(center = "this is the subtitle2")),
+    footer = fancyfoot(fancyrow(left = "this is the docorator footnote")),
+    display_name = "mytbl",
+    save_object = FALSE
+  )
+
+  gt_display <- prep_obj_rtf(docorator)
+
+  # should be a gt_group object
+  expect_equal(class(gt_display), "gt_group")
+
+  gt_1 <- gt::grp_pull(gt_display, 1)
+  gt_2 <- gt::grp_pull(gt_display, 2)
+
+  # check headers and footers are added correctly for each
+
+  # only docorator footnotes
+  expect_equal(unlist(gt_1$`_footnotes`$footnotes), c("this is the docorator footnote"))
+  expect_equal(unlist(gt_2$`_footnotes`$footnotes), c("this is the docorator footnote"))
+
+  # title should be docorator titles only 
+  expect_equal(gt_1$`_heading`$title, "this is the title")
+  expect_equal(as.character(gt_1$`_heading`$subtitle), "this is the subtitle1<br>this is the subtitle2")
+  expect_equal(gt_2$`_heading`$title, "this is the title")
+  expect_equal(as.character(gt_2$`_heading`$subtitle), "this is the subtitle1<br>this is the subtitle2")
+
 })
 
 test_that("prep_obj_rtf - png", {

tests/testthat/test-scale_gt.R

@@ -299,3 +299,71 @@ test_that("apply_scale works - gt_group",{
 
   expect_identical(apply_scale(gt_group2, fontsize = 10, tbl_scale = TRUE, tbl_stub_pct = 0.3), expected_group2)
 })
+
+test_that("apply_scale works - list", {
+  gt_tbl <- gt::exibble |>
+    gt::gt() |>
+    gt::tab_options(
+      table.font.size = "10pt",
+      heading.subtitle.font.size = "10pt",
+      heading.title.font.size = "10pt",
+      table.width = "100%"
+    )
+  list_gt <- list(
+    # one bad column widths
+    gt_tbl |> gt::cols_width(num ~ "400%", char ~ "3%"),
+    # one good column widths
+    gt_tbl
+  )
+
+  # expect first table to be auto rescaled, second table unchanged
+  expected_list_gt <- list(scale_gt(gt_tbl, tbl_stub_pct = 0.3), gt_tbl)
+
+  expect_warning(
+    apply_scale(list_gt, fontsize = 10, tbl_scale = FALSE, tbl_stub_pct = 0.3),
+    "Column widths must be add to =<100%, not 403%. Applying auto table scaling."
+  )
+  expect_identical(
+    suppressWarnings(apply_scale(
+      list_gt,
+      fontsize = 10,
+      tbl_scale = FALSE,
+      tbl_stub_pct = 0.3
+    )),
+    expected_list_gt
+  )
+
+  ggplot <- ggplot2::ggplot(ggplot2::mpg, ggplot2::aes(x = displ, y = hwy)) +
+      ggplot2::geom_point()
+
+  list_gt_ggplot <- list(
+    # one bad column widths
+    gt_tbl |> gt::cols_width(num ~ "400%", char ~ "3%"),
+    # one good column widths
+    gt_tbl,
+    # ggplot
+    ggplot
+  )
+
+  # expect first table to be auto rescaled, second table unchanged, ggplot unchanged
+  expected_list_gt_ggplot <- list(
+    scale_gt(gt_tbl, tbl_stub_pct = 0.3),
+    gt_tbl,
+    ggplot
+  )
+
+
+  expect_warning(
+    apply_scale(list_gt_ggplot, fontsize = 10, tbl_scale = FALSE, tbl_stub_pct = 0.3),
+    "Column widths must be add to =<100%, not 403%. Applying auto table scaling."
+  )
+  expect_identical(
+    suppressWarnings(apply_scale(
+      list_gt_ggplot,
+      fontsize = 10,
+      tbl_scale = FALSE,
+      tbl_stub_pct = 0.3
+    )),
+    expected_list_gt_ggplot
+  )
+})