Nothing
context("SmoothedPG")
test_that("smoothedPG works as expected- compare to naively computed estimator",{
set.seed(2581)
Y <- rnorm(64)
freq <- 2*pi*(0:63)/64
levels <- c(0.25,0.5)
qPG <- quantilePG(Y, frequencies = freq, levels.1 = levels)
weight <- kernelWeight(N=64, W=W0, bw=0.1)
#weight <- kernelWeight(W=W0, bw=0.1)
#sPG <- smoothedPG(Y, frequencies = freq, levels.1 = levels, weight=weight)
sPG <- smoothedPG(qPG, weight=weight, frequencies=freq)
# perform smoothing 'by hand':
# weight function
Wn <- function(x) {
start <- ceiling(-weight@bw-x/(2*pi))
end <- floor(weight@bw-x/(2*pi))
result <- 0
for (j in start:end) {
result <- result + weight@bw^(-1) * weight@W(weight@bw^(-1)*(x+2*pi*j))
}
result
}
Q <- getValues(qPG)
ref <- array(0, dim=c(64,2,2,1))
for (f in 1:length(freq)) {
for (s in 1:63) {
ref[f,,,] <- ref[f,,,] + Wn(freq[f]-2*pi*s/64) * Q[s+1,,,]
}
ref[f,,,] <- 2*pi*ref[f,,,]/ (64 * (weight@env$Wnj[c(64,1:63)])[f])
}
S <- getValues(sPG)
expect_that(dim(S),equals(c(64,2,2,1)))
expect_that(S,equals(ref))
}
)
test_that("smoothedPG (with SpecDistrWeight) works as expected- compare to naively computed estimator",{
set.seed(2581)
Y <- rnorm(64)
freq <- 2*pi*(0:63)/64
levels <- c(0.25,0.5)
qPG <- quantilePG(Y, frequencies = freq, levels.1 = levels)
weight <- specDistrWeight()
sPG <- smoothedPG(qPG, weight=weight, frequencies=freq)
# perform smoothing 'by hand':
Q <- getValues(qPG)
ref <- array(0, dim=c(64,2,2,1))
for (f in 1:length(freq)) {
for (s in 1:63) {
ref[f,,,] <- ref[f,,,] + (freq[f] >= 2*pi*s/64) * Q[s+1,,,]
}
ref[f,,,] <- 2*pi*ref[f,,,] / 64
}
S <- getValues(sPG)
expect_that(dim(S),equals(c(64,2,2,1)))
expect_that(S,equals(ref))
}
)
test_that("smoothedPG works as expected for various levels",{
source("load-ref.R")
lev.ok.all <- c(0.25,0.5,0.75)
lev.ok.1 <- c(0.25)
lev.ok.2 <- c(0.5,0.75)
lev.err.1 <- c("non numeric",0.5)
lev.err.2 <- c(0.5,1.5)
# Check whether it works for all levels:
W.qr.ref.1 <- array(W.qr.ref[,,,1], dim=c(64,3,3,1))
W.fft.ref.1 <- array(W.fft.ref[,,,1], dim=c(64,3,3,1))
weight = kernelWeight(W=W0, N=64, bw=0.2)
#weight = kernelWeight(W=W0, bw=0.2)
sPG.qr <- smoothedPG(Y, levels.1=lev.ok.all, weight = weight, type="qr")
W.qr <- getValues(sPG.qr)
expect_that(dim(W.qr),equals(c(64,3,3,1)))
expect_that(W.qr,equals(W.qr.ref.1))
sPG.fft <- smoothedPG(Y, levels.1=lev.ok.all, weight = weight, type="clipped")
W.fft <- getValues(sPG.fft)
expect_that(dim(W.fft),equals(c(64,3,3,1)))
expect_that(W.fft,equals(W.fft.ref.1))
W.fft.sd <- getSdNaive(sPG.fft)
expect_that(dim(W.fft.sd),equals(c(64,3,3)))
expect_that(W.fft.sd,equals(W.fft.sd.ref))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.