在 R 中绘制拟合数据和原始数据，拟合的 x 值密度更高

Question

我试着在这里搜索了一段时间，但没有真正找到解决问题的方法。我想要一种简单的方法来获得拟合模型的方程并将其与我的原始数据一起显示。

这是目前有效的代码：

#the dataframe:
library(ggplot2)
df<-data.frame(x=c(0,3,5,7,9,14),y=c(1.7,25.4,185.5,303.9,255.9,0.0))

#fitting a third degree polinomial model
fit1<- lm(y~poly(x, 3, raw=TRUE),data = df)

#plotting fitted and original values
ggplot(df, aes(x, y))+
  geom_point()+
  geom_line(aes(x, y=predict(fit1)), col=2)

以下绘图结果[红色=预测值，黑色=原始数据]：

现在，我试图更好地掌握模型与我的原始数据点相比的实际外观，因为我想稍后计算线下的面积。

我尝试通过调用

从 fit1 中提取系数

coef(fit1)

并在等式中输入近似系数

x1<-seq(0:14)
eq<- 20.35*x1+6.64*x1^2-0.58*x1^3-10.84

有没有更简单的方法 "extract" 模型中的 f(x) = x+x^2+c 等函数并以高密度显示它（0 到 14 之间的无限 x 值）与原始值一起？也许使用 geom_line() 或 stat_function()?

感谢任何建议！

Answer 1

关键不是预测你用来制作模型的数据，而是在相同的范围内生成更密集的数据：

x <- seq(from = min(df$x), to = max(df$x), by = 0.1)

完整代码如下：

library(ggplot2)
df <- data.frame(x = c(0, 3, 5, 7, 9, 14), y = c(1.7, 25.4, 185.5, 303.9, 255.9, 0.0))
fit1 <- lm(y ~ poly(x, 3, raw = TRUE), data = df)

生成密集数据：

predf <-  data.frame(x = seq(from = min(df$x), to = max(df$x), by = 0.1))

根据密集数据预测 y：

predf$y <- predict(fit1, predf)

剧情：

ggplot(df, aes(x, y))+
  geom_point()+
  geom_line(data= predf, aes(x, y  ), col=2)

Answer 2

对于那些感兴趣的人，我在这里找到了一些非常好的代码：提取函数并计算 AUC 并将其调整为此处的示例：

 #get the function from the model
poly3fnct <- function(x){
  (fnct <- fit1$coeff[1]+
     fit1$coeff[2]* x +
     fit1$coeff[3]* x^2 +
     fit1$coeff[4]* x^3) +
    return(fnct)
}

#function to find the roots
manyroots <- function(f,inter){
  roots <- array(NA, inter)
  for(i in 1:(length(inter)-1)){
    roots[i] <- tryCatch({
      return_value <- uniroot(f,c(inter[i],inter[i+1]))$root
    }, error = function(err) {
      return_value <- -1
    })
  }
  retroots <- roots[-which(roots==-1)]
  return(retroots)
}
#find the roots or x values for y = 0
roots <- manyroots(poly3fnct,seq(0,14))
roots

#integrate function
integrate(poly3fnct, roots[1],roots[2])

在 R 中绘制拟合数据和原始数据，拟合的 x 值密度更高

Plotting fitted and original data in R, with higher density of x values for fitted

r

ggplot2

lm