##' arrange ggplot2, lattice, and grobs on a page
##'
##' @aliases grid.arrange arrangeGrob latticeGrob drawDetails.lattice print.arrange
##' @title arrangeGrob
##' @param ... plots of class ggplot2, trellis, or grobs, and valid arguments to grid.layout
##' @param main string, or grob (requires a well-defined height, see example)
##' @param sub string, or grob (requires a well-defined height, see example)
##' @param legend string, or grob (requires a well-defined width, see example)
##' @param left string, or grob (requires a well-defined width, see example)
##' @param as.table logical: bottom-left to top-right or top-left to bottom-right
##' @param clip logical: clip every object to its viewport
##' @return return a frame grob; side-effect (plotting) if plot=T
##' @export
##'
##' @examples
##' \dontrun{
##' require(ggplot2)
##' plots = lapply(1:5, function(.x) qplot(1:10,rnorm(10), main=paste("plot",.x)))
##' require(gridExtra)
##' do.call(grid.arrange, plots)
##' require(lattice)
##' grid.arrange(qplot(1:10), xyplot(1:10~1:10),
##' tableGrob(head(iris)), nrow=2, as.table=TRUE, main="test main",
##' sub=textGrob("test sub", gp=gpar(font=2)))
##' }
arrangeGrob <- function(..., as.table=FALSE, clip=TRUE,
main=NULL, sub=NULL, left=NULL,
legend=NULL) {
if(is.null(main)) main <- nullGrob()
if(is.null(sub)) sub <- nullGrob()
if(is.null(legend)) legend <- nullGrob()
if(is.null(left)) left <- nullGrob()
if(is.character(main)) main <- textGrob(main)
if(is.character(sub)) sub <- textGrob(sub)
if(is.character(legend)) legend <- textGrob(legend, rot=-90)
if(is.character(left)) left <- textGrob(left, rot=90)
arrange.class <- "arrange" # grob class
dots <- list(...)
params <- c("nrow", "ncol", "widths", "heights",
"default.units", "respect", "just" )
## names(formals(grid.layout))
layout.call <- intersect(names(dots), params)
params.layout <- dots[layout.call]
if(is.null(names(dots)))
not.grobnames <- FALSE else
not.grobnames <- names(dots) %in% layout.call
grobs <- dots[! not.grobnames ]
n <- length(grobs)
nm <- n2mfrow(n)
if(is.null(params.layout$nrow) & is.null(params.layout$ncol))
{
params.layout$nrow = nm[1]
params.layout$ncol = nm[2]
}
if(is.null(params.layout$nrow))
params.layout$nrow = ceiling(n/params.layout$ncol)
if(is.null(params.layout$ncol))
params.layout$ncol = ceiling(n/params.layout$nrow)
nrow <- params.layout$nrow
ncol <- params.layout$ncol
lay <- do.call(grid.layout, params.layout)
fg <- frameGrob(layout=lay)
## if a ggplot is present, make the grob derive from the ggplot class
classes <- lapply(grobs, class)
inherit.ggplot <- any("ggplot" %in% unlist(classes))
if(inherit.ggplot) arrange.class <- c(arrange.class, "ggplot")
ii.p <- 1
for(ii.row in seq(1, nrow)){
ii.table.row <- ii.row
if(as.table) {ii.table.row <- nrow - ii.table.row + 1}
for(ii.col in seq(1, ncol)){
ii.table <- ii.p
if(ii.p > n) break
## select current grob
cl <- class(grobs[[ii.table]])
ct <- if("grob" %in% unlist(cl)) "grob" else
if("ggplot" %in% unlist(cl)) "ggplot" else cl
g.tmp <- switch(ct,
ggplot = ggplotGrob(grobs[[ii.table]]),
trellis = latticeGrob(grobs[[ii.table]]),
grob = grobs[[ii.table]],
stop("input must be grobs!"))
if(clip) # gTree seems like overkill here ?
g.tmp <- gTree(children=gList(clipGrob(), g.tmp))
fg <- placeGrob(fg, g.tmp, row=ii.table.row, col=ii.col)
ii.p <- ii.p + 1
}
}
## optional annotations in a frame grob
wl <- unit(1, "grobwidth", left)
wr <- unit(1, "grobwidth", legend)
hb <- unit(1, "grobheight", sub)
ht <- unit(1, "grobheight", main)
annotate.lay <- grid.layout(3, 3,
widths=unit.c(wl, unit(1, "npc")-wl-wr, wr),
heights=unit.c(ht, unit(1, "npc")-hb-ht, hb))
af <- frameGrob(layout=annotate.lay)
af <- placeGrob(af, fg, row=2, col=2)
af <- placeGrob(af, main, row=1, col=2)
af <- placeGrob(af, sub, row=3, col=2)
af <- placeGrob(af, left, row=2, col=1)
af <- placeGrob(af, legend, row=2, col=3)
invisible(gTree(children=gList(af), cl=arrange.class))
}
##' @export
grid.arrange <- function(..., as.table=FALSE, clip=TRUE,
main=NULL, sub=NULL, left=NULL, legend=NULL,
newpage=TRUE){
if(newpage) grid.newpage()
grid.draw(arrangeGrob(...,as.table=as.table, clip=clip,
main=main, sub=sub, left=left, legend=legend))
}
##' @export
latticeGrob <- function(p, ...){
grob(p=p, ..., cl="lattice")
}
##' @export
drawDetails.lattice <- function(x, recording=FALSE){
lattice:::plot.trellis(x$p, newpage=FALSE)
}
##' @export
print.arrange <- function(x, newpage = is.null(vp), vp = NULL, ...) {
if(newpage) grid.newpage()
grid.draw(editGrob(x, vp=vp))
}
##' Interface to arrangeGrob that can dispatch on multiple pages
##'
##' If the layout specifies both nrow and ncol, the list of grobs can be split
##' in multiple pages. Interactive devices print open new windows, whilst non-interactive
##' devices such as pdf call grid.newpage() between the drawings.
##' @title marrangeGrob
##' @aliases marrangeGrob print.arrangelist
##' @param ... grobs
##' @param as.table see \link{arrangeGrob}
##' @param clip see \link{arrangeGrob}
##' @param top see \link{arrangeGrob}
##' @param bottom see \link{arrangeGrob}
##' @param left see \link{arrangeGrob}
##' @param right see \link{arrangeGrob}
##' @return a list of class arrangelist
##' @author baptiste Auguie
##' @export
##' @family user
##' @examples
##' \dontrun{
##' require(ggplot2)
##' pl <- lapply(1:11, function(.x) qplot(1:10,rnorm(10), main=paste("plot",.x)))
##' ml <- do.call(marrangeGrob, c(pl, list(nrow=2, ncol=2)))
##' ## interactive use; open new devices
##' ml
##' ## non-interactive use, multipage pdf
##' ggsave("multipage.pdf", ml)
##' }
marrangeGrob <- function(..., as.table=FALSE, clip=TRUE,
top=quote(paste("page", g, "of", pages)),
bottom=NULL, left=NULL, right=NULL){
arrange.class <- "arrange" # grob class
dots <- list(...)
params <- c("nrow", "ncol", "widths", "heights",
"default.units", "respect", "just" )
## names(formals(grid.layout))
layout.call <- intersect(names(dots), params)
params.layout <- dots[layout.call]
if(is.null(names(dots)))
not.grobnames <- FALSE else
not.grobnames <- names(dots) %in% layout.call
grobs <- dots[! not.grobnames ]
n <- length(grobs)
nm <- n2mfrow(n)
if(is.null(params.layout$nrow) & is.null(params.layout$ncol))
{
params.layout$nrow = nm[1]
params.layout$ncol = nm[2]
}
if(is.null(params.layout$nrow))
params.layout$nrow = ceiling(n/params.layout$ncol)
if(is.null(params.layout$ncol))
params.layout$ncol = ceiling(n/params.layout$nrow)
nrow <- params.layout$nrow
ncol <- params.layout$ncol
## if nrow and ncol were given, may need multiple pages
nlay <- with(params.layout, nrow*ncol)
## add one page if division is not complete
pages <- n %/% nlay + as.logical(n %% nlay)
groups <- split(seq_along(grobs),
gl(pages, nlay, n))
pl <-
lapply(names(groups), function(g)
{
top <- eval(top) ## lazy evaluation
do.call(arrangeGrob, c(grobs[groups[[g]]], params.layout,
list(as.table=as.table, clip=clip,
main=top, sub=bottom, left=left, legend=right)))
})
class(pl) <- c("arrangelist", "ggplot", class(pl))
pl
}
##' @export
print.arrangelist = function(x, ...) lapply(x, function(.x) {
if(dev.interactive()) dev.new() else grid.newpage()
grid.draw(.x)
}, ...)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.