Як я можу виділити шумні патчі у часовій серії?

У мене дуже багато даних часових рядів - рівень води та швидкість проти часу. Це результат моделювання гідравлічної моделі. У рамках процесу огляду, щоб підтвердити, що модель працює так, як очікувалося, я повинен будувати кожен часовий ряд, щоб упевнитися у відсутності "коливань" у даних (див. Приклад незначних коливань нижче). Використання інтерфейсу програмного забезпечення для моделювання - досить повільний і трудомісткий спосіб перевірити ці дані. Тому я написав короткий макрос VBA, щоб імпортувати різні біти даних із моделі, включаючи результати, в Excel та складати їх усі відразу. Я сподіваюся написати ще один короткий макрос VBA, щоб проаналізувати дані часових рядів та виділити будь-які підозрілі розділи.

Єдина моя думка поки що - я можу зробити якийсь аналіз на схилі даних. У будь-якому місці, коли нахил швидко змінюється від позитивного до негативного кілька разів у межах певного вікна пошуку, можна класифікувати як нестабільний. Чи пропускаю я якісь простіші хитрощі? По суті, "стабільне" моделювання повинно забезпечувати дуже плавну криву. Будь-які раптові зміни, ймовірно, будуть наслідком нестабільності в розрахунках.

Для простоти я б запропонував проаналізувати розміри (абсолютні значення) залишків відносно надійної гладкості даних. Для автоматизованого виявлення розглянути можливість заміни цих розмірів на показник: 1, коли вони перевищують високий квантил, скажімо, на рівні , а 0 - інакше. Згладьте цей показник і виділіть усі згладжені значення, що перевищують .$1-\alpha$$\alpha$

Графіка на лівій графіці точок даних синього кольору, а також надійний, локальний гладкий чорний колір. Графіка праворуч показує розміри залишків цього гладкого. Чорна пунктирна лінія - їх 80-й перцентиль (відповідає ). Червона крива побудована так, як описано вище, але масштабується (від значень і ) до середнього діапазону абсолютних залишків для побудови графіку.$1201$$\alpha=0.2$$0$$1$

Варіація дозволяє контролювати точність. У цьому випадку встановлення менше ідентифікує короткий розрив у шумі близько 22 годин, тоді як встановлення більше також сприймає швидку зміну близько 0 годин.$\alpha$$\alpha$$0.20$$\alpha$$0.20$

Деталі гладкого не мають великого значення. У цьому прикладі лес згладжувати (реалізовано в Rякості loessз span=0.05локалізувати її) був використаний, але навіть віконним середнє зробило б штраф. Для згладжування абсолютних залишків я провів серед вікон середнє значення шириною 17 (приблизно 24 хвилини), а потім медіану з вікнами. Ці гладкі вікна порівняно легко реалізувати в Excel. Ефективна реалізація VBA (для старих версій Excel, але вихідний код повинен працювати навіть у нових версіях) доступна за адресою http://www.quantdec.com/Excel/smoothing.htm .

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