Wie kann ich verrauschte Patches in einer Zeitreihe hervorheben?

Ich habe viele Zeitreihendaten - Wasserstände und Geschwindigkeiten gegen die Zeit. Es ist die Ausgabe einer hydraulischen Modellsimulation. Als Teil des Überprüfungsprozesses, um zu bestätigen, dass das Modell die erwartete Leistung erbringt, muss ich jede Zeitreihe zeichnen, um sicherzustellen, dass die Daten keine "Wackelbewegungen" enthalten (siehe Beispiel für geringfügiges Wackeln unten). Die Verwendung der Benutzeroberfläche der Modellierungssoftware ist eine ziemlich langsame und mühsame Methode, um diese Daten zu überprüfen. Ich habe daher ein kurzes VBA-Makro geschrieben, um verschiedene Datenbits aus dem Modell einschließlich der Ergebnisse in Excel zu importieren und alle gleichzeitig zu zeichnen. Ich hoffe, ein weiteres kurzes VBA-Makro schreiben zu können, um die Zeitreihendaten zu analysieren und verdächtige Abschnitte hervorzuheben.

Mein einziger Gedanke ist bisher, dass ich eine Analyse der Steigung der Daten durchführen könnte. Überall dort, wo sich die Steigung innerhalb eines bestimmten Suchfensters schnell schnell von positiv zu negativ ändert, kann sie als instabil eingestuft werden. Vermisse ich einfachere Tricks? Im Wesentlichen sollte eine "stabile" Simulation eine sehr glatte Kurve liefern. Jegliche plötzlichen Änderungen sind wahrscheinlich auf eine Instabilität der Berechnungen zurückzuführen.

$1-\alpha$$\alpha$

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

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

Die Details des Glatten spielen keine Rolle. In diesem Beispiel wurde eine Lössglättung (implementiert Rwie loessbei span=0.05der Lokalisierung) verwendet, aber selbst ein Mittelwert mit Fenster hätte gut funktioniert. Um die absoluten Residuen zu glätten, habe ich einen Fenstermittelwert der Breite 17 (ca. 24 Minuten) gefolgt von einem Fenstermedian ausgeführt. Diese Fensterglättungen sind relativ einfach in Excel zu implementieren. Eine effiziente VBA-Implementierung (für ältere Versionen von Excel, aber der Quellcode sollte auch in neuen Versionen funktionieren) ist unter http://www.quantdec.com/Excel/smoothing.htm verfügbar .

R Code

#
# 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))