## show plot using runquantile
k <- 31; n <- 200
x <- rnorm(n, sd=30) + abs(seq(n)-n/4)
y <- diveMove:::.runquantile(x, k, probs=c(0.05, 0.25, 0.5, 0.75, 0.95))
col <- c("black", "red", "green", "blue", "magenta", "cyan")
plot(x, col=col[1], main="Moving Window Quantiles")
lines(y[,1], col=col[2])
lines(y[,2], col=col[3])
lines(y[,3], col=col[4])
lines(y[,4], col=col[5])
lines(y[,5], col=col[6])
lab=c("data", "runquantile(.05)", "runquantile(.25)", "runquantile(0.5)",
"runquantile(.75)", "runquantile(.95)")
legend(0,230, lab, col=col, lty=1)
## basic tests against apply/embed
a <- diveMove:::.runquantile(x, k, c(0.3, 0.7), endrule="trim")
b <- t(apply(embed(x, k), 1, quantile, probs=c(0.3, 0.7)))
eps <- .Machine$double.eps ^ 0.5
stopifnot(all(abs(a - b) < eps))
## Test against loop approach
## This test works fine at the R prompt but fails during package check -
## need to investigate
k <- 25; n <- 200
x <- rnorm(n, sd=30) + abs(seq(n) - n / 4) # create random data
x[seq(1, n, 11)] <- NaN; # add NANs
k2 <- k %/% 2
k1 <- k - k2 - 1
a <- diveMove:::.runquantile(x, k, probs=c(0.3, 0.8))
b <- matrix(0, n, 2)
for(j in 1:n) {
lo <- max(1, j - k1)
hi <- min(n, j + k2)
b[j, ] <- quantile(x[lo:hi], probs=c(0.3, 0.8), na.rm=TRUE)
}
## stopifnot(all(abs(a-b)
Run the code above in your browser using DataLab