সরলতার জন্য, আমি ডেটা শক্তিশালী স্মুথের তুলনায় অবশিষ্টাংশের আকার (পরম মান) বিশ্লেষণের পরামর্শ দেব। স্বয়ংক্রিয় শনাক্তকরণের জন্য, সেই আকারগুলি একটি সূচক দ্বারা প্রতিস্থাপনের বিষয়টি বিবেচনা করুন: 1 যখন তারা কিছু উচ্চ পরিমাণের চেয়ে বেশি হয়, স্তরে বলুন1 - α, এবং অন্যথায় 0 এই সূচকটি মসৃণ করুন এবং ছাড়িয়ে যাওয়া কোনও ধরণের মানকে হাইলাইট করুনα।
বাম প্লটে গ্রাফিক 1201নীল রঙের সাথে শক্তিশালী, কালো রঙের স্থানীয় মসৃণ সাথে ডেটা পয়েন্ট। ডানদিকে থাকা গ্রাফিকটি সেই মসৃণটির অবশিষ্টাংশগুলির আকার দেখায়। কালো বিন্দুযুক্ত রেখাটি তাদের 80 তম পার্সেন্টাইল (এর সাথে সম্পর্কিত)α = 0.2)। লাল বক্ররেখা উপরে বর্ণিত হিসাবে নির্মিত হয়েছে, তবে ছোট করে দেওয়া হয়েছে (এর মান থেকে)0 এবং 1) ষড়যন্ত্রের জন্য পরম অবশিষ্টাংশগুলির মিডরেঞ্জ।
অসমজ্ঞ্জস αনির্ভুলতা নিয়ন্ত্রণ করতে দেয়। এই উদাহরণে, সেটিংα এর চেয়ে কম 0.20 সেট করার সময় প্রায় ২২ ঘন্টা শব্দের মধ্যে একটি ছোট ব্যবধান চিহ্নিত করে α অপেক্ষা বৃহত্তর 0.20 0 ঘন্টার কাছাকাছি দ্রুত পরিবর্তনটিও তুলে ধরে।
মসৃণ বিশদটি তেমন গুরুত্ব দেয় না। এই উদাহরণে একটি ধুসর - হরিদ্রাভ রঙের মিহি মাটির স্তর যা রাইন মসৃণ (বাস্তবায়িত Rযেমন loessসঙ্গে span=0.05এটা চিহ্নিত করতে) ব্যবহার করা হয়, কিন্তু এমনকি একটি বাতায়নযুক্ত গড় সম্পন্ন জরিমানা হবে। পরম অবশিষ্টাংশগুলিকে মসৃণ করতে আমি একটি উইন্ডোড মিডিয়ান দ্বারা প্রস্থ 17 (প্রায় 24 মিনিট) এর মাঝের দিকে চালিত হই। এই উইন্ডোড স্মুথগুলি এক্সেলে কার্যকর করা তুলনামূলক সহজ। একটি দক্ষ ভিবিএ বাস্তবায়ন (এক্সেলের পুরানো সংস্করণগুলির জন্য, তবে উত্স কোডটি নতুন সংস্করণেও কাজ করা উচিত) http://www.quantdec.com/Excel/smooming.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))
