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

Question

首先，我要感谢巴蒂斯特爵士帮助我改进了我的 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) 我还会在标题中添加符号，例如点形状=c(1,22);颜色=c（“黑色”，“红色”）；填充=c("红色", "黑色")。

我将如何做这些？我是 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 爵士所说，在我给他的原始电子邮件中，我已经有了关于组合图的图例。但是，在图形标题中，我需要说明图例中的那些符号是什么意思，以及情节的其他一些细节。根据巴蒂斯特爵士给出的示例，我需要在标题中包含 supp 的含义以及 OJ（黑圈）和 VC（黑三角）的符号。

再次，非常感谢！

Answer 1

基于 cmets，我建议以下策略：创建一个虚拟图，将您的图形标题（文本）作为图例标题，提取其图例，并将其放在 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 图形对文本不是特别好）。

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

下一步是添加一些方便的包装器来生成通用符号，并交错两个 grobs 列表。

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]])