如何在剧情区域的精确区域放置带有annotation_custom（）的grobs？ [英] How to place grobs with annotation_custom() at precise areas of the plot region?
问题描述
我试图用 ggplot2
anotation_custom（）绘制（在下面的第二张图中），并且我已经使用了@ baptiste关闭剪辑的技巧来允许绘制绘图边距。 p>
尽管进行了很多尝试，但我无法在设备中的所需位置放置 segmentGrobs（），以便它们加入正确
一个可重现的例子是
y< ; - data.frame（矩阵（runif（30 * 10），ncol = 10））
名称（y）< - paste0（spp，1:10）
< - gl （3,10）
时间< - 因子（代表（1:10，3））
要求（素食主义者）;要求（网格）;要求（reshape2）; require（ggplot2）
mod < - prc（y，treat，time）
如果你没有安装素食，我在课题末尾添加了一个 dput 的强化对象，并在使用 ggplot（）方便绘图的fortify（）方法以及 fortify（） code>。我还包含一个比较冗长的函数， myPlt（），它说明了我目前为止所做的工作，如果您已经加载了包，可以在示例数据集上使用它，可以创建 mod 。
我已经尝试了很多选项，但现在我似乎在黑暗中闪现将线段正确放置。
我没有找到针对示例数据集的标签/线段绘制特定问题的解决方案，而是一种通用解决方案我可以用编程方式放置段和标签，因为这将构成 class（mod）的对象的 autoplot（）方法的基础。 C $ C>。我确定了标签，只是不是线段。所以对于这些问题：
-
xmin，xmax，ymin，ymax当我想放置段grob时使用的参数从数据坐标x0，y0到x1，y1？ - 也许以不同的方式提出问题，您如何使用
annotation_custom（）在<外部绘制已知数据坐标x0，y0至x1，y1？
我会很高兴收到答案，它只是在绘图区域中有任何旧的绘图，但显示了如何在绘图边缘的已知坐标之间添加线段。
我不会使用 annotation_custom（），所以如果有更好的解决方案可用，我也会考虑这一点。我确实希望避免在剧情区域有标签;我想我可以通过使用 annotate（）并通过扩展来扩展比例尺的x轴限制。参数。
$ b
fortify（）方法
fortify.prc< - 函数（模型，数据，缩放= 3，轴= 1，
...）{
s< - 摘要=缩放，轴=轴）
b <-t（coef（s））
rs < - rownames（b）
cs < - colnames（b）
res < - 熔化（b）
名称（res）< -c（时间，治疗，响应）
n < - 长度（s $ sp）
sampLab < - 粘贴（res $ Treatment，res $ Time，sep = - ）
res < - rbind（res，cbind（Time = rep（NA，n），
Treatment = rep NA，n），
Response = s $ sp））
res $得分< - 因子（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），处理= 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），响应= 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.523065304477 453，-0.19259357510277，
-0.0786143714402391，-0.313283220381509），得分=结构（c（1L，1 b， 1L，1L，1L，1L，1L，
1L，1L，1L，2L，2L，2L，2L，2L，2L，2L，2L，2L，2L），标签= 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 171819
20spp1 spp2 spp3 spp4 spp5 spp6 spp7
spp8，spp9，spp10），class =data.frame）
我试过的：
myPlt < - function（x，air = 1.1）{
##加强PRC模型
fx < - 强化（x）
##采样和物种分数
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，
color = Treatment，group = Treatment），
subset = Score ==Sample ）
plt< - plt + geom_line（）+＃添加行
geom_rug（sides =r，data = sppScr）## add rug
## species labels
sppLab < - sppScr [，Label]
##标签grobs
tg < - lapply（sppLab，textGrob，just =left）
##标签grob宽度
wd < - sapply（tg，function（x）convertWidth（grobWidth（x），cm，
valueOnly = TRUE））
mwd < - max（wd）## maximum标签
##添加一些空间（c（0，mwd + 1,0,0），cm），$ b $（单位b legend.position =top，
legend.direction =horizontal，
legend.key.width = unit（0.1，npc））
##注释位置
## - Xloc = new x coord for label
## - Xloc2 = rug ticks遇到的绘图区边缘的位置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 - 将标签放置在y坐标中的位置
yran< - max （sampScr $ Response，na.rm = TRUE） -
min（sampScr $ Response，na.rm = TRUE）
##这是从素食主义者::: linestack
##尝试将标签沿y轴方向排出
ht < - 2 *（air *（sapply（sppLab，
）函数（x）convertHeight（stringHeight（x），
npc，valueOnly = TRUE））*
yran））
n < - length（sppLab）
pos< - 数字（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 ; - min（sppScr $ Response [i]，pos [i + 1] - ht [i]）
}
}
## pos现在包含标签的y轴位置，展开
##在标签上循环并为每个
添加textGrob和segmentsGrob（在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]）
##这里有问题 - ymin，ymax，xmin，xmax使用什么？
plt< - plt + annotation_custom（seg，
## xmin = Xloc2，
## xmax = Xloc，
## ymin = pos [i]，$ b $
xmin = Xloc2，
xmax = Xloc，
ymin = min（pos [i]，sppScr $ Response [i]），
$ max $（pos [i]，sppScr $ Response [i]））
}
##建立绘图
p2 < - ggplot_gtable（ggplot_build（plt））
##关闭剪辑
p2 $ layout $ clip [p2 $ layout $ name ==panel]< - off
## draw plot
grid.draw（p2 ）
}
myPlt < - function（x，air = 1.1）{
##加强PRC模型
fx < - 强化（x）
##采样和物种分数
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，
color = Treatment，group = Treatment），
subset = Score ==Sample ）
plt< - plt + geom_line（）+＃添加行
geom_rug（sides =r，data = sppScr）## add rug
## species labels
sppLab < - sppScr [，Label]
##标签grobs
tg < - lapply（sppLab，textGrob，just =left）
##标签grob宽度
wd < - sapply（tg，function（x）convertWidth（grobWidth（x），cm，
valueOnly = TRUE））
mwd < - max（wd）## maximum标签
##添加一些空间（c（0，mwd + 1,0,0），cm），$ b $（单位b legend.position =top，
legend.direction =horizontal，
legend.key.width = unit（0.1，npc））
##注释位置
## - Xloc = new x coord for label
## - Xloc2 = rug ticks遇到的绘图区边缘的位置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 - 将标签放置在y坐标中的位置
yran< - max （sampScr $ Response，na.rm = TRUE） -
min（sampScr $ Response，na.rm = TRUE）
##这是从素食主义者::: linestack
##尝试将标签沿y轴方向排出
ht < - 2 *（air *（sapply（sppLab，
）函数（x）convertHeight（stringHeight（x），
npc，valueOnly = TRUE））*
yran））
n < - length（sppLab）
pos< - 数字（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 ; - min（sppScr $ Response [i]，pos [i + 1] - ht [i]）
}
}
## pos现在包含标签的y轴位置，展开
##在标签上循环并为每个
添加textGrob和segmentsGrob（在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]）
##这里有问题 - ymin，ymax，xmin，xmax使用什么？
plt< - plt + annotation_custom（seg，
## xmin = Xloc2，
## xmax = Xloc，
## ymin = pos [i]，$ b $
xmin = Xloc2，
xmax = Xloc，
ymin = min（pos [i]，sppScr $ Response [i]），
$ max $（pos [i]，sppScr $ Response [i]））
}
##建立绘图
p2 < - ggplot_gtable（ggplot_build（plt））
##关闭剪辑
p2 $ layout $ clip [p2 $ layout $ name ==panel]< - off
## draw plot
grid.draw（p2 ）
}
基于我在 myPlt （）
这就是我用 myPlt（）从上面。请注意通过标签绘制的小水平滴答 - 这些应该是上面第一张图中的有角线段。
也许这可以说明 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 = ））
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）+
注释（segment，x = 5，xend = 6，y = 3，yend = 5，color =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 code>，它会第二次忽略放置坐标，并将其与第一层堆叠起来。这个功能真的很麻烦。
I am trying to reproduce the following [base R] plot with ggplot2
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.
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.
A reproducible example is
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)
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.
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:
- 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.
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.
The fortify() method
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
}
The dput()
This is the output from 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")
What I've tried:
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)
}
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.
Maybe this can illustrate 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)
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屋！
