r - 在使用 geom_abline 创建的线之间绘制带状图

Question

我正在尝试在使用geom_abline创建的线条之间创建阴影区域

require(ggplot2)

val_intcpt <- c(-1,1)

ggplot() + 
  geom_point(data = iris, mapping = aes(x = Petal.Length, y = Sepal.Width)) +
  geom_abline(intercept = 0, slope = 1, linetype = 'dashed') +
  geom_abline(intercept = val_intcpt, slope = 1, linetype = 'dotted') 

这个想法是对虚线之间的区域进行阴影处理。

• geom_ribbon 不起作用，因为它需要 ymin/ymax 而我没有此信息(当然，我可以硬编码一个数据框，但这是这不完全是一个很好的解决方案，因为它不会自动适用于任何给定的数据。)
• 使用 ggplot_build 没有帮助，因为数据框不提供 x/y 数据。

我确信我错过了一些非常明显的东西:(

Answer 1

也许可以绘制一个多边形？

# let ss be the slope for geom_abline
ss <- 1

p <- ggplot() + 
  geom_point(data = iris, mapping = aes(x = Petal.Length, y = Sepal.Width)) +
  geom_abline(intercept = 0, slope = ss, linetype = 'dashed') +
  geom_abline(intercept = val_intcpt, slope = ss, linetype = 'dotted') 

# get plot limits
p.x <- layer_scales(p)$x$get_limits()
p.y <- layer_scales(p)$y$get_limits()

# create polygon coordinates, setting x positions somewhere
# beyond the current plot limits
df <- data.frame(
  x = rep(c(p.x[1] - (p.x[2] - p.x[1]),
            p.x[2] + (p.x[2] - p.x[1])), each = 2),
  intcpt = c(val_intcpt, rev(val_intcpt))
) %>%
  mutate(y = intcpt + ss * x)

# add polygon layer, & constrain to previous plot limits
p +
  annotate(geom = "polygon",
           x = df$x,
           y = df$y,
           alpha = 0.2) +
  coord_cartesian(xlim = p.x, ylim = p.y)

解释其工作原理

让我们考虑一个正常的情节:

ss <- 0.75 # this doubles up as illustration for different slope values

p <- ggplot() +
  geom_point(data = iris, aes(x = Petal.Length, y = Sepal.Width), color = "grey75") +
  geom_abline(intercept = val_intcpt, slope = ss, linetype = 'dashed', 
              color = c("blue", "red"), size = 1) +
  annotate(geom = "text", x = c(6, 3), y = c(2.3, 4), color = c("blue", "red"), size = 4,
           label = c("y == a[1] + b*x", "y == a[2] + b*x"), parse = TRUE)
  coord_fixed(ratio = 1.5) +
  theme_classic()

p + ggtitle("Step 0: Construct plot")

获取限制 p.x/p.y来自p ，&看看绘图本身中的相应​​位置(紫色):

p.x <- layer_scales(p)$x$get_limits()
p.y <- layer_scales(p)$y$get_limits()

p1 <- p + 
  geom_point(data = data.frame(x = p.x, y = p.y) %>% tidyr::complete(x, y),
             aes(x = x, y = y), 
             size = 2, stroke = 1, color = "purple")

p1 + ggtitle("Step 1: Get plot limits")

记下 x 轴限制的值(仍为紫色):

p2 <- p1 +
  annotate(geom = "text", x = p.x, y = min(p.y), label = c("x[0]", "x[1]"), 
           vjust = -1, parse = TRUE, color = "purple", size = 4)

p2 + 
  ggtitle("Step 2: Note x-axis coordinates of limits") +
  annotate(geom = "segment", 
           x = p.x[1] + diff(p.x), 
           xend = p.x[2] - diff(p.x), 
           y = min(p.y), yend = min(p.y),
           color = "purple", linetype = "dashed", size = 1,
           arrow = arrow(ends = "both")) +
  annotate(geom = "text", x = mean(p.x), y = min(p.y), label = "x[1] - x[0]",
           vjust = -1, parse = TRUE, color = "purple", size = 4)

我们想要构造一个多边形(准确地说是平行四边形)，其角点远远超出原始绘图的范围，以便在绘图中看不到任何角点。实现此目的的一种方法是采用现有图的 x 轴限制并将其向外移动与现有图的 x 轴范围相同的量:结果位置(黑色)相当远:

p3 <- p2 +
  annotate(geom = "point", 
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)), y = min(p.y),
           shape = 4, size = 1, stroke = 2) +
  annotate(geom = "text", 
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)), y = min(p.y),
           label = c("x[0] - (x[1] - x[0])", "x[1] + (x[1] - x[0])"),
           vjust = -1, parse = TRUE, size = 5, hjust = c(0, 1))

p3 +
  ggtitle("Calculate x-axis coordinates of two points far beyond the limits") +
  annotate(geom = "segment", 
           x = p.x, 
           xend = p.x + c(-diff(p.x), diff(p.x)), 
           y = min(p.y), yend = min(p.y),
           linetype = "dashed", size = 0.5,
           arrow = arrow(ends = "both", length = unit(0.1, "inches"))) 

对于每个 geom_abline，我们可以导出与 x 轴位置相关的相应 y 值。 (红色/蓝色)，使用标准y = a + b * x公式:

p4 <- p3 + 
  annotate(geom = "point",
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           y = val_intcpt[2] + ss * c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           shape = 8, size = 2, stroke = 2, col = "red") + 
  annotate(geom = "point",
           x = c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           y = val_intcpt[1] + ss * c(p.x[1] - diff(p.x), p.x[2] + diff(p.x)),
           shape = 8, size = 2, stroke = 2, col = "blue")

p4 +
  ggtitle("Calculate the corresponding y coordinates for both ab-lines") +
  annotate(geom = "text",
           x = p.x[1] - diff(p.x),
           y = val_intcpt + ss * (p.x[1] - diff(p.x)),
           label = c("y == a[1] + b * (x[0] - (x[1] - x[0]))", 
                     "y == a[2] + b * (x[0] - (x[1] - x[0]))"), 
           hjust = -0.2, parse = TRUE, 
           color = c("blue", "red")) +
  annotate(geom = "text",
           x = p.x[2] + diff(p.x),
           y = val_intcpt + ss * (p.x[2] + diff(p.x)),
           label = c("y == a[1] + b * (x[1] + (x[1] - x[0]))", 
                     "y == a[2] + b * (x[1] + (x[1] - x[0]))"), 
           hjust = 1.2, parse = TRUE, 
           color = c("blue", "red"))

现在我们有了角点的 x/y 坐标，构造多边形只需将它们连接在一起即可:

p5 <- p4 +
  annotate(geom = "polygon",
           x = rep(c(p.x[1] - diff(p.x),
                     p.x[2] + diff(p.x)),
                   each = 2),
           y = c(val_intcpt + ss * (p.x[1] - diff(p.x)),
                 rev(val_intcpt) + ss * (p.x[2] + diff(p.x))),
           fill = "yellow", alpha = 0.4)

p5 +
  ggtitle("Step 5: Draw polygon based on calculated coordinates") +
  annotate(geom = "label",
           x = rep(c(p.x[1] - diff(p.x),
                     p.x[2] + diff(p.x)),
                   each = 2),
           y = c(val_intcpt + ss * (p.x[1] - diff(p.x)),
                 rev(val_intcpt) + ss * (p.x[2] + diff(p.x))),
           label = c("list(x[0] - (x[1] - x[0]), a[1] + b*(x[0] - (x[1] - x[0])))",
                     "list(x[0] - (x[1] - x[0]), a[2] + b*(x[0] - (x[1] - x[0])))",
                     "list(x[1] + (x[1] - x[0]), a[2] + b*(x[1] + (x[1] - x[0])))",
                     "list(x[1] + (x[1] - x[0]), a[1] + b*(x[1] + (x[1] - x[0])))"),
           parse = TRUE, hjust = rep(c(0, 1), each = 2))

应用原始绘图范围，我们有一个假装是填充丝带的多边形，其角安全地隐藏在视野之外:

p5 +
  ggtitle("Step 6: Reset plot range to original range") +
  coord_fixed(ratio = 1.5, xlim = p.x, ylim = p.y) 

(注意:这里有很多不必要的代码，用于标记和着色中间步骤以用于说明目的。对于实际使用，根据我原来的解决方案，这些都不是必需的。但就解释而言，要么是这个或者用我蹩脚的笔迹素描+扫描...)