如何在绘图区域的精确区域放置带有annotation_custom（）的grobs？

Question

我试图用 ggplot2

重现以下[基础R]图

我已经管理了大部分内容，但目前让我感到困惑的是将线段放置在图表右侧与相应标签相连的边缘地毯图上。标签已经通过anotation_custom()绘制（在下面的第二个图中），并且我使用了@ baptiste的关闭剪裁的技巧，允许在绘图边缘绘图。

尽管经过多次尝试，我仍无法将segmentGrobs()放置在设备中的所需位置，以便他们加入正确的地毯标记和标签。

可重现的例子是

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)

如果您没有安装素食主义者，我会在问题末尾添加dput强化对象，如果您希望运行fortify()方法示例和fortify()用于ggplot()的方便绘图。我还包括一个有点冗长的函数myPlt()，它说明了我到目前为止所做的工作，如果你加载了包并且可以创建mod，它可以用在示例数据集上。

我已经尝试了很多选项，但我现在似乎在黑暗中挣扎着正确放置线段。

我不是在寻找绘制示例数据集的标签/段的具体问题的解决方案，而是我可以用来以编程方式放置段和标签的通用解决方案，因为这将构成{{的基础1}} autoplot()对象的方法。我有标签制定好了，不是线段。所以对于问题：

1. 当我想放置一个包含从数据坐标{{1}运行的行的段grob时，如何使用class(mod)，xmin，xmax，ymin参数}，ymax到x0，y0？
2. 或许以不同的方式询问，您如何使用x1在已知数据坐标y1，annotation_custom()到{{}之间的绘图区域之外绘制细分1}}，x0？

我很乐意收到简单地在情节区域中有任何旧情节的答案，但展示了如何在情节边缘的已知坐标之间添加线段。

我并不拘泥于y0的使用，所以如果有更好的解决方案，我也会考虑这个问题。我确实希望避免在情节区域中有标签;我想我可以通过使用x1并通过y1参数扩展比例中的x轴限制来实现这一点。

annotation_custom()方法

annotate()

expand

这是fortify()的输出：

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") 所做的而言。注意通过标签绘制的小水平刻度 - 这些应该是上面第一个图中的有角度的线段。

Answer 1

以下是我将如何处理这个问题，

library(gtable)
library(ggplot2)
library(plyr)

set.seed(1)
d <- data.frame(x=rep(1:10, 5),
                y=rnorm(50),
                g = gl(5,10))

# example plot
p <- ggplot(d, aes(x,y,colour=g)) +
  geom_line() +
  scale_x_continuous(expand=c(0,0))+
  theme(legend.position="top",
        plot.margin=unit(c(1,0,0,0),"line"))

# dummy data for the legend plot
# built with the same y axis (same limits, same expand factor)
d2 <- ddply(d, "g", summarise, x=0, y=y[length(y)])
d2$lab <- paste0("line #", seq_len(nrow(d2)))

plegend <- ggplot(d, aes(x,y, colour=g)) +
  geom_blank() +
  geom_segment(data=d2, aes(x=2, xend=0, y=y, yend=y), 
               arrow=arrow(length=unit(2,"mm"), type="closed")) +
  geom_text(data=d2, aes(x=2.5,label=lab), hjust=0) +
  scale_x_continuous(expand=c(0,0)) +
  guides(colour="none")+
  theme_minimal() + theme(line=element_blank(),
                          text=element_blank(),
                          panel.background=element_rect(fill="grey95", linetype=2))

# extract the panel only, we don't need the rest
gl <- gtable_filter(ggplotGrob(plegend), "panel")

# add a cell next to the main plot panel, and insert gl there
g <- ggplotGrob(p)
index <- subset(g$layout, name == "panel")
g <- gtable_add_cols(g, unit(1, "strwidth", "line # 1") + unit(1, "cm"))
g <- gtable_add_grob(g, gl, t = index$t, l=ncol(g), 
                     b=index$b, r=ncol(g))
grid.newpage()
grid.draw(g)

应该直截了当地使用特定的标签和位置调整“图例”图（左侧作为感兴趣的读者的练习）。

Answer 2

也许这可以说明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，它会第二次忽略放置坐标并将其与第一层叠加。这个功能真的很麻烦。