plot2img.R

#' @param expr Expression or code block that generates a plot.
#' @param width,height The size of the image, in pixels, as viewed in the web page.
#' @param res The effective resolution of the image, before factoring in HiDPI/retina,
#'   in pixels per inch. Lower values will result in smaller fonts/glyphs.
#' @param retina If \code{TRUE}, then the image data will be generated using doubled
#'   values for width, height, and resolution, resulting in a sharper image on
#'   HiDPI/retina displays. If \code{FALSE}, then the width, height, and res values
#'   will be used as-is. If a numeric value, then that factor will be used (so
#'   \code{TRUE} is an alias for \code{2}, and \code{FALSE} is an alias for \code{1}).
#' @param device If a function, use the function to start the new graphics device.
#'   If not provided, then either \code{grDevices::png} or \code{Cairo::CairoPNG} will
#'   be used, depending on platform and availability.
#' @param contentType If a custom device is used that produces something other than
#'   PNG image data, then use this argument to specify the content type of the image.
#' @param ... Arguments to pass through to the device function.
plot2img <- function(expr, width = 600, height = 600, res = 96, retina = TRUE,
  device = "auto", contentType = "image/png", ...) {
  
  pngfun <- if (is.function(device)) {
    device
  } else if (!missing(device)) {
    stop("Invalid device argument")
  } else if (capabilities("aqua")) {
    grDevices::png
  } else if (nchar(system.file(package = "Cairo"))) {
    Cairo::CairoPNG
  } else {
    grDevices::png
  }
  
  tmpfile <- tempfile(fileext = ".png")
  
  if (isTRUE(retina)) {
    retina <- 2
  } else if (identical(retina, FALSE)) {
    retina <- 1
  }
  
  physHeight <- height * retina
  physWidth <- width * retina
  physRes <- res * retina
  
  pngfun(filename = tmpfile,
    width = width * retina,
    height = height * retina,
    res = res * retina, ...)
  op <- graphics::par(mar = rep(0, 4))
  tryCatch(graphics::plot.new(), finally = graphics::par(op))
  dv <- grDevices::dev.cur()
  tryCatch(
    {
      result <- withVisible(expr)
      if (result$visible) {
        utils::capture.output(print(result$value))
      }
    },
    finally = grDevices::dev.off(dv)
  )
  
  on.exit(unlink(tmpfile), add = TRUE)
  
  b64data <- base64enc::base64encode(tmpfile, 0)
  htmltools::tags$img(src = paste0("data:", contentType, ";base64,", b64data),
    style = htmltools::css(
      width = htmltools::validateCssUnit(width),
      height = htmltools::validateCssUnit(height)
    )
  )
}

# EXAMPLE

library(ggplot2)
library(leaflet)

plt <- plot2img({
  ggplot(cars, aes(speed, dist)) + geom_point()
}, width = 300, height = 200, res = 60)

leaflet() %>% addTiles() %>% addMarkers(0, 0,
  popup = as.character(plt),
  label = "Click me!", labelOptions = labelOptions(noHide = TRUE))