Functions and examples on rasterising ggplot2 layers

rasterising_ggplot_layers.R

# Preface:
# This document has two function to rasterise ggplot2 layers.
# The functions are very similar in structure to those in thomas85's ggfx package (https://github.com/thomasp85/ggfx),
# The ggfx package is licenced under an MIT licence, so I think this should be OK.

library(ggplot2)
library(grid)
library(ragg)
library(png)

# Main function that the user should use.
# They should use it to call a geom/stat custructor with.
# e.g. rasterise(geom_line(...)) or rasterise(stat_density(...))
rasterise <- function(layer, dpi = NULL, dev = "cairo") {
  dev <- match.arg(dev, c("cairo", "ragg", "ragg_png"))
  old_geom <- layer$geom
  ggproto(
    NULL, layer,
    geom = ggproto(
      NULL, old_geom,
      draw_panel = function(...) {
        grob <- old_geom$draw_panel(...)
        class(grob) <- c("rasteriser", class(grob))
        grob$dpi <- dpi
        grob$dev <- dev
        return(grob)
      }
    )
  )
}

makeContext.rasteriser <- function(x) {
  # Grab viewport information
  vp <- if(is.null(x$vp)) viewport() else x$vp
  width <- grid::convertWidth(unit(1, "npc"), "inch", valueOnly = TRUE)
  height <- grid::convertHeight(unit(1, "npc"), "inch", valueOnly = TRUE)
  
  # Grab grob metadata
  dpi <- x$dpi
  if (is.null(dpi)) {
    dpi <- convertWidth(unit(1, "inch"), "pt", valueOnly = TRUE)
  }
  dev <- x$dev
  
  # Clean up grob
  x$dev <- NULL
  x$dpi <- NULL
  class(x) <- setdiff(class(x), "rasteriser")
  
  # Track current device
  dev_cur <- dev.cur()
  on.exit(dev.set(dev_cur), add = TRUE)
  
  # Setup temporary device for capture
  if (dev == "cairo") {
    dev_id <- Cairo::Cairo(
      type = 'raster',
      width = width, 
      height = height,
      units = "in",
      dpi = dpi, bg = NA
    )[1]
  } else if (dev == "ragg") {
    dev_id <- ragg::agg_capture(
      width = width, height = height,
      units = "in", res = dpi, 
      background = NA
    )
  } else {
    file <- tempfile(fileext = ".png")
    ragg::agg_png(
      file,
      width = width, height = height, 
      units = "in", res = dpi,
      background = NA
    )
    on.exit(unlink(file), add = TRUE)
  }

  # Render layer
  grid::pushViewport(vp)
  grid::grid.draw(x)
  grid::popViewport()
  
  # Capture raster
  if (dev != "ragg_png") {
    cap <- grid.cap()
  }
  
  # Reset device to current
  dev.off()
  
  if (dev == "ragg_png") {
    cap <- png::readPNG(file, native = FALSE)
    dim <- dim(cap)
    cap <- matrix(
      rgb(
        red = as.vector(cap[,,1]),
        green = as.vector(cap[,,2]),
        blue = as.vector(cap[,,3]),
        alpha = as.vector(cap[,,4])
      ),
      dim[1], dim[2]
    )
  }
  
  # Forward raster grob
  grid::rasterGrob(
    cap, x = 0.5, y = 0.5, 
    height = unit(height, "inch"),
    width = unit(width, "inch"),
    default.units = "npc",
    just = "center"
  )
}

# Example of usage
ggplot(iris, aes(Sepal.Width, Sepal.Length, colour = Species)) +
  rasterise(geom_point(), dpi = 300, dev = "ragg_png")