เพื่อความง่ายฉันขอแนะนำให้วิเคราะห์ขนาด (ค่าสัมบูรณ์) ของส่วนที่เหลือเทียบกับความราบรื่นของข้อมูล สำหรับการตรวจจับอัตโนมัติให้พิจารณาเปลี่ยนขนาดนั้นด้วยตัวบ่งชี้: 1 เมื่อมีขนาดที่สูงกว่าควอไทล์สูงให้พูดที่ระดับและ 0 เป็นอย่างอื่น Smooth ตัวบ่งชี้นี้และเน้นเรียบค่าใด ๆ ที่เกิน\1−αα
กราฟฟิคด้านซ้ายมีจุดข้อมูลจุดเป็นสีน้ำเงินพร้อมกับความเรียบและแข็งแกร่งของสีดำ กราฟิกทางด้านขวาแสดงขนาดของสิ่งตกค้างที่ราบรื่น เส้นประสีดำคือเปอร์เซนต์ไทล์ที่ 80 (ตรงกับ ) เส้นโค้งสีแดงถูกสร้างขึ้นตามที่อธิบายไว้ข้างต้น แต่ได้ถูกปรับอัตราส่วน (จากค่าและ ) ไปจนถึงระดับกลางของค่าตกค้างสัมบูรณ์สำหรับการพล็อต1201α=0.201
การเปลี่ยนแปลงช่วยให้สามารถควบคุมความแม่นยำได้ ในกรณีนี้การตั้งค่าน้อยกว่าระบุช่องว่างสั้น ๆ ของเสียงรบกวนประมาณ 22 ชั่วโมงในขณะที่การตั้งค่ามากกว่ารับการเปลี่ยนแปลงที่รวดเร็วใกล้ 0 ชั่วโมงαα0.20α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))
