Làm thế nào tôi có thể làm nổi bật các bản vá ồn ào trong một chuỗi thời gian?

Tôi có rất nhiều dữ liệu chuỗi thời gian - mực nước và vận tốc theo thời gian. Nó là đầu ra từ một mô phỏng mô hình thủy lực. Là một phần của quy trình xem xét để xác nhận rằng mô hình đang hoạt động như mong đợi, tôi phải vẽ từng chuỗi thời gian để đảm bảo rằng không có "sự chao đảo" trong dữ liệu (xem ví dụ nhỏ lắc lư bên dưới). Sử dụng giao diện người dùng của phần mềm mô hình hóa là một cách khá chậm và tốn nhiều công sức để kiểm tra dữ liệu này. Do đó, tôi đã viết một macro VBA ngắn để nhập các bit dữ liệu khác nhau từ mô hình bao gồm các kết quả vào Excel và vẽ tất cả chúng cùng một lúc. Tôi hy vọng sẽ viết một macro VBA ngắn khác để phân tích dữ liệu chuỗi thời gian và làm nổi bật bất kỳ phần nào bị nghi ngờ.

Suy nghĩ duy nhất của tôi cho đến nay là tôi có thể thực hiện một số phân tích về độ dốc của dữ liệu. Bất cứ nơi nào độ dốc thay đổi nhanh chóng từ tích cực sang tiêu cực nhiều lần trong một cửa sổ tìm kiếm nhất định có thể được phân loại là không ổn định. Tôi có thiếu bất kỳ thủ thuật đơn giản hơn? Về cơ bản, một mô phỏng "ổn định" sẽ cung cấp một đường cong rất trơn tru. Bất kỳ thay đổi đột ngột nào cũng có thể là kết quả của sự không ổn định trong tính toán.

Để đơn giản, tôi sẽ đề nghị phân tích kích thước (giá trị tuyệt đối) của phần dư liên quan đến độ mượt của dữ liệu. Để phát hiện tự động, hãy xem xét thay thế các kích thước đó bằng một chỉ báo: 1 khi chúng vượt quá một số lượng tử cao, giả sử ở cấp và 0 nếu không. Làm mịn chỉ báo này và làm nổi bật bất kỳ giá trị được làm mịn nào vượt quá .$1-\alpha$$\alpha$

Đồ họa ở bên trái vẽ điểm dữ liệu màu xanh lam cùng với sự mượt mà cục bộ, màu đen. Đồ họa bên phải cho thấy kích thước của phần dư của mịn đó. Đường chấm màu đen là phân vị thứ 80 của chúng (tương ứng với ). Đường cong màu đỏ được xây dựng như mô tả ở trên, nhưng đã được thu nhỏ (từ các giá trị và ) đến dải giữa của phần dư tuyệt đối để vẽ đồ thị.$1201$$\alpha=0.2$$0$$1$

Thay đổi cho phép kiểm soát độ chính xác. Trong trường hợp này, cài đặt nhỏ hơn xác định khoảng cách ngắn trong tiếng ồn khoảng 22 giờ, trong khi cài đặt lớn hơn cũng nhận được sự thay đổi nhanh chóng gần 0 giờ.$\alpha$$\alpha$$0.20$$\alpha$$0.20$

Các chi tiết của mịn không quan trọng nhiều. Trong ví dụ này một hoàng thổ mịn (thực hiện trong Rkhi loessvới span=0.05bản địa hóa nó) đã được sử dụng, nhưng ngay cả một cửa sổ trung bình đã có thể làm tốt. Để làm mịn phần dư tuyệt đối, tôi chạy một giá trị trung bình có cửa sổ có chiều rộng 17 (khoảng 24 phút) theo sau là một cửa sổ trung bình. Những làm mịn cửa sổ này tương đối dễ thực hiện trong Excel. Việc triển khai VBA hiệu quả (đối với các phiên bản Excel cũ hơn, nhưng mã nguồn phải hoạt động ngay cả trong các phiên bản mới) có sẵn tại http://www.quantdec.com/Excel/smoothing.htmlm .

R Mã

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