如何添加线以将回归线上的点连接到 ggplot 上的 x 和 y 轴？

Question

如何添加将回归方程连接到 x 轴上的特定点和 y 轴上的相应值的线？

这是一个可重现的示例：

library(ggplot2)
library(ggpmisc)

x<-c(1,2,3,5,10,12,15,20,22,25,30,33,37)

y<-c(1000,800,100,10,1,0.3,0.25,0.2,0.1,0.1,0.03,0.05,0.03)

myformula<-y ~ poly(x,3)

df <- data.frame(x, y)

ggplot(df, aes(x,y)) + 
  stat_smooth(method = lm, formula = myformula) + 
  geom_point() + 
  stat_smooth(method = lm, formula = myformula) +
  stat_poly_eq(formula = myformula, eq.with.lhs = "italic(psi)~`=`~",
               eq.x.rhs = "~italic(theta)", 
               aes(label = paste(..eq.label.., ..rr.label.., 
                                 sep = "~~~~")), label.x=0.15, parse = TRUE)+ 
  xlim(0, 40)+  
  ylim(0, 2000)+ 
  scale_y_log10(breaks = c(0, 0.1,10,1000), labels= c(0,0.1, 10,1000))

这就是我所拥有的：

这就是我想要的：

Answer 1

您首先要保存 plot 供以后使用，这里我将其保存到 object p中（我忽略了与您的问题无关的内容）。

p <- ggplot(df, aes(x,y)) + 
  stat_smooth(method = lm, formula = myformula) + 
  geom_point() + 
  xlim(0, 40) +  
  scale_y_log10(breaks = c(0, 0.1,10,1000), labels= c(0,0.1, 10,1000))

The ggplot2 package has a function ggplot_build() which allows you to observe all the makings of the plot.

plot_str <- ggplot_build(p)

创建的 object 是一个列表，其中包含一个data元素，它本身就是用于构建 plot 的每个几何图形的所有数据帧的列表。 在这里，我们对折线图感兴趣，它是该列表中的第二个数据框。

head(plot_str$data[[2]])
         x        y     ymin     ymax        se flipped_aes PANEL group  colour   fill size linetype weight alpha
1 1.000000 3.019354 2.645929 3.392780 0.1650750       FALSE     1    -1 #3366FF grey60    1        1      1   0.4
2 1.455696 2.796358 2.458116 3.134599 0.1495218       FALSE     1    -1 #3366FF grey60    1        1      1   0.4
3 1.911392 2.581749 2.273151 2.890348 0.1364177       FALSE     1    -1 #3366FF grey60    1        1      1   0.4
4 2.367089 2.375366 2.090702 2.660030 0.1258375       FALSE     1    -1 #3366FF grey60    1        1      1   0.4
5 2.822785 2.177044 1.910571 2.443518 0.1177963       FALSE     1    -1 #3366FF grey60    1        1      1   0.4
6 3.278481 1.986621 1.732776 2.240466 0.1122137       FALSE     1    -1 #3366FF grey60    1        1      1   0.4

现在我们可以抓住几点。 在这里，我抓住了第 5 行和第 70 行。

specific_points <- plot_str$data[[2]][c(5, 70), ]

然后回到 plot 的早期版本，我添加了一些参考这些点的段几何。

p + 
  geom_segment(y = specific_points$y[1], yend = specific_points$y[1], x = -Inf, xend = specific_points$x[1]) + 
  geom_segment(y = specific_points$y[1], yend = -Inf, x = specific_points$x[1], xend = specific_points$x[1], linetype = "dashed") + 
  geom_segment(y = specific_points$y[2], yend = specific_points$y[2], x = -Inf, xend = specific_points$x[2]) + 
  geom_segment(y = specific_points$y[2], yend = -Inf, x = specific_points$x[2], xend = specific_points$x[2], linetype = "dashed")

Answer 2

（我的答案还不太奏效，因为我还没有弄清楚如何复制 ggplot2 在适合折线之前所做的比例转换。我很想听听任何建议！）

我的方法是在 ggplot 之外拟合曲线，并使用这些结果来驱动注释。 下表显示了拟合折线上两点的坐标：

points <- c(4, 34)
lines <- data.frame(
  x = points,
  y = predict(lm(myformula), data.frame(x = points))
)
#lines
#   x       y
#1  4 370.537
#2 34  41.233

然后我们可以将它们输入geom_segment：

ggplot(df, aes(x,y)) + 
  stat_smooth(method = lm, formula = myformula) + 
  geom_point() + 
  stat_poly_eq(formula = myformula, eq.with.lhs = "italic(psi)~`=`~",
               eq.x.rhs = "~italic(theta)", 
               aes(label = paste(..eq.label.., ..rr.label.., 
                                 sep = "~~~~")), label.x=0.15, parse = TRUE)+ 
  geom_segment(data = lines, lty = "dashed",
               aes(x = x, xend = x, y = 0, yend = y)) +
  geom_segment(data = lines, lty = "dashed",
               aes(x = 0, xend = x, y = y, yend = y))

不幸的是，如果 y 被转换，这将不起作用，就像在原始问题中一样。 我了解到ggplot2 在适合 model 之前会转换比例，因此适合 ggplot2 使用的比例将与未转换的版本不同。

在这里我们看到添加scale_y_log10(breaks = c(0, 0.1,10,1000), labels= c(0,0.1, 10,1000))后的转换数据可以比未转换的数据更接近三次曲线, r^2 增加到 0.98。 但是，旧的线段将不再起作用，因为拟合已经改变。 由于我无法弄清楚，我将把适合的更正留给读者。