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,6 +3,7 @@ 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)

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

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

@@ -172,7 +172,7 @@ create_chunk <- function(x, id = 1, transform) {
   ), collapse = '')
 
   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'}",
+  `","``{r new_chunk", id, ", fig.height=", x$fig_dim[1], ", fig.width=", x$fig_dim[2], ", out.width= '", x$fig_dim[2], "in', out.height= '", x$fig_dim[1], "in', echo=FALSE, results='asis', output='asis'}",
                       "\n(",
                       deparsed
                       , ")()",
@@ -276,4 +276,64 @@ 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
+  )
 }

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
+  )
+})

tests/testthat/test-utils.R

@@ -138,3 +138,82 @@ test_that("convert_list_displays works", {
   )
 })
 
+test_that("gg_to_png works", {
+  # single ggplot object
+  gg <- ggplot2::ggplot(mtcars, ggplot2::aes(x = wt, y = mpg)) +
+    ggplot2::geom_point()
+
+  # list of ggplot objects
+  list_gg <- list(
+    ggplot2::ggplot(mtcars, ggplot2::aes(x = wt, y = mpg)) + ggplot2::geom_point(),
+    ggplot2::ggplot(mtcars, ggplot2::aes(x = hp, y = mpg)) + ggplot2::geom_point()
+  )
+
+  # list of gt tables and ggplot objects
+  list_mixed <- list(
+    gt::gt(mtcars),
+    ggplot2::ggplot(mtcars, ggplot2::aes(x = wt, y = mpg)) + ggplot2::geom_point()
+  )
+
+  list_no_gg <- list(
+    gt::gt(mtcars),
+    gt::gt(mtcars)
+  )
+
+  png <- gg_to_PNG(gg)
+  expect_equal(class(png), "PNG")
+
+  list_png <- gg_to_PNG(list_gg)
+  expect_equal(class(list_png), "list")
+  expect_equal(length(list_png), 2)
+  expect_true(all(sapply(list_png, function(x) inherits(x, "PNG"))))
+
+  list_mixed_png <- gg_to_PNG(list_mixed)
+  expect_equal(class(list_mixed_png), "list")
+  expect_equal(length(list_mixed_png), 2)
+  expect_true(inherits(list_mixed_png[[1]], "gt_tbl"))
+  expect_true(inherits(list_mixed_png[[2]], "PNG"))
+
+  # if convert_ggplot is FALSE, ggplot objects should not be converted
+  list_mixed_no_convert <- gg_to_PNG(list_mixed, convert_ggplot = FALSE)
+  expect_equal(class(list_mixed_no_convert), "list")
+  expect_equal(length(list_mixed_no_convert), 2)
+  expect_true(inherits(list_mixed_no_convert[[1]], "gt_tbl"))
+  expect_true(inherits(list_mixed_no_convert[[2]], "ggplot"))
+
+  # no ggplots present should not change
+  list_no_gg_png <- gg_to_PNG(list_no_gg)
+  expect_identical(list_no_gg, list_no_gg_png)
+
+})
+
+test_that("prep_display works", {
+  # single gt table - only scaling should happen
+  gt_tbl <- gt::gt(mtcars)
+  scaled_gt_tbl <- apply_scale(gt_tbl, fontsize = 10, tbl_scale = TRUE, tbl_stub_pct = 0.3)
+  prep_gt <- prep_display(gt_tbl)
+  expect_identical(prep_gt, scaled_gt_tbl)
+
+  # single ggplot - only conversion should happen
+  gg <- ggplot2::ggplot(mtcars, ggplot2::aes(x = wt, y = mpg)) +
+    ggplot2::geom_point()
+  prep_gg <- prep_display(gg)
+  expect_true(inherits(prep_gg, "PNG"))
+
+  list_mixed <- list(
+    # should be scaled
+    gt_tbl,
+    # should be converted to PNG
+    ggplot2::ggplot(mtcars, ggplot2::aes(x = wt, y = mpg)) + ggplot2::geom_point(),
+    # should be converted to gt_tbls and scaled
+    gt::gt_group(gt_tbl, gt_tbl)
+  )
+  prep_list_mixed <- prep_display(list_mixed)
+  expect_equal(class(prep_list_mixed), "list")
+  expect_equal(length(prep_list_mixed), 4)
+  expect_identical(prep_list_mixed[[1]], scaled_gt_tbl)
+  expect_true(inherits(prep_list_mixed[[2]], "PNG"))
+  expect_identical(prep_list_mixed[[3]], scaled_gt_tbl)
+  expect_identical(prep_list_mixed[[4]], scaled_gt_tbl)
+
+})