多项式回归方程

Question

我正在尝试关联两个沉积物岩心，因为我在岩心中不同深度处具有不同的样本。我已经使用ggplot 2函数绘制了5阶多项式回归，并在图形上显示了等式和r2值。

我遇到的问题是方程本身，r2值正确，但是方程不正确。我认为这与lm_eq涉及线性回归有关，但我不太确定。

任何帮助或指导将不胜感激。我对图形本身很满意，但是任何有关如何清理代码的建议也将不胜感激。

我尝试过搜索其他函数来显示方程式，但没有找到解决方案。

long_data <- gather(Correlations, key = "Core", value = "Depth",
#Reshapes my data frame
                    LC1U, LC3U) 
df <- data.frame("x"=long_data$Sample, "y"=long_data$Depth)

lm_eqn = function(df){   m=lm(y ~ poly(x, 5), df)#3rd degree polynomial   eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2,
                   list(a = format(coef(m)[1], digits = 2),
                        b = format(coef(m)[2], digits = 2),
                        r2 = format(summary(m)$r.squared, digits = 4)))   as.character(as.expression(eq)) }

p1 <- ggplot(long_data, aes(x=Sample,y=Depth)) + geom_point(aes(color=Core)) +  
    labs(x ='Sample N.', y ='Depth (mm)', title = 'Core Correlation of Lake Nganoke') +  
    ylim(1,800) 

p1 + stat_smooth(method = "lm", formula = y~poly(x,5, raw = TRUE), size = 1) +    
    annotate("text", x = 0, y = 800, label = lm_eqn(df), hjust=0, family="Times", parse = TRUE) + #Add polynomial regression
    scale_y_continuous(trans = "reverse", breaks = c(0,100,200,300,400,500,600,700,800))

Answer 1

这是一个替代答案。我观察到绘图中多项式的端点显示的曲率不符合数据的形状（朗格现象），因此我从散点图中提取了数据并进行了方程搜索。我可以找到的最佳候选对象似乎是“ y = C /（1.0 + exp（（xA）/ B））+ D * exp（（xB）/ E）”，如下所示，Y轴以正常方式绘制。对于参数

A =  4.1190742945259711E+00
B = -6.4849391432073888E-01
C =  3.5527347656282654E+02
D =  1.7759549500121045E+02
E =  2.1295437650578787E+01

我获得R平方= 0.9604和RMSE = 36.37，请注意，方程式的绘制极值未显示多项式所示的曲率。如果这可能有用，则需要使用这些参数值的实际研究数据重新拟合，作为非线性求解器的初始参数估计。

Answer 2

您的问题是sort -n -t . -k 1,1 -k 2,2 -k 3,3 -k 4,4 filename or | to sort -n -t . -k 1,1 -k 2,2 -k 3,3 -k 4,4 经过定制以显示线性回归方程，即第一级的多项式。我已经对其进行了修改，以显示N次多项式的方程式。由于您尚未发布数据（将来您应该做的事情以及可能为什么您的问题最初被否决了），因此，我使用了lm_eqn中的cars数据集。

datasets

Answer 3

感谢Arienhood的帮助！原来，我在此序列中的数据没有遵循多项式趋势，但是会进一步使用此代码。 （以后肯定会发布我的数据集）

library(ggplot2)

lm_eqn <- function(df, degree, raw=TRUE){
  m <- lm(y ~ poly(x, degree, raw=raw), df)  
  cf <- round(coef(m), 2)  
  r2 <- round(summary(m)$r.squared, 4)  
  powers <- paste0("^", seq(length(cf)-1))  
  powers[1] <- ""  

  pcf <- paste0(ifelse(sign(cf[-1])==1, " + ", " - "), abs(cf[-1]),
                paste0("*italic(x)", powers), collapse = "")

  eq <- paste0("italic(y) == ", cf[1], pcf, "*','", "~italic(r)^2==", r2)
  eq
}

df <- data.frame("x"=Correlations$LC3U, "y"=Correlations$LC1U)

p2 <- ggplot(df, aes(x = x, y = y)) +
  geom_point() +
  labs(x ='LC3U', y ='LC1U', title = 'Core Correlation of Lake Nganoke') +
  stat_smooth(method = "lm", formula = y ~ poly(x, 1, raw = TRUE), size = 1) +
  annotate("text", x = 10, y = 10, label = lm_eqn(df, 1, raw = TRUE),
           hjust = 0, family = "Times", parse = TRUE) +
  scale_y_continuous(breaks = c(0,10,20,30,40,50,60,70,80)) +
  scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80))

p2