Nothing
test_that("pwelch", {
rave_pwelch <- function(x,
fs,
window = 64,
noverlap = 8,
nfft = 256,
col = "black",
xlim = NULL,
ylim = NULL,
main = "Welch periodogram",
plot = TRUE,
log = "xy",
spec_func = stats::spectrum,
cex = 1,
...)
{
x <- as.vector(x)
x_len <- length(x)
nfft <- max(min(nfft, length(x)), window)
window <- hanning(window)
window_len <- length(window)
step <- max(floor(window_len - noverlap + 0.99), 1)
# print(c(1, x_len - window_len + 1, by = step))
offset <- seq(1, x_len - window_len + 1, by = step)
N <- length(offset)
re <- sapply(seq_len(N), function(i) {
a <- detrend_naive(x[offset[i] - 1 + seq_len(window_len)])
a <- fftwtools::fftw_r2c(postpad(a$Y * window, nfft))
Mod(a)^2
})
NN <- ceiling((nfft + 1) / 2)
freq <- seq(0, fs / 2, length.out = NN)
spec <- rowMeans(re[seq_len(NN), , drop = FALSE]) / window_len #(window_len/2)^2
res <- list(freq = freq,
spec = spec,
method = "Welch")
return(invisible(res))
}
x <- rnorm(10000)
a <- pwelch(
x,
fs = 100,
window = 64,
noverlap = 6,
nfft = 256,
plot = FALSE,
window_family = hanning
)
b <- rave_pwelch(
x,
fs = 100,
window = 64,
noverlap = 6,
nfft = 256,
log = ""
)
expect_equal(a$freq, b$freq)
expect_equal(a$spec, b$spec)
# if(FALSE) {
# x <- rnorm(600000)
# microbenchmark::microbenchmark(
# rave = {
# rave_pwelch(x, 2000, log = '')
# },
# ravetools = {
# pwelch(x, 2000, plot = FALSE)
# }, times = 20
# )
# }
})
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.