Skip to content

Instantly share code, notes, and snippets.

@gadenbuie
Last active November 16, 2023 16:49
Show Gist options
  • Save gadenbuie/f6b8ec0335bdd45ed5a68bead60ef4fa to your computer and use it in GitHub Desktop.
Save gadenbuie/f6b8ec0335bdd45ed5a68bead60ef4fa to your computer and use it in GitHub Desktop.
Print xaringan slides to PDF, even the complicated ones
#' Print xaringan slides to PDF
#'
#' Prints xaringan slides to a PDF file, even complicated slides
#' with panelsets or other html widgets or advanced features.
#' Requires a local installation of Chrome.
#'
#' @param input Path to Rmd or html file of xaringan slides.
#' @param output_file The name of the output file. If using NULL then
#' the output filename will be based on filename for the input file.
#' If a filename is provided, a path to the output file can also be provided.
#' @param delay Seconds of delay between advancing to and printing
#' a new slide.
#' @param include_partial_slides Should partial (continuation) slides be
#' included in the output? If `FALSE`, the default, only the complete slide
#' is included in the PDF.
xaringan_to_pdf <- function(
input,
output_file = NULL,
delay = 1,
include_partial_slides = FALSE
) {
if (!requireNamespace("chromote", quietly = TRUE)) {
stop("`chromote` is required: devtools::install_github('rstudio/chromote')")
}
required_packages <- c("progress", "jsonlite", "pdftools", "digest", "fs")
for (pkg in required_packages) {
if (!requireNamespace(pkg, quietly = TRUE)) {
stop("`", pkg, "` is required: install.packages('", pkg, "')")
}
}
is_url <- grepl("^(ht|f)tp", tolower(input))
if (is.null(output_file)) {
if (is_url) {
output_file <- fs::path_ext_set(fs::path_file(input), "pdf")
} else {
output_file <- fs::path_ext_set(input, "pdf")
}
}
if (!is_url && !grepl("^file://", input)) {
if (!tolower(fs::path_ext(input)) %in% c("htm", "html")) {
stop("`input` must be the HTML version of the slides.")
}
input <- paste0("file://", fs::path_abs(input))
}
b <- chromote::ChromoteSession$new()
on.exit(b$close(), add = TRUE)
b$Page$navigate(input, wait_ = TRUE)
b$Page$loadEventFired()
has_remark <- b$Runtime$evaluate("typeof slideshow !== 'undefined'")$result$value
if (!has_remark) {
stop("Input does not appear to be xaringan slides: ", input)
}
current_slide <- function() {
x <- b$Runtime$evaluate("slideshow.getCurrentSlideIndex()")$result$value
as.integer(x) + 1L
}
slide_is_continuation <- function() {
b$Runtime$evaluate(
"document.querySelector('.remark-visible').matches('.has-continuation')"
)$result$value
}
hash_current_slide <- function() {
digest::digest(b$Runtime$evaluate(
"document.querySelector('.remark-visible').innerHTML"
)$result$value)
}
get_ratio <- function() {
r <- b$Runtime$evaluate('slideshow.getRatio()')$result$value
r <- lapply(strsplit(r, ":"), as.integer)
width <- r[[1]][1]
height <- r[[1]][2]
page_width <- 8/width * width
list(
width = as.integer(908 * width / height),
height = 681L,
page = list(width = page_width, height = page_width * height / width)
)
}
slide_size <- get_ratio()
expected_slides <- as.integer(
b$Runtime$evaluate("slideshow.getSlideCount()")$result$value
)
max_slides <- expected_slides * 4
b$Browser$setWindowBounds(1, bounds = list(
width = slide_size$width,
height = slide_size$height
))
b$Emulation$setEmulatedMedia("print")
b$Runtime$evaluate(paste0(
"let style = document.createElement('style')\n",
"style.innerText = '@media print { ",
".remark-slide-container:not(.remark-visible){ display:none; }",
if (include_partial_slides) " .has-continuation { display: block }",
"}'\n",
"document.head.appendChild(style)"
))
pb <- progress::progress_bar$new(
format = "Slide :slide (:part) [:bar] Eta: :eta",
total = expected_slides
)
idx_slide <- current_slide()
last_hash <- ""
idx_part <- 0L
pdf_files <- c()
for (i in seq_len(max_slides)) {
if (i > 1) {
b$Input$dispatchKeyEvent(
"rawKeyDown",
windowsVirtualKeyCode = 39,
code = "ArrowRight",
key = "ArrowRight",
wait_ = TRUE
)
}
if (current_slide() == idx_slide) {
step <- 0L
idx_part <- idx_part + 1L
} else {
step <- 1L
idx_part <- 1L
}
idx_slide <- current_slide()
pb$tick(step, tokens = list(slide = idx_slide, part = idx_part))
if (!isTRUE(include_partial_slides) && slide_is_continuation()) next
Sys.sleep(delay)
this_hash <- hash_current_slide()
if (identical(last_hash, this_hash)) break
last_hash <- this_hash
pdf_file_promise <- b$Page$printToPDF(
landscape = TRUE,
printBackground = TRUE,
paperWidth = 12,
paperHeight = 9,
marginTop = 0,
marginRight = 0,
marginBottom = 0,
marginLeft = 0,
pageRanges = "1",
preferCSSPageSize = TRUE,
wait_ = FALSE
)$then(function(value) {
filename <- tempfile(fileext = ".pdf")
writeBin(jsonlite::base64_dec(value$data), filename)
filename
})
pdf_files <- c(pdf_files, b$wait_for(pdf_file_promise))
}
pdftools::pdf_combine(pdf_files, output = output_file)
fs::file_delete(pdf_files)
invisible(output_file)
}
@lbelzile
Copy link

lbelzile commented Feb 1, 2021

Thanks Garrick for this nice feature. I dunno if this is a platform specific-problem, but I get additional blank slides when using the function (e.g., this slide deck gets three empty slides when printed that are not in the html version). I am at lost as to why this happens: did anyone else experience this problem?

@gadenbuie
Copy link
Author

@ibelzile it's because of how partial slides are handled — I just pushed a fix that lets you choose between skipping partial slides or including each one. BTW, I've added this function to xaringanBuilder. Give that package a look, it has some nice features that compliment this function!

@lbelzile
Copy link

lbelzile commented Feb 1, 2021

Thanks for this additional feature, it works flawlessly! Its also nice to know the function has found its way in a package, I will surely have a look.

@simonschoe
Copy link

Hi Garrick, thanks for function, love the simplicity compared to spinning up a docker image for using decktape. However, it appears that emojis can only be rendered in black and white (those stemming from Hadley's emo::ji() function). Any idea how to work around this?

@bttomio
Copy link

bttomio commented Feb 18, 2021

Thanks for this feature, Garrick! I would like to try it to see if it prints correctly your panelset feature. Nonetheless, I am getting this error message:

Error in find_chrome() : 
  `google-chrome` and `chromium-browser` were not found. Try setting the CHROMOTE_CHROME environment variable or adding one of these executables to your PATH.

My guess is that it's failing to find Chromium on Ubuntu, which would be linked to "chromium" instead of "chromium-browser". Could you please take a look at it? Thanks once again!

@lbelzile
Copy link

@bttomio The issue is with the chromote package; there is already a pull request, but it hasn't been merged in the main branch. See rstudio/chromote#27

Until this has been fixed, you can change chrome.R of the chromote package by setting

  path <- Sys.which("google-chrome")
    if (nchar(path) == 0) {
      path <- Sys.which("chromium-browser")
    }
    if (nchar(path) == 0) {
      path <- Sys.which("chromium")
    }

@bttomio
Copy link

bttomio commented Feb 18, 2021

@lbelzile, thanks for your quick answer. I wish I could find chrome.R to change it. Any idea of how to find it in Ubuntu?

@lbelzile
Copy link

It's in the R package chromote, see this directory. You can download the source package, change chrome.R and build the package afterwards yourself.

@bshor
Copy link

bshor commented Nov 15, 2021

I'm running the latest R and Rstudio on Garuda (Arch-derivative), with everything updated. I'm getting the following error on running your code.

google-chrome and chromium-browser were not found. Try setting the CHROMOTE_CHROME environment variable or adding one of these executables to your PATH.`

But I most definitely have Google Chrome installed!

@jobreu
Copy link

jobreu commented Nov 16, 2023

Thanks a lot for this really helpful gist! When I source and run the function once in RStudio, everything works fine. However, when I want to execute the function again, I get the following error message: Error in onRejected(reason) : code: -32000 message: Browser window not found . Restarting my R session solves this issue.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment