如何突出显示时间序列中的嘈杂补丁？

我有很多时间序列数据-水位和速度与时间的关系。它是水力模型仿真的输出。作为检查过程的一部分，以确认模型是否按预期运行，我必须绘制每个时间序列图，以确保数据中没有“摆动”（请参见下面的示例轻微摆动）。使用建模软件的UI是一种非常缓慢且费力的检查数据的方法。因此，我编写了一个简短的VBA宏，以将模型中的各种数据（包括结果）导入Excel并一次将其全部绘制出来。我希望编写另一个简短的VBA宏来分析时间序列数据并突出显示任何可疑的部分。

到目前为止，我唯一的想法就是可以对数据的斜率进行一些分析。在给定的搜索窗口内，斜率多次从正变为负的快速变化的任何地方都可以归类为不稳定。我是否缺少任何更简单的技巧？本质上，“稳定”模拟应提供非常平滑的曲线。任何突然的变化都可能是计算不稳定的结果。

$1-\alpha$$\alpha$

$1201$$\alpha=0.2$$0$$1$

$\alpha$$\alpha$$0.20$$\alpha$$0.20$

平滑的细节并不重要。在这个例子中黄土平滑（中实现R为loess与span=0.05本地化的话）使用，但即使一个窗口平均会做的很好。为了平滑绝对残差，我运行了宽度为17（约24分钟）的开窗平均值，然后是开窗中位数。这些窗口平滑比较容易在Excel中实现。可从http://www.quantdec.com/Excel/smoothing.htm获得有效的VBA实现（适用于旧版本的Excel，但源代码即使在新版本中也应工作）。

R 码

#
# Emulate the data in the plot.
#
xy <- matrix(c(0, 96.35,  0.3, 96.6, 0.7, 96.7, 1, 96.73, 1.5, 96.74, 2.5, 96.75, 
               4, 96.9, 5, 97.05, 7, 97.5, 10, 98.5, 12, 99.3, 12.5, 99.35, 
               13, 99.355, 13.5, 99.36, 14.5, 99.365, 15, 99.37, 15.5, 99.375, 
               15.6, 99.4, 15.7, 99.41, 20, 99.5, 25, 99.4, 27, 99.37),
             ncol=2, byrow=TRUE)
n <- 401
set.seed(17)
noise.x <- cumsum(rexp(n, n/max(xy[,1])))
noise.y <- rep(c(-1,1), ceiling(n/2))[1:n]
noise.amp <- runif(n, 0.8, 1.2) * 0.04
noise.amp <- noise.amp * ifelse(noise.x < 16 | noise.x > 24.5, 0.05, 1)
noise.y <- noise.y * noise.amp

g <- approxfun(noise.x, noise.y)
f <- splinefun(xy[,1], xy[,2])
x <- seq(0, max(xy[,1]), length.out=1201)
y <- f(x) + g(x)
#
# Plot the data and a smooth.
#
par(mfrow=c(1,2))
plot(range(xy[,1]), range(xy[,2]), type="n", main="Data", sub="With Smooth",
     xlab="Time (hours)", ylab="Water Level")
abline(h=seq(96, 100, by=0.5), col="#e0e0e0")
abline(v=seq(0, 30, by=5), col="#e0e0e0")
#curve(f(x) + g(x), xlim=range(xy[,1]), col="#2070c0", lwd=2, add=TRUE, n=1201)
lines(x,y, type="l", col="#2070c0", lwd=2)

span <- 0.05
fit <- loess(y ~ x, span=span)
y.hat <- predict(fit)
lines(fit$x, y.hat)
#
# Plot the absolute residuals to the smooth.
#
r <-  abs(resid(fit))
plot(fit$x, r, type="l", col="#808080",
     main="Absolute Residuals", sub="With Smooth and a Threshold",
     xlab="Time hours", ylab="Residual Water Level")
#
# Smooth plot an indicator of the smoothed residuals.
#
library(zoo)
smooth <- function(x, window=17) {
  x.1 <- rollapply(ts(x), window, mean)
  x.2 <- rollapply(x.1, window, median)
  return(as.vector(x.2))
}
alpha <- 0.2
threshold <- quantile(r, 1-alpha)
abline(h=threshold, lwd=2, lty=3)
r.hat <- smooth(r >threshold)
x.hat <- smooth(fit$x)
z <- max(r)/2 * (r.hat > alpha)
lines(x.hat, z, lwd=2, col="#c02020")
par(mfrow=c(1,1))