将注释框添加到ggplot对象的网格中

时间:2013-09-19 23:12:39

标签: r ggplot2 gridextra

我正在使用ggplot函数准备37 grid.arrange个网格。为了节省轴标签当前占用的空间并添加一些信息,如Sys.time(),我会在图形网格的右下角添加一个框。

使用mtcars数据的最小示例可以在下面找到。真实数据将涵盖x轴上的非常不同的范围,以及刻面不是一种选择。

是否可以添加“文本框”,如下面的* .pdf中所示,以使用例如添加更多信息catprint?任何提示都将受到高度赞赏。

# load needed libraries
library(ggplot2)
library(gridExtra)

# Set loop counter and create list to store objects
imax=37 
plist <- list() 

# loop to generate 37 ggplot objects
# the real example covers different ranges on x-axis so facetting
# is not an option
for(i in 1:imax){
  p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_line()  + ggtitle(i) 
  plist[[i]] <- p
}

# print to pdf in A3 format
pdf(file="out.pdf",width=16.5,height=11.7)
do.call(grid.arrange,c(plist,main="Main Title",sub="Subtitle"))
dev.off()

The output generated by above script

更新

Slowlearner使用Baptiste提供的代码的解决方案完全符合我的要求。

实现类似功能的另一种方法是在空图上使用annotate_custom() ggplot2函数。空表示所有theme()属性都设置为element_blank()。然后可以使用Winston Chang在其R Cookbook网站上提供的the following function将该情节安排在网格中。但是,在这个解决方案中,textgrob不会跨越所有剩余的空格。

1 个答案:

答案 0 :(得分:4)

基于对Baptiste上述评论的成熟考虑(即我基本上捏了他所有的代码),我把一个简单的例子放在一起。显然,您需要尝试绘制图表的格式和大小,textGrob需要在其他地方定义和格式化,但这些都是详细信息。生成的图表如下,代码如下。其中大部分内容由the function definition占用,底部的情节代码。

enter image description here

gtable_arrange <- function(..., grobs=list(), as.table=TRUE,
                           top = NULL, bottom = NULL, 
                           left = NULL, right = NULL, draw=TRUE){
  require(gtable)
  # alias
  gtable_add_grobs <- gtable_add_grob

  dots <- list(...)
  params <- c("nrow", "ncol", "widths", "heights",
              "respect", "just", "z") # TODO currently ignored

  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

  if(!length(grobs))
  grobs <- dots[! not.grobnames ]

  ## figure out the layout
  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)

  if(is.null(params.layout$widths))
    params.layout$widths <- unit(rep(1, params.layout$ncol), "null")
  if(is.null(params.layout$heights))
    params.layout$heights <- unit(rep(1,params.layout$nrow), "null")

  positions <- expand.grid(row = seq_len(params.layout$nrow), 
                           col = seq_len(params.layout$ncol))
  if(as.table) # fill table by rows
    positions <- positions[order(positions$row),]

  positions <- positions[seq_along(grobs), ] # n might be < ncol*nrow

  ## build the gtable, similar steps to gtable_matrix

  gt <- gtable(name="table")
  gt <- gtable_add_cols(gt, params.layout$widths)
  gt <- gtable_add_rows(gt, params.layout$heights)
  gt <- gtable_add_grobs(gt, grobs, t = positions$row, 
                            l = positions$col)

  ## titles given as strings are converted to text grobs
  if (is.character(top)) 
    top <- textGrob(top)
  if (is.character(bottom)) 
    bottom <- textGrob(bottom)
  if (is.character(right)) 
    right <- textGrob(right, rot = -90)
  if (is.character(left)) 
    left <- textGrob(left, rot = 90)

  if(!is.null(top)){
    gt <- gtable_add_rows(gt, heights=grobHeight(top), 0)
    gt <- gtable_add_grobs(gt, top, t=1, l=1, r=ncol(gt))
  }
  if(!is.null(bottom)){
    gt <- gtable_add_rows(gt, heights=grobHeight(bottom), -1)
    gt <- gtable_add_grobs(gt, bottom, t=nrow(gt), l=1, r=ncol(gt))
  }
  if(!is.null(left)){
    gt <- gtable_add_cols(gt, widths=grobWidth(left), 0)
    gt <- gtable_add_grobs(gt, left, t=1, b=nrow(gt), l=1, r=1)
  }
  if(!is.null(right)){
    gt <- gtable_add_cols(gt, widths=grobWidth(right), -1)
    gt <- gtable_add_grobs(gt, right, t=1, b=nrow(gt), l=ncol(gt), r=ncol(gt))
  }

  if(draw){
   grid.newpage()
   grid.draw(gt)
  }
  gt

}

# load needed libraries
library(ggplot2)

# Set loop counter and create list to store objects
imax=37
plist <- list()
p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_line() 

for(i in 1:imax){
  plist[[i]] <- p + ggtitle(i)
}

# build list of grobs
grob.list <- lapply(plist, ggplotGrob)

# prepare titles
title.main <- textGrob("Main title")
title.sub <- textGrob("Subtitle")

# then arrange as required
g <- gtable_arrange(ncol=6, grobs=grob.list, 
                    top=title.main, bottom=title.sub, draw=FALSE)
ann <- grobTree(rectGrob(), textGrob("Annotation box here"))
g <- gtable_add_grobs(g, ann, t=nrow(g)-1, l=2, r=ncol(g))

# save it all together
png(file = "out.png",width=1000, height=710, units = "px")
grid.draw(g)
dev.off()