Skip to content
Permalink
Browse files

Basic use of new gridGraphics device capability implemented.

  • Loading branch information...
clauswilke committed Mar 24, 2018
1 parent bb819a1 commit 3dbd598ac9b37374cc5a78e52a24e17ae94653ac
Showing with 52 additions and 30 deletions.
  1. +5 −5 DESCRIPTION
  2. +15 −6 R/plot_to_gtable.R
  3. +20 −13 R/set_null_device.R
  4. +12 −6 vignettes/plot_grid.Rmd
@@ -11,12 +11,12 @@ Description: Some helpful extensions and modifications to the 'ggplot2'
package name, which stands for Claus O. Wilke's plot package.
URL: https://github.com/wilkelab/cowplot
Depends:
R (>= 3.3.0),
R (>= 3.5.0),
ggplot2 (>= 2.1.0),
Imports:
grid (>= 3.0.0),
gtable (>= 0.1.2),
plyr (>= 1.8.2),
grid,
gtable,
plyr,
grDevices,
methods,
scales,
@@ -26,7 +26,7 @@ LazyData: true
Suggests:
Cairo,
covr,
gridGraphics,
gridGraphics (>= 0.2-2),
knitr,
magick,
maps,
@@ -24,13 +24,11 @@ plot_to_gtable <- function(plot){
}
else {
# we convert the captured plot or output plot into a grob
# to be safe, we have to save and restore the current graphics device
cur_dev <- grDevices::dev.cur()
tree <- grid::grid.grabExpr(gridGraphics::grid.echo(plot)) # capture plot
grDevices::dev.set(cur_dev)
grob <- plot_to_grob(plot) # capture plot

# now wrap into a gtable
u <- grid::unit(1, "null")
gt <- gtable::gtable_col(NULL, list(tree), u, u)
gt <- gtable::gtable_col(NULL, list(grob), u, u)
# fix gtable clip setting
gt$layout$clip <- "inherit"
gt
@@ -50,7 +48,7 @@ plot_to_gtable <- function(plot){
# `Cairo(type = "raster")` works well on Windows but font-handling is broken on OS X.)

cur_dev <- grDevices::dev.cur() # store current device
null_dev_env$current() # open null device
null_dev_env$current(width = 6, height = 6) # open null device
null_dev <- grDevices::dev.cur() # store null device
plot <- ggplot2::ggplotGrob(plot) # convert plot to grob
grDevices::dev.off(null_dev) # close null device
@@ -78,3 +76,14 @@ plot_to_gtable <- function(plot){
}
}

# function that reliably captures a base plot and turns it into a grob
plot_to_grob <- function(plot) {
device <- null_dev_env$current
grid::recordGrob(
tryCatch(
gridGraphics::grid.echo(plot, newpage=FALSE, device = device),
error = function(e) {}
),
list(plot = plot, device = device))
}

@@ -17,9 +17,13 @@
#' @examples
#' set_null_device("png") # set the png null device
#'
#' # create a jpg null device
#' jpg_null_device <- function() {jpeg(filename = "jpeg_null_plot.jpg")}
#' set_null_device(jpg_null_device)
#' # create a jpeg null device
#' jpeg_null_device <- function(width, height) {
#' jpeg(filename = "jpeg_null_plot.jpg",
#' width = width, height = height, units = "in", res = 96)
#' dev.control("enable")
#'}
#' set_null_device(jpeg_null_device)
#' @export
set_null_device <- function(null_device) {
old <- null_dev_env$current
@@ -33,7 +37,7 @@ set_null_device <- function(null_device) {
cairo = cairo_null_device,
Cairo = cairo_null_device,
{
warning("Null device ", null_device, " not recognized. Substituting grDevices::pdf(NULL).", call. = FALSE);
warning("Null device ", null_device, " not recognized. Substituting grDevices::pdf().", call. = FALSE);
pdf_null_device
}
)
@@ -42,20 +46,25 @@ set_null_device <- function(null_device) {
invisible(old)
}

png_null_device <- function() {
grDevices::png(filename = "cowplot_null_plot.png")
png_null_device <- function(width, height) {
grDevices::png(filename = "cowplot_null_plot.png", width = width, height = height,
units = "in", res = 96)
dev.control("enable")
}

pdf_null_device <- function() {
grDevices::pdf(NULL)
pdf_null_device <- function(width, height) {
grDevices::pdf(NULL, width = width, height = height)
dev.control("enable")
}

cairo_null_device <- function() {
cairo_null_device <- function(width, height) {
if (requireNamespace("Cairo", quietly = TRUE)) {
Cairo::Cairo(type = "raster")
Cairo::Cairo(type = "raster", width = width, height = height,
units = "in")
dev.control("enable")
} else {
warning("Package `Cairo` is required to use the Cairo null device. Substituting grDevices::pdf(NULL).", call. = FALSE)
grDevices::pdf(NULL)
pdf_null_device(width, height)
}
}

@@ -64,5 +73,3 @@ cairo_null_device <- function() {
null_dev_env <- new.env(parent = emptyenv())
null_dev_env$current <- pdf_null_device



@@ -59,18 +59,24 @@ The function `plot_grid()` can handle several different plot formats, including

For example, the following creates a `recordedPlot` object by recording a previous plot (`plot(sqrt)`):
```{r, message=FALSE, results="hold", collapse=TRUE}
par(xpd = NA, # switch off clipping, necessary to always see axis labels
bg = "transparent", # switch off background to avoid obscuring adjacent plots
oma = c(2, 2, 0, 0), # move plot to the right and up
par(bg = "transparent", # switch off background to avoid obscuring adjacent plots
mar = c(3, 3, 1, 1) + .1, # reduce margins
mgp = c(2, 1, 0) # move axis labels closer to axis
)
)
plot(sqrt) # plot the square root function
recordedplot <- recordPlot() # record the previous plot
```

Next we define a function that creates a plot:
```{r, message=FALSE}
plotfunc <- function() image(volcano) # define the function
# define the function
plotfunc <- function() {
par(bg = "transparent", # switch off background to avoid obscuring adjacent plots
mar = c(3, 3, 1, 1) + .1, # reduce margins
mgp = c(2, 1, 0) # move axis labels closer to axis
)
image(volcano)
}
plotfunc() # call the function to make the plot
```

@@ -83,7 +89,7 @@ ggdraw(gcircle)
Now we combine all these plots with `plot_grid()`:
```{r, message=FALSE, fig.width=7, fig.height=5}
plot_grid(plot.mpg, recordedplot, plotfunc, gcircle, labels = "AUTO", hjust = 0, vjust = 1,
scale = c(1., 1., 0.9, 0.9))
scale = c(1., 1., 1., 0.9))
```
Note that the various alignment functions of `plot_grid()` only work with plots generated by `ggplot`, not with any of the other supported plot types.

0 comments on commit 3dbd598

Please sign in to comment.
You can’t perform that action at this time.