如何将平滑曲线拟合到R中的数据？

我正试图在

R

中绘制一条平滑的曲线。我有以下简单的玩具数据：

> x
 [1]  1  2  3  4  5  6  7  8  9 10
> y
 [1]  2  4  6  8  7 12 14 16 18 20

现在，当我用标准命令绘制它时，它看起来很颠簸和前卫，当然：

> plot(x,y, type='l', lwd=2, col='red')

如何使曲线平滑，以便使用估计值对3条边进行圆角处理？我知道有很多方法可以拟合平滑曲线，但我不确定哪种方法最适合这种曲线，以及如何在

R

中编写它

我非常喜欢平滑：

x <- 1:10
y <- c(2,4,6,8,7,12,14,16,18,20)
lo <- loess(y~x)
plot(x,y)
lines(predict(lo), col='red', lwd=2)

---

正如德克所说，黄土是一种非常好的方法

另一种选择是使用贝塞尔样条曲线，在某些情况下，如果数据点不多，它可能比黄土更好

在这里，您可以找到一个示例：

#x，y：外壳点的x和y坐标
#n：曲线中的点数。
bezierCurve可能平滑。样条曲线是一个选项，您可以在此处设置平滑参数（通常介于0和1之间）

也可以在smooth.spline对象上使用“预测”。该函数随base R一起提供，请参阅
？详细信息请参见smooth.spline。
为了使其真正光滑

x <- 1:10
y <- c(2,4,6,8,7,8,14,16,18,20)
lo <- loess(y~x)
plot(x,y)
xl <- seq(min(x),max(x), (max(x) - min(x))/1000)
lines(xl, predict(lo,xl), col='red', lwd=2)

ggplot2包中的qplot（）函数使用非常简单，提供了一个包含置信区间的优雅解决方案。比如说,

qplot(x,y, geom='smooth', span =0.5)

产生
其他答案都是好方法。但是，R中还有一些其他选项尚未提及，包括
lowess
和
Abrox
，它们可能提供更好的拟合效果或更快的性能

使用备用数据集可以更容易地展示其优势：

sigmoid <- function(x)
{
  y<-1/(1+exp(-.15*(x-100)))
  return(y)
}

dat<-data.frame(x=rnorm(5000)*30+100)
dat$y<-as.numeric(as.logical(round(sigmoid(dat$x)+rnorm(5000)*.3,0)))

结果是：

plot(dat,col='gray')
curve(sigmoid,0,200,add=TRUE,col='blue',)
lines(lowessFit,col='red')
lines(loessFit,col='green')
lines(approxFit,col='purple')
legend(150,.6,
       legend=c("Sigmoid","Loess","Lowess",'Approx'),
       lty=c(1,1),
       lwd=c(2.5,2.5),col=c("blue","green","red","purple"))


如您所见，
lowess
生成了与原始生成曲线近乎完美的拟合
黄土
接近，但在两个尾部都出现了奇怪的偏差

虽然您的数据集会有很大的不同，但我发现其他数据集的性能类似，
leash
和
lowss
都能够产生良好的结果。当您查看基准时，差异变得更加显著：

> microbenchmark::microbenchmark(loess(y~x, dat, span = 0.6),approx(dat,n = 20),lowess(dat,f = .6,iter=1),times=20)
Unit: milliseconds
                           expr        min         lq       mean     median        uq        max neval cld
  loess(y ~ x, dat, span = 0.6) 153.034810 154.450750 156.794257 156.004357 159.23183 163.117746    20   c
            approx(dat, n = 20)   1.297685   1.346773   1.689133   1.441823   1.86018   4.281735    20 a  
 lowess(dat, f = 0.6, iter = 1)   9.637583  10.085613  11.270911  11.350722  12.33046  12.495343    20  b 

非常慢，大约需要100倍的时间
Lowess
比
approx
产生更好的结果，同时仍然运行得相当快（比Lowess快15倍）

黄土
随着点数的增加，也越来越陷入困境，在50000点左右变得无法使用

编辑：其他研究表明，
黄土
更适合某些数据集。如果处理小数据集或性能不是一个考虑因素，请尝试两个函数并比较结果。
在ggplot2中，可以通过多种方式进行平滑处理，例如：

library(ggplot2)
ggplot(mtcars, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = "gam", formula = y ~ poly(x, 2)) 
ggplot(mtcars, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = "loess", span = 0.3, se = FALSE) 


我没有看到显示此方法，因此如果其他人希望这样做，我发现ggplot文档建议使用
gam
方法，该方法在处理小数据集时产生类似于
gam
的结果

library(ggplot2)
x <- 1:10
y <- c(2,4,6,8,7,8,14,16,18,20)

df <- data.frame(x,y)
r <- ggplot(df, aes(x = x, y = y)) + geom_smooth(method = "gam", formula = y ~ s(x, bs = "cs"))+geom_point()
r

库（ggplot2）
它完全取决于你的数据是什么以及你为什么要平滑它！数据是否统计？密度？测量？可能存在哪种类型的测量误差？你想用图表告诉读者什么故事？所有这些问题都会影响是否以及如何平滑数据。这些都是测量数据。在x值为1、2、3、…、10时，一些系统产生2、4、6、…、20个错误。拟合算法可能不会改变这些坐标。但我想模拟缺失x值处的误差（y），例如在数据中，f（4）=8，f（5）=7，所以假设f（4.5）是7到8之间的某个值，使用多项式或其他平滑。在这种情况下，对于每个x值，有一个数据点，我根本不会平滑。我的测量数据点只有大点，用细线连接它们。其他任何东西都会向观众表明，你比你更了解你的数据。这个例子你可能是对的。知道怎么做很好，我以后可能想在其他一些数据上使用它，例如，如果你有数千个非常尖锐的数据点，这种数据点会上下波动，这是有意义的，但是有一个总的趋势，比如像这里这样向上：plot（seq（1100）+runif（100，0，10），type='l'）。这是一个好方法，如何将其应用于此数据？我不知道怎么做，因为它需要一个公式。谢谢正如我在示例中所示，当if
x
和
y
是可见变量时。如果它们是名为
foo
的data.frame的列，则向
less（y~x.data=foo）
调用添加一个
data=foo
选项——就像R.i中几乎所有其他建模函数一样，也像
supsmu（）
一样作为开箱即用的平滑如果x是一个日期参数，这会起什么作用？如果我用一个将日期映射到数字的数据表（使用
lo@Wichert-Akkerman）来尝试它，似乎大多数R函数都不喜欢日期格式。我通常会做一些类似new$date=as.numeric（new$date，as.date（“2015-01-01”），units=“days”）（如上所述）的操作来回避这个问题，但我发现报告R^2（或伪R^2）平滑拟合的值是可疑的。随着带宽的减少，平滑拟合的值必然会更接近数据。这可能会有帮助：嗯，我最终无法在R3.3.1中运行您的代码。我已成功安装
ggplot2
但无法运行
qplot
，因为它在Debian 8.5中找不到函数。是否可以使用此geom\u为进一步的过程而默思？
plot(dat,col='gray')
curve(sigmoid,0,200,add=TRUE,col='blue',)
lines(lowessFit,col='red')
lines(loessFit,col='green')
lines(approxFit,col='purple')
legend(150,.6,
       legend=c("Sigmoid","Loess","Lowess",'Approx'),
       lty=c(1,1),
       lwd=c(2.5,2.5),col=c("blue","green","red","purple"))

> microbenchmark::microbenchmark(loess(y~x, dat, span = 0.6),approx(dat,n = 20),lowess(dat,f = .6,iter=1),times=20)
Unit: milliseconds
                           expr        min         lq       mean     median        uq        max neval cld
  loess(y ~ x, dat, span = 0.6) 153.034810 154.450750 156.794257 156.004357 159.23183 163.117746    20   c
            approx(dat, n = 20)   1.297685   1.346773   1.689133   1.441823   1.86018   4.281735    20 a  
 lowess(dat, f = 0.6, iter = 1)   9.637583  10.085613  11.270911  11.350722  12.33046  12.495343    20  b 

library(ggplot2)
ggplot(mtcars, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = "gam", formula = y ~ poly(x, 2)) 
ggplot(mtcars, aes(wt, mpg)) + geom_point() +
  geom_smooth(method = "loess", span = 0.3, se = FALSE) 

library(ggplot2)
x <- 1:10
y <- c(2,4,6,8,7,8,14,16,18,20)

df <- data.frame(x,y)
r <- ggplot(df, aes(x = x, y = y)) + geom_smooth(method = "gam", formula = y ~ s(x, bs = "cs"))+geom_point()
r