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

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)我还会在标题中添加符号，例如shapes=c(1，22)点；colours=c(“黑色”，“红色”)；fill=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，正如Sir @baptiste在我给他的原始电子邮件中所说的那样，我已经有了关于组合图的图例。然而，在图的标题中，我需要说明图例中的符号是什么意思，以及一些其他细节的情节。根据baptiste爵士给出的例子，我需要在标题中包括supp的意思，以及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图形对于文本并不是特别好)。

这里是一个混合符号和文本的标题grob的弱尝试。理想情况下，文本应该首先拆分成单独的单词(以便提供更多的换行选项)，但是split数学表达式会使其不方便。

​

​

下一步是添加一些方便的包装器来生成公共符号，并交错两个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]])