diff --git a/NAMESPACE b/NAMESPACE index 55f6fad..38c650c 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index a7036c7..69aef81 100644 --- a/NEWS.md +++ b/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 diff --git a/R/docorate.R b/R/docorate.R index 7ebeb3f..2cdd345 100644 --- a/R/docorate.R +++ b/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" diff --git a/R/prep_obj_docx.R b/R/prep_obj_docx.R index 167fd73..30573ea 100644 --- a/R/prep_obj_docx.R +++ b/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 diff --git a/R/scale_gt.R b/R/scale_gt.R index 9f7a89d..efb594e 100644 --- a/R/scale_gt.R +++ b/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` diff --git a/R/utils.R b/R/utils.R index f636291..6c9441c 100644 --- a/R/utils.R +++ b/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 } \ No newline at end of file diff --git a/R/utils_gt.R b/R/utils_gt.R index 015c756..27cbb45 100644 --- a/R/utils_gt.R +++ b/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" diff --git a/man/apply_scale.Rd b/man/apply_scale.Rd index 766aeaf..dd7b122 100644 --- a/man/apply_scale.Rd +++ b/man/apply_scale.Rd @@ -5,6 +5,7 @@ \alias{apply_scale.default} \alias{apply_scale.gt_tbl} \alias{apply_scale.gt_group} +\alias{apply_scale.list} \title{Apply scaling to gt objects} \usage{ apply_scale(x, fontsize, tbl_scale, tbl_stub_pct) @@ -14,6 +15,8 @@ apply_scale(x, fontsize, tbl_scale, tbl_stub_pct) \method{apply_scale}{gt_tbl}(x, fontsize, tbl_scale, tbl_stub_pct) \method{apply_scale}{gt_group}(x, fontsize, tbl_scale, tbl_stub_pct) + +\method{apply_scale}{list}(x, fontsize, tbl_scale, tbl_stub_pct) } \arguments{ \item{x}{gt object} diff --git a/man/as_docorator.Rd b/man/as_docorator.Rd index 35eee2a..9980aed 100644 --- a/man/as_docorator.Rd +++ b/man/as_docorator.Rd @@ -16,6 +16,7 @@ as_docorator( fontsize = 10, geometry = geom_set(), fig_dim = c(5, 8), + convert_ggplot = TRUE, tbl_scale = TRUE, tbl_stub_pct = 0.3 ) @@ -45,6 +46,8 @@ package. Accepts a named list. Default is \code{geom_set()}.} \item{fig_dim}{vector containing figure height and width in inches. Defaults to \code{c(5,8)}} +\item{convert_ggplot}{Boolean for whether or not to convert ggplot objects to PNG files to preserve scaling for all render engines. Defaults to TRUE.} + \item{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.} \item{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.} diff --git a/tests/testthat/test-prep_obj_rtf.R b/tests/testthat/test-prep_obj_rtf.R index c1a3a0f..75ff929 100644 --- a/tests/testthat/test-prep_obj_rtf.R +++ b/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
this is the subtitle2
title2
subtitle2
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
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
this is the subtitle2") + }) test_that("prep_obj_rtf - png", { diff --git a/tests/testthat/test-scale_gt.R b/tests/testthat/test-scale_gt.R index 989f089..8dc9e64 100644 --- a/tests/testthat/test-scale_gt.R +++ b/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 + ) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 206b078..ea4366c 100644 --- a/tests/testthat/test-utils.R +++ b/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) + +}) \ No newline at end of file diff --git a/vignettes/display_sizing.Rmd b/vignettes/display_sizing.Rmd index b32b8ce..9042de6 100644 --- a/vignettes/display_sizing.Rmd +++ b/vignettes/display_sizing.Rmd @@ -106,7 +106,18 @@ mytbl |> ## Figure sizing -Figure sizes can be adjusted via the `fig_dim` argument of `as_docorator()`. This argument expects a numeric vector of length 2, where the first and second elements are the height and width in inches, respectively. For example, the default `c(5,8)` translates to a height of 5 inches and width of 8 inches. +Figure sizes can be adjusted via the `fig_dim` argument of `as_docorator()`. This argument expects a numeric vector of length 2, where the first and second elements are the height and width in inches, respectively. For example, the default `c(5,8)` translates to a height of 5 inches and width of 8 inches. +Note: for `ggplot2` objects, the height and width are applied in the `ggplot2::ggsave()` function when the plot is converted to PNG prior to render. For further control over figure sizing, such as changing the DPI, users can use `ggplot2::ggsave()` directly on the plot object prior to passing it to `as_docorator()` via `png_path`. For example: + +```{r eval = FALSE} +myplot <- ggplot2::ggplot(mtcars, ggplot2::aes(x = wt, y = mpg)) + + ggplot2::geom_point() + +ggplot2::ggsave(myplot, filename = "myplot.png", width = 6, height = 4, dpi = 300) + +as_docorator(png_path("myplot.png"), display_name = "my_plot") |> + render_pdf() +``` ## Future developments