问题
First of all I would like to thank Sir Baptiste for helping me improve my R script by adding a caption at the bottom left the of the combined plots using gtable/textGrob as shown below:
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)
However, I want to add two more things:
(1) Insert a scientific name to the caption, which should be written in italics. - For example, based on the caption mentioned above, I want to italize only the word "is" while the rest are in plain text.
(2) I will also add symbols in the caption, e.g. point shapes=c(1,22); colours=c("black", "red"); fill=c("red", "black").
How am I going to do these? I am a novice user of R program, hence your help is much appreciated. Thank you.
UPDATE:
I have already addressed query 1 with the help of @Docconcoct, @user20650 and @baptiste using this script:
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)
For query 2, as stated by Sir @baptiste, in my original email to him, I already have a legend on the combined plots. However, in the figure caption, I need to state what are those symbols in the legend mean, and some other details of the plot. Based on the example given by Sir baptiste, I need to include what supp means, as well as the symbols of OJ (dark circle) and VC (dark triangle) in the caption.
Again, many thanks!
回答1:
Based on the comments, I suggest the following strategy: create a dummy plot with your figure caption (text) as legend title, extract its legend, and place it at the bottom of your 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)
回答2:
I think a good solution would rely on LaTeX or similar for the text rendering and particularly the tricky issue of line-wrapping, but something could be designed at R level to facilitate the inclusion of plotting symbols that correspond to a given graphic. Something along those lines,
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}."
Interesting thought, but probably a lot of work to get it right.
A quick-and-dirty R graphics output could also be devised, though it's uncommon to want captions to be part of the figure (and R graphics isn't particularly good with text).
Here's a weak attempt at making a caption grob mixing symbols and text. Ideally the text would be split into individual words first (to offer more options for line breaks), but plotmath expressions make it inconvenient.
Next step would be to add a few convenient wrappers to generate common symbols, and to interleave the two lists of 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]])
来源：https://stackoverflow.com/questions/35936319/figure-caption-scientific-names-symbols-in-textgrob-gtable