Bir zaman serisindeki gürültülü yamaları nasıl vurgulayabilirim?

Çok sayıda zaman serisi verim var - su seviyeleri ve hızlar zamana karşı. Hidrolik model simülasyonundan elde edilen çıktıdır. Modelin beklendiği gibi çalıştığını doğrulamak için inceleme sürecinin bir parçası olarak, verilerde "yalpalama" olmadığından emin olmak için her zaman serisini çizmek zorundayım (aşağıdaki örnekte küçük yalpalamaya bakınız). Modelleme yazılımının kullanıcı arayüzünü kullanmak, bu verileri kontrol etmenin oldukça yavaş ve zahmetli bir yoludur. Bu nedenle, modeldeki çeşitli veri parçalarını Excel'e dahil etmek ve hepsini bir kerede çizmek için kısa bir VBA makrosu yazdım. Zaman serisi verilerini analiz etmek ve şüpheli olan bölümleri vurgulamak için başka bir kısa VBA makrosu yazmayı umuyorum.

Şimdiye kadar düşündüğüm tek şey, verilerin eğimi üzerinde bazı analizler yapabilmemdi. Belirli bir arama penceresi içinde eğimin hızla pozitif olmaktan birden çok kez değiştiği her yerde kararsız olarak sınıflandırılabilir. Daha basit numaralar eksik mi? Esasen, "kararlı" bir simülasyon çok düzgün bir eğri sağlamalıdır. Herhangi bir ani değişiklik muhtemelen hesaplamalardaki dengesizliğin bir sonucu olabilir.

Basitlik için, verilerin sağlam bir pürüzsüzlüğüne göre artıkların boyutlarını (mutlak değerler) analiz etmenizi öneririm. Otomatik algılama için, bu boyutları bir göstergeyle değiştirmeyi düşünün: 1 yüksek bir kantili aşarlarsa, örneğin$1-\alpha$ve 0 ise. Bu göstergeyi düzleştirin ve aşan düzleştirilmiş değerleri vurgulayın$\alpha$.

Sol parsellerdeki grafik $1201$veri noktaları mavi ile birlikte sağlam, lokal siyah renkte pürüzsüz. Sağdaki grafik, bu pürüzsüzün artıklarının boyutlarını gösterir. Siyah noktalı çizgi 80. persentildir ($\alpha=0.2$). Kırmızı eğri yukarıda açıklandığı gibi yapılandırılmıştır, ancak ölçeklendirilmiştir ($0$ ve $1$) çizim için mutlak artıkların orta aralığına kadar.

Değişen $\alpha$hassasiyet üzerinde kontrol sağlar. Bu örnekte,$\alpha$ daha az $0.20$ 22 saat civarında gürültüde kısa bir boşluk belirler. $\alpha$ daha büyük $0.20$ ayrıca hızlı değişimi 0 saate yaklaştırabilir.

Pürüzsüz ayrıntılar çok önemli değil. Bu örnekte bir lös (uygulanan pürüzsüz Rolarak loessbirlikte span=0.05onu yerelleştirilmesine) kullanıldı, ancak bu bile pencereli bir ortalama bitti cezası olurdu. Mutlak kalıntıları yumuşatmak için pencereli bir ortalama 17 genişliği (yaklaşık 24 dakika) ve ardından pencereli bir medyan çalıştırdım. Bu pencereli düzeltmelerin Excel'de uygulanması nispeten kolaydır. Verimli bir VBA uygulaması (Excel'in eski sürümleri için, ancak kaynak kodun yeni sürümlerde bile çalışması gerekir) http://www.quantdec.com/Excel/smoothing.htm adresinde bulunabilir .

R kod

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