如何使用 annotation_custom() 在绘图区域的精确区域放置 grobs? [英] How to place grobs with annotation_custom() at precise areas of the plot region?
问题描述
我正在尝试使用 ggplot2
我已经解决了大部分问题，但目前让我感到困惑的是连接位于图右侧的边缘地毯图的线段的位置，并带有相应的标签.标签是通过 anotation_custom() 绘制的(在下面的第二张图中)，我使用了@baptiste 的关闭剪辑的技巧以允许在绘图边缘绘制.
I have managed most of this, but what is currently baffling me is the placement of the line segments that join the marginal rug plot on the right of the plot with the respective label. The labels have been draw (in the second figure below) via anotation_custom() and I have used @baptiste's trick of turning off clipping to allow drawing in the plot margin.
尽管进行了多次尝试，我还是无法将 segmentGrobs() 放置在设备中的所需位置，以便它们加入正确的地毯刻度和标签.
Despite many attempts I am unable to place segmentGrobs() at the desired locations in the device such that they join the correct rug tick and label.
一个可重复的例子是
y <- data.frame(matrix(runif(30*10), ncol = 10))
names(y) <- paste0("spp", 1:10)
treat <- gl(3, 10)
time <- factor(rep(1:10, 3))
require(vegan); require(grid); require(reshape2); require(ggplot2)
mod <- prc(y, treat, time)
如果你没有安装 vegan，我会在问题的末尾附加一个强化对象的 dput 和一个 fortify()code> 方法是否应该运行示例和 fortify() 以便使用 ggplot() 方便地绘图.我还包括了一个有点冗长的函数，myPlt()，它说明了我到目前为止所做的工作，如果你加载了包并且可以创建 mod，它可以用于示例数据集.
If you don't have vegan installed, I append a dput of the fortified object at the end of the Question and a fortify() method should you wish to run the example and fortify() for handy plotting with ggplot(). I also include a somewhat lengthy function, myPlt(), that illustrates what I have working so far, which can be used on the example data set if you have the packages loaded and can create mod.
我已经尝试了很多选择，但我现在似乎在正确放置线段方面不知所措.
I have tried quite a few options but I seem to be flailing in the dark now on getting the line segments placed correctly.
我不是在寻找为示例数据集绘制标签/段的特定问题的解决方案，而是一个通用的解决方案，我可以使用它以编程方式放置段和标签，因为这将构成<代码的基础class(mod) 对象的 >autoplot() 方法.我已经确定了标签，但不是线段.所以对于问题:
I am not looking for a solution to the specific issue of plotting the labels/segments for the example data set, but a generic solution that I can use to place segments and labels programatically as this will form the basis of an autoplot() method for objects of class(mod). I have the labels worked out OK, just not the line segments. So to the questions:
- 当我想放置一个段时，
xmin、xmax、ymin、ymax参数是如何使用的grob 包含一行从数据坐标x0,y0到x1,y1? - 也许换一种方式问，你如何使用
annotation_custom()在已知数据坐标x0之间的绘图区域外部绘制线段，y0tox1,y1?
- How are the
xmin,xmax,ymin,ymaxarguments used when I want to place a segment grob containing a line running from data coordx0,y0tox1,y1? - Perhaps asked a different way, how do you use
annotation_custom()to draw segments outside the plot region between known data coordsx0,y0tox1,y1?
我很高兴收到答案，这些答案只是在绘图区域中有任何旧绘图，但展示了如何在绘图边缘的已知坐标之间添加线段.
I would be happy to receive Answers that simply had any old plot in the plot region but showed how to add line segments between known coordinates in the margin of the plot.
我不喜欢使用 annotation_custom()，所以如果有更好的解决方案，我也会考虑.不过，我确实希望避免在绘图区域中使用标签；我想我可以通过使用 annotate() 并通过 expand 参数扩展比例尺中的 x 轴限制来实现这一点.
I'm not wedded to the use of annotation_custom() so if a better solution is available I'd consider that too. I do want to avoid having the labels in the plot region though; I think I can achieve that by using annotate() and extending the x-axis limits in the scale via the expand argument.
fortify.prc <- function(model, data, scaling = 3, axis = 1,
...) {
s <- summary(model, scaling = scaling, axis = axis)
b <- t(coef(s))
rs <- rownames(b)
cs <- colnames(b)
res <- melt(b)
names(res) <- c("Time", "Treatment", "Response")
n <- length(s$sp)
sampLab <- paste(res$Treatment, res$Time, sep = "-")
res <- rbind(res, cbind(Time = rep(NA, n),
Treatment = rep(NA, n),
Response = s$sp))
res$Score <- factor(c(rep("Sample", prod(dim(b))),
rep("Species", n)))
res$Label <- c(sampLab, names(s$sp))
res
}
dput()
这是fortify.prc(mod)的输出:
structure(list(Time = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA), Treatment = c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), Response = c(0.775222658013234,
-0.0374860102875694, 0.100620532505619, 0.17475403767196, -0.736181209242918,
1.18581913245908, -0.235457236665258, -0.494834646295896, -0.22096700738071,
-0.00852429328460645, 0.102286976108412, -0.116035743892094,
0.01054849999509, 0.429857364190398, -0.29619258318138, 0.394303081010858,
-0.456401545475929, 0.391960511587087, -0.218177702859661, -0.174814586471715,
0.424769871360028, -0.0771395073436865, 0.698662414019584, 0.695676522106077,
-0.31659375422071, -0.584947748238806, -0.523065304477453, -0.19259357510277,
-0.0786143714402391, -0.313283220381509), Score = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Sample",
"Species"), class = "factor"), Label = c("2-1", "2-2", "2-3",
"2-4", "2-5", "2-6", "2-7", "2-8", "2-9", "2-10", "3-1", "3-2",
"3-3", "3-4", "3-5", "3-6", "3-7", "3-8", "3-9", "3-10", "spp1",
"spp2", "spp3", "spp4", "spp5", "spp6", "spp7", "spp8", "spp9",
"spp10")), .Names = c("Time", "Treatment", "Response", "Score",
"Label"), row.names = c("1", "2", "3", "4", "5", "6", "7", "8",
"9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19",
"20", "spp1", "spp2", "spp3", "spp4", "spp5", "spp6", "spp7",
"spp8", "spp9", "spp10"), class = "data.frame")
我尝试过的:
myPlt <- function(x, air = 1.1) {
## fortify PRC model
fx <- fortify(x)
## samples and species scores
sampScr <- fx[fx$Score == "Sample", ]
sppScr <- fx[fx$Score != "Sample", ]
ord <- order(sppScr$Response)
sppScr <- sppScr[ord, ]
## base plot
plt <- ggplot(data = sampScr,
aes(x = Time, y = Response,
colour = Treatment, group = Treatment),
subset = Score == "Sample")
plt <- plt + geom_line() + # add lines
geom_rug(sides = "r", data = sppScr) ## add rug
## species labels
sppLab <- sppScr[, "Label"]
## label grobs
tg <- lapply(sppLab, textGrob, just = "left")
## label grob widths
wd <- sapply(tg, function(x) convertWidth(grobWidth(x), "cm",
valueOnly = TRUE))
mwd <- max(wd) ## largest label
## add some space to the margin, move legend etc
plt <- plt +
theme(plot.margin = unit(c(0, mwd + 1, 0, 0), "cm"),
legend.position = "top",
legend.direction = "horizontal",
legend.key.width = unit(0.1, "npc"))
## annotate locations
## - Xloc = new x coord for label
## - Xloc2 = location at edge of plot region where rug ticks met plot box
Xloc <- max(fx$Time, na.rm = TRUE) +
(2 * (0.04 * diff(range(fx$Time, na.rm = TRUE))))
Xloc2 <- max(fx$Time, na.rm = TRUE) +
(0.04 * diff(range(fx$Time, na.rm = TRUE)))
## Yloc - where to position the labels in y coordinates
yran <- max(sampScr$Response, na.rm = TRUE) -
min(sampScr$Response, na.rm = TRUE)
## This is taken from vegan:::linestack
## attempting to space the labels out in the y-axis direction
ht <- 2 * (air * (sapply(sppLab,
function(x) convertHeight(stringHeight(x),
"npc", valueOnly = TRUE)) *
yran))
n <- length(sppLab)
pos <- numeric(n)
mid <- (n + 1) %/% 2
pos[mid] <- sppScr$Response[mid]
if (n > 1) {
for (i in (mid + 1):n) {
pos[i] <- max(sppScr$Response[i], pos[i - 1] + ht[i])
}
}
if (n > 2) {
for (i in (mid - 1):1) {
pos[i] <- min(sppScr$Response[i], pos[i + 1] - ht[i])
}
}
## pos now contains the y-axis locations for the labels, spread out
## Loop over label and add textGrob and segmentsGrob for each one
for (i in seq_along(wd)) {
plt <- plt + annotation_custom(tg[[i]],
xmin = Xloc,
xmax = Xloc,
ymin = pos[i],
ymax = pos[i])
seg <- segmentsGrob(Xloc2, pos[i], Xloc, pos[i])
## here is problem - what to use for ymin, ymax, xmin, xmax??
plt <- plt + annotation_custom(seg,
## xmin = Xloc2,
## xmax = Xloc,
## ymin = pos[i],
## ymax = pos[i])
xmin = Xloc2,
xmax = Xloc,
ymin = min(pos[i], sppScr$Response[i]),
ymax = max(pos[i], sppScr$Response[i]))
}
## Build the plot
p2 <- ggplot_gtable(ggplot_build(plt))
## turn off clipping
p2$layout$clip[p2$layout$name=="panel"] <- "off"
## draw plot
grid.draw(p2)
}
图基于我在 myPlt()
中的尝试这是我使用上面的 myPlt() 所做的.请注意通过标签绘制的小水平刻度线 - 这些应该是上面第一张图中的倾斜线段.
Figure based on what I have tried in myPlt()
This is as far as I have made it with myPlt() from above. Note the small horizontal ticks drawn through the labels - these should be the angled line segments in the first figure above.
推荐答案
也许这个可以说明annotation_custom,
myGrob <- grobTree(rectGrob(gp=gpar(fill="red", alpha=0.5)),
segmentsGrob(x0=0, x1=1, y0=0, y1=1, default.units="npc"))
myGrob2 <- grobTree(rectGrob(gp=gpar(fill="blue", alpha=0.5)),
segmentsGrob(x0=0, x1=1, y0=0, y1=1, default.units="npc"))
p <- qplot(1:10, 1:10) + theme(plot.margin=unit(c(0, 3, 0, 0), "cm")) +
annotation_custom(myGrob, xmin=5, xmax=6, ymin=3.5, ymax=5.5) +
annotate("segment", x=5, xend=6, y=3, yend=5, colour="red") +
annotation_custom(myGrob2, xmin=8, xmax=12, ymin=3.5, ymax=5.5)
p
g <- ggplotGrob(p)
g$layout$clip[g$layout$name=="panel"] <- "off"
grid.draw(g)
显然有一个奇怪的错误，如果我重用 myGrob 而不是 myGrob2，它第二次忽略放置坐标并将其与第一层叠加.这个功能真的有问题.
There's a weird bug apparently, whereby if I reuse myGrob instead of myGrob2, it ignores the placement coordinates the second time and stacks it up with the first layer. This function is really buggy.
这篇关于如何使用 annotation_custom() 在绘图区域的精确区域放置 grobs?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
