Question

首先，我要感谢Baptiste爵士帮助我改进我的R脚本，在组合图的左下方添加一个标题，使用gtable / textGrob，如下所示：

library(grid)
library(gridExtra)
library(ggplot2)

p1 <- p2 <- ggplot()

g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)

g <- rbind(g1, g2)
caption <- textGrob("Figure 1. This is a caption", hjust=0, x=0)
g <- gtable::gtable_add_rows(g, unit(2,"mm") + grobHeight(caption), -1)
g <- gtable::gtable_add_grob(g, caption, nrow(g), l = 4, r = ncol(g))
grid.newpage()
grid.draw(g)

但是，我想再添加两件事：

（1）在标题中插入一个科学名称，该标题应以斜体字书写。 - 例如，根据上面提到的标题，我想只用“is”这个词来表示，而其余的都是纯文本。

（2）我还会在标题中添加符号，例如point shapes = c（1,22）; colors = c（“黑色”，“红色”）; fill = c（“red”，“black”）。

我怎么做这些？我是R程序的新手用户，因此非常感谢您的帮助。谢谢。

更新：

我已经使用此脚本在@Docconcoct，@ user20650和@baptiste的帮助下解决了查询1：

library(grid)
library(gridExtra)
library(ggplot2)

g1 <- ggplotGrob(pl)
g2 <- ggplotGrob(pl1)

g <- rbind(g1, g2)
caption <- textGrob(expression(paste("Figure 1. This",  italic(" is"), " a caption")), hjust=0, x=0)
g <- gtable::gtable_add_rows(g, unit(2,"mm") + grobHeight(caption), -1)
g <- gtable::gtable_add_grob(g, caption, nrow(g), l = 4, r = ncol(g))
grid.newpage()
grid.draw(g)

对于查询2，正如@baptiste爵士所说，在我给他的原始电子邮件中，我已经有了关于合并图的传奇。但是，在图标题中，我需要说明图例中的符号是什么，以及该图的其他一些细节。根据巴蒂斯特爵士给出的例子，我需要在标题中包含支持的含义，以及OJ（黑圈）和VC（黑三角）的符号。

再次，非常感谢！

Answer 1

根据评论，我建议采用以下策略：创建一个虚拟情节，用你的人物标题（文字）作为图例标题，提取其图例，并将其放在你的gtable的底部。

library(grid)
library(gridExtra)
library(ggplot2)
library(gtable)

p1 <- ggplot()
p2 <- ggplot(ToothGrowth, aes(len, dose, shape=supp)) + geom_point() +
  theme(legend.position="bottom", 
        legend.background=element_rect(colour="black")) 

title <- expression("Figure 1. This "*italic(is)*" now a legendary caption")
dummy <- ggplotGrob(p2 + guides(shape = guide_legend(title = title)))

g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
caption <- gtable_filter(dummy,"guide")[["grobs"]][[1]]
caption$widths <- grid:::unit.list(caption$widths)
caption$widths <- unit.c(unit(0,"mm"), caption$widths[2], unit(1,"null"))

g <- rbind(g1, g2)
g <- gtable::gtable_add_rows(g, unit(2,"mm") + grobHeight(caption), -1)
g <- gtable::gtable_add_grob(g, caption, nrow(g), l = 4, r = ncol(g))
grid.newpage()
grid.draw(legend)
grid.draw(g)

Answer 2

我认为一个好的解决方案将依赖于LaTeX或类似的文本渲染，特别是线条包装的棘手问题，但可以在R级别设计一些东西，以便于包含对应于给定图形的绘图符号。这些方面的东西，

gl = extract_legend_grobs(p)
caption = caption_plot("Figure 1. We are referring to the points {{gl$points[supp == OG'']}}. 
 The theoretical model is shown as {{gl$lines[type == 'theory']}}.", gl)

print(caption, output="latex")
## "Figure 1. We are referring to the points \includegraphics{gl_p_1.png}. 
## The theoretical model is shown as \includegraphics{gl_l_1.png}."

有趣的想法，但可能需要做很多工作才能做到正确。

也可以设计出快速而肮脏的R图形输出，但是想要将字幕作为图形的一部分并且（并且R图形对于文本不是特别好）并不常见。

这是一个弱的尝试，使标题混合符号和文本。理想情况下，文本将首先分成单个单词（为换行提供更多选项），但plotmath表达式使其不方便。

下一步是添加一些方便的包装器来生成公共符号，并交换两个grob列表。

library(grid)
library(gridExtra)

inwidth <- function(x, margin=unit(1,"mm")) {
  if(inherits(x, "text"))
    convertWidth(grobWidth(x)+margin, "in", valueOnly = TRUE) else
      convertWidth(unit(1,"line")+margin, "in", valueOnly = TRUE)
}

captionGrob <- function(..., width = unit(4, "in"), debug = FALSE){

  maxw <- convertWidth(width, "in", valueOnly = TRUE)
  lg <- list(...)
  lw <- lapply(lg, inwidth)
  stopifnot(all(lw < maxw))

  # find breaks
  cw <- cumsum(lw)
  bks <- which(c(0, diff(cw %% maxw))  < 0 )
  # list of lines
  tg <- list()
  starts <- c(1, bks)
  ends <- c(bks -1, length(lg))

  for(line in seq_along(starts)){
    ids <- seq(starts[line], ends[line])
    sumw <- do.call(sum,lw[ids])
    neww <- maxw - sumw # missing width to fill
    filler <- rectGrob(gp=gpar(col=NA, fill=NA), 
                             width=unit(neww, "in"), 
                             height=unit(1, "line"))
    grobs <- c(lg[ids], list(filler))

    # store current line
    tg[[line]] <- arrangeGrob(grobs=grobs, nrow = 1, 
                              widths = unit(c(lw[ids], neww), "in"))

  }

  # arrange all lines in one column
  grid.arrange(grobs=tg, ncol=1,
               heights = unit(rep(1, length(tg)), "line"))

  if(debug)  grid.rect(width=width, gp=gpar(fill=NA, lty=2))
}

tg <- lapply(c(expression(bold(Figure~1.)~italic(Those)~points), 
               "are important, ", "nonetheless", "and", "have value too."), 
             textGrob)
pGrob <- function(fill, size=1, ...){
  rectGrob(..., width=unit(size,"line"), height=unit(size,"line"), gp=gpar(fill=fill))
}
pg <- mapply(pGrob, fill=1:5, size=0.5, SIMPLIFY = FALSE)
grid.newpage()
captionGrob(tg[[1]], pg[[1]], pg[[2]], pg[[3]], tg[[2]], tg[[3]], pg[[4]], tg[[4]], pg[[5]], tg[[5]])

图片标题科学名称+ textGrob gtable中的符号

2 个答案: