'如何使用 ggplot 绘制多项式线和方程，然后将它们组合成一个图'

Question

我试图在一个绘图上比较和对比具有相似 x 轴的四个关系之间的差异。

我似乎可以绘制回归线，但不知道如何绘制方程和/或将所有四个图合并为一个。

这是我的代码的基本基础：对不起，如果它非常基础或笨拙，我才刚刚开始。

library(ggplot2)
library(cowplot)

p1 <- ggplot(NganokeData, aes(x=Depth,y=LCU1)) + geom_point() + 
  labs(x ='Depths (cm)', y ='Density (Hu)', title = 'Density Regression of Lake Nganoke Core 1') +
  ylim(1,2)

p2 <- ggplot(NganokeData, aes(x=Depth,y=LCU2)) + geom_point() + 
  labs(x ='Depths (cm)', y ='Density (Hu)', title = 'Density Regression of Lake Nganoke Core 2') +
  ylim(1,2)

p3 <- ggplot(NganokeData, aes(x=Depth,y=LCU3)) + geom_point() + 
  labs(x ='Depths (cm)', y ='Density (Hu)', title = 'Density Regression of Lake Nganoke Core 3') +
  ylim(1,2)

p4 <- ggplot(NganokeData, aes(x=Depth,y=LCU4)) + geom_point() + 
  labs(x ='Depths (cm)', y ='Density (Hu)', title = 'Density Regression of Lake Nganoke Core 4') +
  ylim(1,2)

p3 + stat_smooth(method = "lm", formula = y ~ poly(x, 3), size = 1) #Adds polynomial regression

Picture of my code

Answer 1

您的列名中似乎有一个感兴趣的变量（LCU1、LCU2、LCU3、LCU4）。您可以使用 tidyr 包中的 gather 来重塑数据框：

library(tidyr)
long_data <- gather(NganokeData, key = "core", value = "density",
                    LCU1, LCU2, LCU3, LCU4)

然后使用 ggplot2 包中的 facet_grid 将您的情节划分为您正在寻找的四个方面。

p <- ggplot(long_data, aes(x=Depth,y=density)) + 
          geom_point() + 
          labs(x ='Depths (cm)', y ='Density (Hu)', 
               title = 'Density Regression of Lake Nganoke Cores') +
     ylim(1,2) +
     facet_grid(rows = vars(core)) #can also use cols instead

p + stat_smooth(method = "lm", formula = y ~ poly(x, 3), size = 1)

您的代码很棒。但作为初学者，我强烈建议您花几分钟时间阅读并学习使用 tidyr 包，因为 ggplot2 是建立在 tidy 数据的概念之上的，如果您可以操作在尝试绘制之前将数据框转换为您需要的格式。

https://tidyr.tidyverse.org/index.html

编辑：

要添加详细说明回归方程的注释，我发现代码取自 Jodie Burchell 的这篇博文：

http://t-redactyl.io/blog/2016/05/creating-plots-in-r-using-ggplot2-part-11-linear-regression-plots.html

不过，首先，使用公式中的 poly 函数收集可显示的回归方程是不可能的。正交多项式的优点是它们避免了共线性，但缺点是您不再有一个易于解释的回归方程，其中 x 和 x 平方和 x 立方作为回归量。

所以我们必须将 lm 拟合公式更改为

y ~ poly(x, 3, raw = TRUE)

这将拟合原始多项式并为您提供您正在寻找的回归方程。

您将不得不更改 x 和 y 位置值以确定在图表上放置注释的位置，因为我没有您的数据，但这是您需要的自定义函数：

equation = function(x) {
  lm_coef <- list(a = round(coef(x)[1], digits = 2),
                  b = round(coef(x)[2], digits = 2),
                  c = round(coef(x)[3], digits = 2),
                  d = round(coef(x)[4], digits = 2),
                  r2 = round(summary(x)$r.squared, digits = 2));
  lm_eq <- substitute(italic(y) == a + b %.% italic(x) + c %.% italic(x)^2 + d %.% italic(x)^3*","~~italic(R)^2~"="~r2,lm_coef)
  as.character(as.expression(lm_eq));                 
}

然后只需将注释添加到您的绘图中，根据需要调整 x 和 y 参数，您将被设置：

p + 
    stat_smooth(method = "lm", formula = y ~ poly(x, 3, raw = TRUE), size = 1) +
    annotate("text", x = 1, y = 10, label = equation(fit), parse = TRUE)