`smooth.spline`严重影响长(周期)时间序列

时间:2016-10-26 21:55:02

标签: r time-series regression spline smoothing

我想在R中平滑非常长的噪声数据但是我发现对于高度周期性的数据,开箱即用的smooth.spline()很快就会崩溃,平滑的数据开始出现振铃

考虑余弦时间序列(有无噪声)

t <- seq(0,100*2*pi,length.out=3000)
y <- cos(t)# + rnorm(length(t), 0,0.05)

y100_s <- smooth.spline(y)$y

plot( y~t, type="l" )
lines( y100_s~t, col="blue" )

我们可以检查向smooth.spline()添加更多值的效果,

# rms increases as points are added to smooth.spline
rms <- sapply( seq(250,3000,by=250), function(i)
  sqrt( mean( (y[1:i] - smooth.spline(y[1:i])$y)^2 )) )

plot(rms)

即使在较低频率下,配合也会响铃(可选)。

t <- seq(0,50*2*pi,length.out=3000)
y <- cos(t)# + rnorm(length(t), 0,0.05)

y50_s <- smooth.spline(y)$y

require(pracma)

peaks <- list(findpeaks(y50_s),findpeaks(-y50_s))

plot( y~t, type="l" )
lines( y50_s~t, col="red" )

lines( peaks[[1]][,1]~t[peaks[[1]][,2]], type="l" )
lines( -peaks[[2]][,1]~t[peaks[[2]][,2]], type="l" )

在探索了一下之后,这种行为似乎是spar参数的一个函数,但我无法将其设置为足够小的值来消除效果。这可能是样条拟合的明显结果,也是依赖开箱即用方法的错误,但我很欣赏一些见解。我可以在smooth.spline()中指定控件,还是替代平滑推荐/策略?

1 个答案:

答案 0 :(得分:2)

我不知道你是否总是适合周期性信号。如果是这种情况,使用来自mgcv::gam的周期样条更好。但是,让我们暂时忘记这个问题。

如果您的数据具有较高的频繁振荡,则必须选择足够数量的节点,即合适的节点密度,否则您只会导致过度平滑(即,不合适)。

看看你的例子:

t <- seq(0, 100 * 2 * pi, length.out = 3000)
y <- cos(t) # + rnorm(length(t), 0, 0.05)
fit <- smooth.spline(t, y)

您有n = 3000个数据点。默认情况下,smooth.spline使用的结节数比n > 49时的数据少得多。确切地说,它是由服务例程.nknots.smspl选择的。但是没有最优理由。因此,您可以证明这是否合理。我们来看看:

length(fit$fit$nk) - 2L  ## or `.nknots.smspl(3000)`
# [1] 194

fit$df
# [1] 194

它仅使用194节并且模型最终具有194个自由度而没有惩罚效果。正如我之前所说,你最终会得不到合适:

plot(t, y, type = "l", col = "gray")
lines(fit, col = 2)

enter image description here

理想情况下,惩罚性回归最终会导致自由度明显小于节数。人们经常忘记惩罚是用来修复原始非惩罚性回归导致的过度拟合问题。如果我们甚至没有看到惩罚效果,那么原始的非惩罚模型是不合适的数据,所以增加结的数量直到我们达到过度拟合的状态。如果您懒得考虑这个问题,请设置all.knots = TRUE。单变量平滑样条在O(n)成本下计算成本非常低。即使您使用所有数据作为结,也不会遇到效率问题。

fit <- smooth.spline(t, y, all.knots = TRUE)

length(fit$fit$nk) - 2L
# [1] 3000

fit$df
# [1] 3000
哦,我们还没有看到惩罚的效果,为什么?因为我们没有嘈杂的数据。您没有为y添加噪音,因此通过使用所有结我们正在进行插值。在y添加一些噪音,以真正理解我对惩罚的解释。

set.seed(0)
t <- seq(0, 100 * 2 * pi, length.out = 3000)
y <- cos(t) + rnorm(length(t), 0, 0.05)

fit <- smooth.spline(t, y, all.knots = TRUE)

length(fit$fit$nk)
# [1] 3002

fit$df
# [1] 705.0414

注意与705相比有多少705.看看合适的样条曲线?

plot(t, y, type = "l", col = "gray")
lines(fit, col = 2)

既没有贴合也没有过度贴合;惩罚导致偏差和方差之间的最佳平衡。

enter image description here