Nothing
tests/testthat/test_hilde.R
In clampSeg: Idealisation of Patch Clamp Recordings
context("hilde")
# a simple way to filter data, not very precise, but enough for test purposes
.convolve <- function(data, filter) {
stats::filter(data, filter$kern, sides = 1)[-c(1:filter$len)] / sqrt(sum(filter$kern^2))
}
test_that("it works if q1, q2, lengths are given and that data and filter have to be given", {
skip_on_cran()
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS"))
expect_error(hilde(family = "jsmurfPS", data = testdata))
expect_error(hilde(family = "jsmurfPS", filter = testfilter))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf")
compare <- improveSmallScales(fit = jsmurf(family = "hjsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "2Param", lengths = 1:65, q = rep(150, 65),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:65, q2 = rep(150, 65),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("output is tested and works", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, q2 = rep(25, 20), output = 1))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, q2 = rep(25, 20),
output = c("only", "every")))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
q2 = rep(25, 20), output = "aha"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
suppressWarningNoDeconvolution = TRUE, lengths = 1:20, q2 = rep(25, 20)),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
output = "only", suppressWarningNoDeconvolution = TRUE, lengths = 1:20, q2 = rep(25, 20)))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, method = "LR",
lengths = 1:20, q2 = rep(25, 20), suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, method = "LR",
lengths = 1:20, q2 = rep(25, 20), output = "each",
suppressWarningNoDeconvolution = TRUE)$idealization)
comparesd <- stepR::sdrobnorm(testdata, lag = testfilter$len + 1)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq, locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "each", suppressWarningNoDeconvolution = TRUE), compare)
compare <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)$idealization
compare2 <- compare[[3]]
attr(compare2, "noDeconvolution") <- attr(compare, "noDeconvolution")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare2)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf")
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, q2 = rep(150, 65), output = 1))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, q2 = rep(150, 65),
output = c("only", "every")))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, q2 = rep(150, 65),
output = "aha"))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
suppressWarningNoDeconvolution = TRUE, lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5)),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
output = "only", suppressWarningNoDeconvolution = TRUE, lengths = c(3, 5, 10, 20, 50),
q2 = rep(150, 5)))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, method = "2Param",
lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5), suppressWarningNoDeconvolution = TRUE),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, method = "2Param",
lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5), output = "each",
suppressWarningNoDeconvolution = TRUE)$idealization)
compareFit <- jsmurf(family = "hjsmurf", data = testdata, filter = testfilter, q = testq, locationCorrection = "none")
compare <- improveSmallScales(fit = compare, data = testdata, filter = testfilter,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q = rep(150, 5),
suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2, filter = testfilter)
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
output = "each", suppressWarningNoDeconvolution = TRUE), compare)
compare <- hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
output = "every", suppressWarningNoDeconvolution = TRUE)$idealization
compare2 <- compare[[3]]
attr(compare2, "noDeconvolution") <- attr(compare, "noDeconvolution")
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
suppressWarningNoDeconvolution = TRUE), compare2)
compareFit <- jsmurf(family = "hjsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q = rep(150, 5),
output = "every", suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2, filter = testfilter)
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
output = "every", suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("more difficult scenarios work", {
testdata <- c(rnorm(108, 0), rnorm(100, 10), rnorm(100, 0), rnorm(100, 10))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testdata <- c(rnorm(100, 0), rnorm(5, 10), rnorm(100, 0))
testdata <- .convolve(testdata, testfilter)
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testdata <- c(rnorm(100, 0), rnorm(5, 15), rnorm(5, 30), rnorm(5, 45), rnorm(100, 60))
testdata <- .convolve(testdata, testfilter)
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfLR", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument data is tested", {
testdata <- c(rnorm(108, 0), rnorm(100, 10), rnorm(100, 0), rnorm(100, 10))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = c(testdata, "s"), filter = testfilter, q1 = testq))
expect_error(hilde(family = "jsmurfPS", data = c(testdata, Inf), filter = testfilter, q1 = testq))
expect_error(hilde(family = "jsmurfPS", data = c(testdata, as.numeric(NA)), filter = testfilter, q1 = testq))
})
test_that("argument filter works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(100, 10), rnorm(100, 0), rnorm(100, 10))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = list(test = 1), q1 = testq))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = unclass(testfilter), q1 = testq))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 5L, cutoff = 0.15), sr = 2143, len = 5L,
shift = 0.2)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
compare <- improveSmallScales(fit = jsmurf(family = "jsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument family is tested", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurf2", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjs", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = c("hjsmurf", "hjsmurfSPS"), data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
})
test_that("argument method is tested", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LRs", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = c("LR", "2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf")
expect_warning(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = c("LR"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = c("LR"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "hjsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = c("LR"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_warning(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = c("2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = c("2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "jsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = c("2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
})
test_that("argument q1 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = "s",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = as.numeric(NA),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = Inf,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = c(1, 2),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument alpha1 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
teststat <- stepR::monteCarloSimulation(n = 215, r = 100, family = "jsmurfPS", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = "s", stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = as.numeric(NA), stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = NULL, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = c(0.1, 0.2), stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter,
alpha1 = 0, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = 1, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
stat = teststat, output = "every",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = 0.01, stat = teststat, output = "every",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.01)
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.04)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
stat = teststat, alpha1 = 0.04, output = "each",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)$idealization,
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.076)
comparesd <- stepR::sdrobnorm(testdata, lag = testfilter$len + 1)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter,
q = testq, locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 3:7, q = rep(25, 5),
suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, alpha1 = 0.076,
method = "LR", lengths = 3:7, q2 = rep(25, 5), stat = teststat,
output = "each", suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.3)
compare <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, alpha1 = 0.3, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)$idealization
compare2 <- compare[[3]]
attr(compare2, "noDeconvolution") <- attr(compare, "noDeconvolution")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare2)
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.1)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, alpha1 = 0.1,
method = "LR", lengths = 1:20, q2 = rep(25, 20), stat = teststat,
output = "every", suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument q2 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = "s",
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = as.numeric(NA),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = Inf,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = c(1, 2),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:4, q2 = c(1, 2, 3),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = c(1, Inf),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = 1,
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = 1, penalty = "sqrt",
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5),
q2 = stepR::critVal(q = 1, n = length(testdata), filter = testfilter,
family = "LR", penalty = "sqrt", lengths = c(3, 5)),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = 3, penalty = "log", nq = 300L,
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5),
q2 = stepR::critVal(q = 3, n = length(testdata), filter = testfilter, nq = 300L,
family = "LR", penalty = "log", lengths = c(3, 5)),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = as.numeric(1:215),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = c(3, 5),
suppressWarningNoDeconvolution = TRUE, output = "every"))
})
test_that("argument alpha2 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
teststat <- stepR::monteCarloSimulation(n = 215, r = 10, family = "LR", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = "s", stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = as.numeric(NA), stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = NULL, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = c(0.1, 0.2), stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter,
q1 = testq, alpha2 = 0, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = 1, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
teststat <- stepR::monteCarloSimulation(family = "LR", n = length(testdata), filter = testfilter, r = 2)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat, alpha2 = 0.04,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE, output = "every"))
testq2 <- getCritVal(family = "LR", n = length(testdata), stat = teststat,
filter = testfilter, lengths = c(1, 8), alpha = 0.123)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat, alpha2 = 0.123,
method = "LR", lengths = c(1, 8),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat, q2 = testq2,
method = "LR", lengths = c(1, 8),
suppressWarningNoDeconvolution = TRUE, output = "every"))
})
test_that("argument sd works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testsd <- 0.5
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = "s",
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = Inf,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = c(1, 0.5),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = -1,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = 0,
suppressWarningNoDeconvolution = TRUE))
estsd <- stepR::sdrobnorm(testdata, lag = 9L)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = estsd,
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurfLR")
expect_warning(ret <- hilde(family = "hjsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), sd = testsd,
suppressWarningNoDeconvolution = TRUE))
expect_identical(ret, hilde(family = "hjsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none", sd = testsd),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = testsd,
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument startTime works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurfSPS")
expect_identical(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE),
hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = 0,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = "0",
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = Inf,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = as.numeric(NA),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = c(0, 0.5),
suppressWarningNoDeconvolution = TRUE))
compare <- improveSmallScales(fit = jsmurf(family = "hjsmurfSPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none", startTime = -1),
data = testdata, filter = testfilter, startTime = -1,
method = "2Param", lengths = c(3, 4), q = rep(25, 2),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 4), q2 = rep(25, 2), startTime = -1,
suppressWarningNoDeconvolution = TRUE), compare)
compare <- improveSmallScales(fit = jsmurf(family = "hjsmurfSPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none", startTime = 100 / testfilter$sr),
data = testdata, filter = testfilter, startTime = 100 / testfilter$sr,
method = "2Param", lengths = c(7, 9), q = rep(25, 2),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(7, 9), q2 = rep(25, 2), startTime = 100 / testfilter$sr,
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("... works and is tested", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(1:19, NA), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(0, 1:19), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(ret <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(1:20, 10), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(ret, hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(1:20), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
testq2 <- getCritVal(n = length(testdata), family = "LR", filter = testfilter, alpha = 0.04,
r = 10, options = list(load = list(), simulation = "matrixIncreased"),
lengths = 21L, nq = length(testdata))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 21L, r = 10L, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 21L, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = c(10, 20), suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = 10.5, suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = 10L, suppressWarningNoDeconvolution = TRUE))
testfilter2 <- lowpassFilter(type = "bessel", param = list(pole = 4, cutoff = 0.1), sr = 31)
testdata2 <- lowpassFilter::randomGeneration(n = 31, filter = testfilter, signal = rep(0, 31), noise = 1, seed = "no")
ret <- hilde(family = "jsmurfPS", data = testdata2, filter = testfilter2, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = 11, suppressWarningNoDeconvolution = TRUE)
expect_identical(attr(ret, "noDeconvolution"), 1L)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
localValue = 1, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
localValue = function(x) {Inf}, suppressWarningNoDeconvolution = TRUE))
ret <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(1e14, 20),
localValue = mean, suppressWarningNoDeconvolution = TRUE)
expect_identical(ret$value, mean(testdata[8:92]))
testqH <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf", r = 2)
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function() {1}, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function(x) {-1}, suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function(x) {1}, suppressWarningNoDeconvolution = TRUE),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function(x, y = 1) {y}, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
regularization = NULL, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
regularization = list(c(1, 0.6, 0.1), c(1, 0.5)),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
gridSize = c(1, as.numeric(NA), 0.01),
suppressWarningNoDeconvolution = TRUE))
expect_warning(ret <- hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
gridSize = c(0.5, 0.1, 0.01) / testfilter$sr,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
windowFactorRefinement = c(1, 1, 1),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
report = 1, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = c(TRUE, TRUE)))
testlocalList <- createLocalList(filter = testfilter, method = "2Param", lengths = 3)
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE,
localList = unclass(testlocalList)))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE,
localList = testlocalList),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE))
testfilter2 <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4, cutoff = 0.1), sr = 50)
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter2, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE,
localList = testlocalList))
testdata <- c(rnorm(100, 0), rnorm(5, 10), rnorm(100, 0))
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
testlocalList <- createLocalList(filter = testfilter, method = "LR", lengths = c(1:19, 21))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", q = rep(25, 20),
lengths = c(1:19, 21), thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2,
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", q2 = rep(25, 20),
lengths = c(1:19, 21), thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2, report = TRUE,
localList = testlocalList,
suppressWarningNoDeconvolution = FALSE)), compare)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
teststat <- stepR::monteCarloSimulation(n = 215, r = 100, family = "jsmurfPS", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, stat = rnorm(100),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, stat = teststat,
filter = lowpassFilter(param = list(pole = 4L, cutoff = 0.2), len = 8),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
r = 0, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
r = 10.5, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
r = 10L, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, nq = 150L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
nq = 300.5, r = 10L, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
nq = 300L, r = 10L, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vecto")),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
messages = -1, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
messages = 2.5, options = list(load = list()), r = 10,
suppressWarningNoDeconvolution = TRUE, output = "every")),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(load = list()), r = 10,
suppressWarningNoDeconvolution = TRUE, output = "every"))
testfile <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".RDS")
testvariable <- "test"
testStepR <- new.env()
testfilter1 <- lowpassFilter(param = list(pole = 4L, cutoff = 0.1), len = 8L)
teststat1 <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "jsmurfPS",
filter = testfilter1, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter1, r = 10L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(RDSfile = testfile, variable = testvariable,
workspace = c("vector", "vectorIncreased")),
load = list(), envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter1,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
stat = teststat1, options = list(save = list()),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(readRDS(testfile), teststat1)
expect_identical(get("test", envir = testStepR), teststat1)
remove(test, envir = testStepR)
testfilter2 <- lowpassFilter(param = list(pole = 4L, cutoff = 0.2), len = 8L)
teststat2 <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "jsmurfPS",
filter = testfilter2, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter2, r = 10L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(envir = testStepR, dirs = "testStepR",
save = list(fileSystem = "vector", workspace = "vector")),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter2,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat2,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter1, r = 20L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(load = list(RDSfile = testfile), save = list(fileSystem = "vector"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter1,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat1,
suppressWarningNoDeconvolution = TRUE, output = "every"))
unlink(testfile)
testfilter3 <- lowpassFilter(param = list(pole = 4L, cutoff = 0.1), len = 11L)
teststat3 <- stepR::monteCarloSimulation(n = 197, r = 10L, family = "jsmurfPS",
filter = testfilter3, output = "maximum")
expect_identical(getCritVal(family = "jsmurfPS", n = 190L, filter = testfilter3, r = 10L, nq = 197L,
options = list(save = list(workspace = "vector", fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR")),
getCritVal(family = "jsmurfPS", n = 190L, stat = teststat3, filter = testfilter3,
options = list(save = list())))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 5L, nq = 300L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vector", fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat3,
suppressWarningNoDeconvolution = TRUE, output = "every"))
teststat4 <- stepR::monteCarloSimulation(n = 250L, r = 10L, family = "jsmurfPS", lengths = 2^(4:7),
filter = testfilter3, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 10L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vector", fileSystem = "vectorIncreased"),
load = list(workspace = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat4,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 10L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(simulation = "vector",
save = list(workspace = "vector", fileSystem = "vectorIncreased"),
load = list(workspace = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat3,
suppressWarningNoDeconvolution = TRUE, output = "every"))
teststat5 <- stepR::monteCarloSimulation(n = 250L, r = 20L, family = "jsmurfPS", lengths = 2^(4:7),
filter = testfilter3, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 20L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vectorIncreased",
fileSystem = "vector"),
load = list(workspace = "vectorIncreased",
fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat5,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 10L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vectorIncreased",
fileSystem = "vector"),
load = list(workspace = "vectorIncreased",
fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat5,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 4L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat1)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[2]], teststat2)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[3]], teststat3)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[4]], teststat5)
expect_identical(length(list.files(file.path(R.cache::getCacheRootPath(), "testStepR"))), 4L)
expect_identical(R.cache::loadCache(attr(teststat2, "keyList"), dirs = "testStepR"), teststat2)
expect_identical(R.cache::loadCache(attr(teststat1, "keyList"), dirs = "testStepR"), teststat1)
expect_identical(R.cache::loadCache(attr(teststat3, "keyList"), dirs = "testStepR"), teststat3)
expect_identical(R.cache::loadCache(attr(teststat4, "keyList"), dirs = "testStepR"), teststat4)
remove(critValStepRTab, envir = testStepR)
unlink(file.path(R.cache::getCacheRootPath(), "testStepR"), recursive = TRUE)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
teststat <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "LR", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 0L, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, penalty = c("sqrt", "log"),
suppressWarningNoDeconvolution = TRUE))
compareq <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", penalty = "sqrt",
stat = teststat)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, penalty = "sqrt",
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = compareq,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = unclass(teststat),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, q1 = testq,
filter = lowpassFilter(param = list(pole = 4L, cutoff = 0.1), len = 11),
method = "LR", lengths = 1:20, stat = teststat,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, weights = rep(1 / 19, 19),
suppressWarningNoDeconvolution = TRUE))
compareq <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", weights = 20:1 / sum(20:1),
stat = teststat)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, weights = 20:1 / sum(20:1),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = compareq,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat,
options = list(load = list(workspace = "ma")),
suppressWarningNoDeconvolution = TRUE))
expect_error(suppressWarnings(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, options = list(load = list()), seed = "s",
suppressWarningNoDeconvolution = TRUE)))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, r = 10L,
method = "LR", lengths = 1:20, options = list(load = list()), seed = 10.5,
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, r = 10L,
method = "LR", lengths = 1:20, options = list(load = list()), seed = 10L,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, options = list(load = list()), r = 10L,
rand.gen = 1,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, options = list(load = list()), r = 10L,
rand.gen = function(data) data$n,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
messages = -1, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
messages = 1, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything")),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, nq = 100L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, nq = 300.746,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, nq = 300L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
testStepR <- new.env()
teststat <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
options = list(simulation = "matrix", save = list(workspace = "matrix"),
load = list(), envir = testStepR),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat,
options = list(save = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 1L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat)
remove(critValStepRTab, envir = testStepR)
# test multiple parameters at the same time
teststat1 <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "jsmurfPS", filter = testfilter)
testq1 <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS", stat = teststat1)
teststat2 <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter)
testq2 <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", stat = teststat2)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L, stat = teststat1,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
teststat1 <- stepR::monteCarloSimulation(n = 300, r = 10L, family = "jsmurfPS", filter = testfilter)
teststat2 <- stepR::monteCarloSimulation(300, r = 10L, family = "LR", filter = testfilter)
testq1 <- getCritVal(n = 300L, filter = testfilter, family = "jsmurfPS", stat = teststat1)
testq2 <- getCritVal(n = 300L, filter = testfilter, family = "LR", stat = teststat2, penalty = "sqrt")
expect_warning(ret <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(simulation = "matrixIncreased", load = list()),
penalty = "sqrt", nq = 300L,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(ret,
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
testq1 <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS", r = 10L)
testq2 <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", r = 10L,
lengths = 1:10, thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2})
testlocalList <- createLocalList(filter = testfilter, method = "LR", lengths = 1:10)
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, r = 10L,
method = "LR", lengths = 1:10, thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2, report = TRUE,
localList = testlocalList,
suppressWarningNoDeconvolution = FALSE)),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", q1 = testq1, q2 = testq2,
lengths = 1:10, thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2,
localList = testlocalList,
suppressWarningNoDeconvolution = TRUE))
testStepR <- new.env()
teststat1 <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "jsmurfPS", filter = testfilter)
teststat2 <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(save = list(workspace = c("matrix", "matrixIncreased"),
fileSystem = c("matrix", "matrixIncreased")),
load = list(), envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list(), save = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 2L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat1)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[2]], teststat2)
expect_identical(length(list.files(file.path(R.cache::getCacheRootPath(), "testStepR"))), 2L)
expect_identical(R.cache::loadCache(attr(teststat1, "keyList"), dirs = "testStepR"), teststat1)
expect_identical(R.cache::loadCache(attr(teststat2, "keyList"), dirs = "testStepR"), teststat2)
remove(critValStepRTab, envir = testStepR)
unlink(file.path(R.cache::getCacheRootPath(), "testStepR"), recursive = TRUE)
testStepR <- new.env()
teststat1 <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "jsmurfPS", filter = testfilter)
teststat2 <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter,
localValue = mean)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(save = list(workspace = c("matrix", "matrixIncreased"),
fileSystem = c("matrix", "matrixIncreased")),
load = list(), envir = testStepR, dirs = "testStepR"),
localValue = mean,
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list(), save = list()),
localValue = mean,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 1L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat1)
expect_identical(length(list.files(file.path(R.cache::getCacheRootPath(), "testStepR"))), 1L)
expect_identical(R.cache::loadCache(attr(teststat1, "keyList"), dirs = "testStepR"), teststat1)
remove(critValStepRTab, envir = testStepR)
unlink(file.path(R.cache::getCacheRootPath(), "testStepR"), recursive = TRUE)
ret <- hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS",
method = "LR", lengths = c(1:10, 21), r = 10L, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE)
expect_identical(length(ret$q2), 11L)
expect_identical(attr(ret$q2, "n"), 197L)
teststat <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "LR", filter = testfilter)
expect_error(hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS",
method = "LR", lengths = c(1:10, 21), stat = teststat, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE))
teststat <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "LR", filter = testfilter, lengths = c(5, 21:23),
output = "maximum", penalty = "sqrt")
expect_identical(hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), stat = teststat, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE),
hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), r = 10L, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), output = "everything", r = 10L,
options = list(simulation = "matrix",
save = list(fileSystem = c("matrix", "vector",
"matrixIncreased", "vectorIncreased")),
dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE),
hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), output = "everything", stat = teststat,
options = list(simulation = "matrix",
save = list(fileSystem = c("matrix", "vector",
"matrixIncreased", "vectorIncreased")),
dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE))
expect_false(file_test(op = "-d", file.path(R.cache::getCacheRootPath(), "testStepR")))
testq1 <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS", r = 10L)
testq2 <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", r = 10L)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
q = 1))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
alpha = 0.05))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
intervalSystem = "all"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
n = 215))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
correlations = 1))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
fit = 1))
})
Try the clampSeg package in your browser
Any scripts or data that you put into this service are public.
clampSeg documentation built on Jan. 28, 2022, 1:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("hilde")
# a simple way to filter data, not very precise, but enough for test purposes
.convolve <- function(data, filter) {
stats::filter(data, filter$kern, sides = 1)[-c(1:filter$len)] / sqrt(sum(filter$kern^2))
}
test_that("it works if q1, q2, lengths are given and that data and filter have to be given", {
skip_on_cran()
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS"))
expect_error(hilde(family = "jsmurfPS", data = testdata))
expect_error(hilde(family = "jsmurfPS", filter = testfilter))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf")
compare <- improveSmallScales(fit = jsmurf(family = "hjsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "2Param", lengths = 1:65, q = rep(150, 65),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:65, q2 = rep(150, 65),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("output is tested and works", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, q2 = rep(25, 20), output = 1))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, q2 = rep(25, 20),
output = c("only", "every")))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
q2 = rep(25, 20), output = "aha"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
suppressWarningNoDeconvolution = TRUE, lengths = 1:20, q2 = rep(25, 20)),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
output = "only", suppressWarningNoDeconvolution = TRUE, lengths = 1:20, q2 = rep(25, 20)))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, method = "LR",
lengths = 1:20, q2 = rep(25, 20), suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, method = "LR",
lengths = 1:20, q2 = rep(25, 20), output = "each",
suppressWarningNoDeconvolution = TRUE)$idealization)
comparesd <- stepR::sdrobnorm(testdata, lag = testfilter$len + 1)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq, locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "each", suppressWarningNoDeconvolution = TRUE), compare)
compare <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)$idealization
compare2 <- compare[[3]]
attr(compare2, "noDeconvolution") <- attr(compare, "noDeconvolution")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare2)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf")
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, q2 = rep(150, 65), output = 1))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, q2 = rep(150, 65),
output = c("only", "every")))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, q2 = rep(150, 65),
output = "aha"))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
suppressWarningNoDeconvolution = TRUE, lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5)),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
output = "only", suppressWarningNoDeconvolution = TRUE, lengths = c(3, 5, 10, 20, 50),
q2 = rep(150, 5)))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, method = "2Param",
lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5), suppressWarningNoDeconvolution = TRUE),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq, method = "2Param",
lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5), output = "each",
suppressWarningNoDeconvolution = TRUE)$idealization)
compareFit <- jsmurf(family = "hjsmurf", data = testdata, filter = testfilter, q = testq, locationCorrection = "none")
compare <- improveSmallScales(fit = compare, data = testdata, filter = testfilter,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q = rep(150, 5),
suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2, filter = testfilter)
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
output = "each", suppressWarningNoDeconvolution = TRUE), compare)
compare <- hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
output = "every", suppressWarningNoDeconvolution = TRUE)$idealization
compare2 <- compare[[3]]
attr(compare2, "noDeconvolution") <- attr(compare, "noDeconvolution")
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
suppressWarningNoDeconvolution = TRUE), compare2)
compareFit <- jsmurf(family = "hjsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q = rep(150, 5),
output = "every", suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2, filter = testfilter)
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 5, 10, 20, 50), q2 = rep(150, 5),
output = "every", suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("more difficult scenarios work", {
testdata <- c(rnorm(108, 0), rnorm(100, 10), rnorm(100, 0), rnorm(100, 10))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testdata <- c(rnorm(100, 0), rnorm(5, 10), rnorm(100, 0))
testdata <- .convolve(testdata, testfilter)
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testdata <- c(rnorm(100, 0), rnorm(5, 15), rnorm(5, 30), rnorm(5, 45), rnorm(100, 60))
testdata <- .convolve(testdata, testfilter)
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfLR", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument data is tested", {
testdata <- c(rnorm(108, 0), rnorm(100, 10), rnorm(100, 0), rnorm(100, 10))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = c(testdata, "s"), filter = testfilter, q1 = testq))
expect_error(hilde(family = "jsmurfPS", data = c(testdata, Inf), filter = testfilter, q1 = testq))
expect_error(hilde(family = "jsmurfPS", data = c(testdata, as.numeric(NA)), filter = testfilter, q1 = testq))
})
test_that("argument filter works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(100, 10), rnorm(100, 0), rnorm(100, 10))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = list(test = 1), q1 = testq))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = unclass(testfilter), q1 = testq))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 5L, cutoff = 0.15), sr = 2143, len = 5L,
shift = 0.2)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
compare <- improveSmallScales(fit = jsmurf(family = "jsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument family is tested", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurf2", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjs", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = c("hjsmurf", "hjsmurfSPS"), data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
})
test_that("argument method is tested", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LRs", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = c("LR", "2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf")
expect_warning(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testq,
method = c("LR"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = c("LR"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "hjsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = c("LR"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_warning(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = c("2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = c("2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(hilde(family = "jsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = c("2Param"), lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
})
test_that("argument q1 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = "s",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = as.numeric(NA),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = Inf,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = c(1, 2),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurf", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument alpha1 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
teststat <- stepR::monteCarloSimulation(n = 215, r = 100, family = "jsmurfPS", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = "s", stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = as.numeric(NA), stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = NULL, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = c(0.1, 0.2), stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter,
alpha1 = 0, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = 1, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
stat = teststat, output = "every",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
alpha1 = 0.01, stat = teststat, output = "every",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.01)
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.04)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
stat = teststat, alpha1 = 0.04, output = "each",
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)$idealization,
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.076)
comparesd <- stepR::sdrobnorm(testdata, lag = testfilter$len + 1)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter,
q = testq, locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 3:7, q = rep(25, 5),
suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, alpha1 = 0.076,
method = "LR", lengths = 3:7, q2 = rep(25, 5), stat = teststat,
output = "each", suppressWarningNoDeconvolution = TRUE), compare)
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.3)
compare <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, alpha1 = 0.3, stat = teststat,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)$idealization
compare2 <- compare[[3]]
attr(compare2, "noDeconvolution") <- attr(compare, "noDeconvolution")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE), compare2)
testq <- getCritVal(family = "jsmurfPS", n = length(testdata), stat = teststat, filter = testfilter,
alpha = 0.1)
compareFit <- jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none")
compare <- improveSmallScales(fit = compareFit, data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
output = "every", suppressWarningNoDeconvolution = TRUE)
compareq2 <- attr(compare, "q")
attr(compare, "q") <- NULL
compare <- list(idealization = compare, fit = compareFit, q1 = testq, q2 = compareq2,
filter = testfilter, sd = comparesd)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, alpha1 = 0.1,
method = "LR", lengths = 1:20, q2 = rep(25, 20), stat = teststat,
output = "every", suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument q2 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurf")
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = "s",
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = as.numeric(NA),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = Inf,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 3, q2 = c(1, 2),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:4, q2 = c(1, 2, 3),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = c(1, Inf),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = 1,
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = 1, penalty = "sqrt",
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5),
q2 = stepR::critVal(q = 1, n = length(testdata), filter = testfilter,
family = "LR", penalty = "sqrt", lengths = c(3, 5)),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = 3, penalty = "log", nq = 300L,
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5),
q2 = stepR::critVal(q = 3, n = length(testdata), filter = testfilter, nq = 300L,
family = "LR", penalty = "log", lengths = c(3, 5)),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = as.numeric(1:215),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurf", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(3, 5), q2 = c(3, 5),
suppressWarningNoDeconvolution = TRUE, output = "every"))
})
test_that("argument alpha2 works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
teststat <- stepR::monteCarloSimulation(n = 215, r = 10, family = "LR", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = "s", stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = as.numeric(NA), stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = NULL, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = c(0.1, 0.2), stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurf", data = testdata, filter = testfilter,
q1 = testq, alpha2 = 0, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, alpha2 = 1, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE))
teststat <- stepR::monteCarloSimulation(family = "LR", n = length(testdata), filter = testfilter, r = 2)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat, alpha2 = 0.04,
method = "LR", lengths = 1:20,
suppressWarningNoDeconvolution = TRUE, output = "every"))
testq2 <- getCritVal(family = "LR", n = length(testdata), stat = teststat,
filter = testfilter, lengths = c(1, 8), alpha = 0.123)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat, alpha2 = 0.123,
method = "LR", lengths = c(1, 8),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
q1 = testq, stat = teststat, q2 = testq2,
method = "LR", lengths = c(1, 8),
suppressWarningNoDeconvolution = TRUE, output = "every"))
})
test_that("argument sd works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testsd <- 0.5
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = "s",
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = Inf,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = c(1, 0.5),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = -1,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = 0,
suppressWarningNoDeconvolution = TRUE))
estsd <- stepR::sdrobnorm(testdata, lag = 9L)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = estsd,
suppressWarningNoDeconvolution = TRUE))
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurfLR")
expect_warning(ret <- hilde(family = "hjsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), sd = testsd,
suppressWarningNoDeconvolution = TRUE))
expect_identical(ret, hilde(family = "hjsmurfLR", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none", sd = testsd),
data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q = rep(25, 20),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20), sd = testsd,
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("argument startTime works and is tested", {
testdata <- c(rnorm(108, 0), rnorm(5, 10), rnorm(5, 20), rnorm(5, 30), rnorm(100, 40))
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurfSPS")
expect_identical(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE),
hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = 0,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = "0",
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = Inf,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = as.numeric(NA),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = 1:20, q2 = rep(25, 20), startTime = c(0, 0.5),
suppressWarningNoDeconvolution = TRUE))
compare <- improveSmallScales(fit = jsmurf(family = "hjsmurfSPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none", startTime = -1),
data = testdata, filter = testfilter, startTime = -1,
method = "2Param", lengths = c(3, 4), q = rep(25, 2),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(3, 4), q2 = rep(25, 2), startTime = -1,
suppressWarningNoDeconvolution = TRUE), compare)
compare <- improveSmallScales(fit = jsmurf(family = "hjsmurfSPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none", startTime = 100 / testfilter$sr),
data = testdata, filter = testfilter, startTime = 100 / testfilter$sr,
method = "2Param", lengths = c(7, 9), q = rep(25, 2),
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(hilde(family = "hjsmurfSPS", data = testdata, filter = testfilter, q1 = testq,
method = "2Param", lengths = c(7, 9), q2 = rep(25, 2), startTime = 100 / testfilter$sr,
suppressWarningNoDeconvolution = TRUE), compare)
})
test_that("... works and is tested", {
testdata <- rnorm(100)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(1:19, NA), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(0, 1:19), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_warning(ret <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(1:20, 10), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(ret, hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = c(1:20), q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
testq2 <- getCritVal(n = length(testdata), family = "LR", filter = testfilter, alpha = 0.04,
r = 10, options = list(load = list(), simulation = "matrixIncreased"),
lengths = 21L, nq = length(testdata))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 21L, r = 10L, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 21L, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = c(10, 20), suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = 10.5, suppressWarningNoDeconvolution = TRUE),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = 10L, suppressWarningNoDeconvolution = TRUE))
testfilter2 <- lowpassFilter(type = "bessel", param = list(pole = 4, cutoff = 0.1), sr = 31)
testdata2 <- lowpassFilter::randomGeneration(n = 31, filter = testfilter, signal = rep(0, 31), noise = 1, seed = "no")
ret <- hilde(family = "jsmurfPS", data = testdata2, filter = testfilter2, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
thresholdLongSegment = 11, suppressWarningNoDeconvolution = TRUE)
expect_identical(attr(ret, "noDeconvolution"), 1L)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
localValue = 1, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
localValue = function(x) {Inf}, suppressWarningNoDeconvolution = TRUE))
ret <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = rep(1e14, 20),
localValue = mean, suppressWarningNoDeconvolution = TRUE)
expect_identical(ret$value, mean(testdata[8:92]))
testqH <- getCritVal(n = length(testdata), filter = testfilter, family = "hjsmurf", r = 2)
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function() {1}, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function(x) {-1}, suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function(x) {1}, suppressWarningNoDeconvolution = TRUE),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
localVar = function(x, y = 1) {y}, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
regularization = NULL, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
regularization = list(c(1, 0.6, 0.1), c(1, 0.5)),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
gridSize = c(1, as.numeric(NA), 0.01),
suppressWarningNoDeconvolution = TRUE))
expect_warning(ret <- hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
gridSize = c(0.5, 0.1, 0.01) / testfilter$sr,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
windowFactorRefinement = c(1, 1, 1),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
report = 1, suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = c(TRUE, TRUE)))
testlocalList <- createLocalList(filter = testfilter, method = "2Param", lengths = 3)
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE,
localList = unclass(testlocalList)))
expect_identical(hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE,
localList = testlocalList),
hilde(family = "hjsmurf", data = testdata, filter = testfilter, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE))
testfilter2 <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4, cutoff = 0.1), sr = 50)
expect_error(hilde(family = "hjsmurf", data = testdata, filter = testfilter2, q1 = testqH,
method = "2Param", lengths = 3, q2 = 200,
suppressWarningNoDeconvolution = TRUE,
localList = testlocalList))
testdata <- c(rnorm(100, 0), rnorm(5, 10), rnorm(100, 0))
testdata <- .convolve(testdata, testfilter)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
testlocalList <- createLocalList(filter = testfilter, method = "LR", lengths = c(1:19, 21))
compare <- improveSmallScales(fit = jsmurf(family = "jsmurfPS", data = testdata, filter = testfilter, q = testq,
locationCorrection = "none"),
data = testdata, filter = testfilter,
method = "LR", q = rep(25, 20),
lengths = c(1:19, 21), thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2,
suppressWarningNoDeconvolution = TRUE)
attr(compare, "q") <- NULL
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", q2 = rep(25, 20),
lengths = c(1:19, 21), thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2, report = TRUE,
localList = testlocalList,
suppressWarningNoDeconvolution = FALSE)), compare)
testfilter <- lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1, len = 8L,
shift = 0.5)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
teststat <- stepR::monteCarloSimulation(n = 215, r = 100, family = "jsmurfPS", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, stat = rnorm(100),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, stat = teststat,
filter = lowpassFilter(param = list(pole = 4L, cutoff = 0.2), len = 8),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
r = 0, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
r = 10.5, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
r = 10L, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, nq = 150L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
nq = 300.5, r = 10L, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
nq = 300L, r = 10L, options = list(load = list()),
method = "LR", lengths = 1:20, q2 = rep(25, 20),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vecto")),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
messages = -1, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
messages = 2.5, options = list(load = list()), r = 10,
suppressWarningNoDeconvolution = TRUE, output = "every")),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(load = list()), r = 10,
suppressWarningNoDeconvolution = TRUE, output = "every"))
testfile <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".RDS")
testvariable <- "test"
testStepR <- new.env()
testfilter1 <- lowpassFilter(param = list(pole = 4L, cutoff = 0.1), len = 8L)
teststat1 <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "jsmurfPS",
filter = testfilter1, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter1, r = 10L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(RDSfile = testfile, variable = testvariable,
workspace = c("vector", "vectorIncreased")),
load = list(), envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter1,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
stat = teststat1, options = list(save = list()),
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(readRDS(testfile), teststat1)
expect_identical(get("test", envir = testStepR), teststat1)
remove(test, envir = testStepR)
testfilter2 <- lowpassFilter(param = list(pole = 4L, cutoff = 0.2), len = 8L)
teststat2 <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "jsmurfPS",
filter = testfilter2, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter2, r = 10L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(envir = testStepR, dirs = "testStepR",
save = list(fileSystem = "vector", workspace = "vector")),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter2,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat2,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter1, r = 20L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(load = list(RDSfile = testfile), save = list(fileSystem = "vector"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter1,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat1,
suppressWarningNoDeconvolution = TRUE, output = "every"))
unlink(testfile)
testfilter3 <- lowpassFilter(param = list(pole = 4L, cutoff = 0.1), len = 11L)
teststat3 <- stepR::monteCarloSimulation(n = 197, r = 10L, family = "jsmurfPS",
filter = testfilter3, output = "maximum")
expect_identical(getCritVal(family = "jsmurfPS", n = 190L, filter = testfilter3, r = 10L, nq = 197L,
options = list(save = list(workspace = "vector", fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR")),
getCritVal(family = "jsmurfPS", n = 190L, stat = teststat3, filter = testfilter3,
options = list(save = list())))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 5L, nq = 300L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vector", fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat3,
suppressWarningNoDeconvolution = TRUE, output = "every"))
teststat4 <- stepR::monteCarloSimulation(n = 250L, r = 10L, family = "jsmurfPS", lengths = 2^(4:7),
filter = testfilter3, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 10L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vector", fileSystem = "vectorIncreased"),
load = list(workspace = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat4,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 10L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(simulation = "vector",
save = list(workspace = "vector", fileSystem = "vectorIncreased"),
load = list(workspace = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat3,
suppressWarningNoDeconvolution = TRUE, output = "every"))
teststat5 <- stepR::monteCarloSimulation(n = 250L, r = 20L, family = "jsmurfPS", lengths = 2^(4:7),
filter = testfilter3, output = "maximum")
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 20L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vectorIncreased",
fileSystem = "vector"),
load = list(workspace = "vectorIncreased",
fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat5,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter3, r = 10L, nq = 250L,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list(workspace = "vectorIncreased",
fileSystem = "vector"),
load = list(workspace = "vectorIncreased",
fileSystem = "vectorIncreased"),
envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "every"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter3,
method = "LR", lengths = 1:20, q2 = rep(25, 20),
options = list(save = list()), stat = teststat5,
suppressWarningNoDeconvolution = TRUE, output = "every"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 4L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat1)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[2]], teststat2)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[3]], teststat3)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[4]], teststat5)
expect_identical(length(list.files(file.path(R.cache::getCacheRootPath(), "testStepR"))), 4L)
expect_identical(R.cache::loadCache(attr(teststat2, "keyList"), dirs = "testStepR"), teststat2)
expect_identical(R.cache::loadCache(attr(teststat1, "keyList"), dirs = "testStepR"), teststat1)
expect_identical(R.cache::loadCache(attr(teststat3, "keyList"), dirs = "testStepR"), teststat3)
expect_identical(R.cache::loadCache(attr(teststat4, "keyList"), dirs = "testStepR"), teststat4)
remove(critValStepRTab, envir = testStepR)
unlink(file.path(R.cache::getCacheRootPath(), "testStepR"), recursive = TRUE)
testq <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS")
teststat <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "LR", filter = testfilter)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 0L, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, penalty = c("sqrt", "log"),
suppressWarningNoDeconvolution = TRUE))
compareq <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", penalty = "sqrt",
stat = teststat)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, penalty = "sqrt",
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = compareq,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = unclass(teststat),
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, q1 = testq,
filter = lowpassFilter(param = list(pole = 4L, cutoff = 0.1), len = 11),
method = "LR", lengths = 1:20, stat = teststat,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, weights = rep(1 / 19, 19),
suppressWarningNoDeconvolution = TRUE))
compareq <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", weights = 20:1 / sum(20:1),
stat = teststat)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat, weights = 20:1 / sum(20:1),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, q2 = compareq,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat,
options = list(load = list(workspace = "ma")),
suppressWarningNoDeconvolution = TRUE))
expect_error(suppressWarnings(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, options = list(load = list()), seed = "s",
suppressWarningNoDeconvolution = TRUE)))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, r = 10L,
method = "LR", lengths = 1:20, options = list(load = list()), seed = 10.5,
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq, r = 10L,
method = "LR", lengths = 1:20, options = list(load = list()), seed = 10L,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, options = list(load = list()), r = 10L,
rand.gen = 1,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, options = list(load = list()), r = 10L,
rand.gen = function(data) data$n,
suppressWarningNoDeconvolution = TRUE))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
messages = -1, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
messages = 1, options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything")),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, nq = 100L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, nq = 300.746,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L, nq = 300L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
testStepR <- new.env()
teststat <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, r = 10L,
options = list(simulation = "matrix", save = list(workspace = "matrix"),
load = list(), envir = testStepR),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter, q1 = testq,
method = "LR", lengths = 1:20, stat = teststat,
options = list(save = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 1L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat)
remove(critValStepRTab, envir = testStepR)
# test multiple parameters at the same time
teststat1 <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "jsmurfPS", filter = testfilter)
testq1 <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS", stat = teststat1)
teststat2 <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter)
testq2 <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", stat = teststat2)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L, stat = teststat1,
options = list(load = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
teststat1 <- stepR::monteCarloSimulation(n = 300, r = 10L, family = "jsmurfPS", filter = testfilter)
teststat2 <- stepR::monteCarloSimulation(300, r = 10L, family = "LR", filter = testfilter)
testq1 <- getCritVal(n = 300L, filter = testfilter, family = "jsmurfPS", stat = teststat1)
testq2 <- getCritVal(n = 300L, filter = testfilter, family = "LR", stat = teststat2, penalty = "sqrt")
expect_warning(ret <- hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(simulation = "matrixIncreased", load = list()),
penalty = "sqrt", nq = 300L,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(ret,
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
testq1 <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS", r = 10L)
testq2 <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", r = 10L,
lengths = 1:10, thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2})
testlocalList <- createLocalList(filter = testfilter, method = "LR", lengths = 1:10)
expect_identical(suppressMessages(hilde(family = "jsmurfPS", data = testdata, filter = testfilter, r = 10L,
method = "LR", lengths = 1:10, thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2, report = TRUE,
localList = testlocalList,
suppressWarningNoDeconvolution = FALSE)),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", q1 = testq1, q2 = testq2,
lengths = 1:10, thresholdLongSegment = 15L,
localValue = function(x, y = x) {(mean(x) + median(y)) / 2},
regularization = list(c(1, 0.6, 0.1), c(1, 0.5), 1),
gridSize = c(1, 0.2, 0.02) / testfilter$sr,
windowFactorRefinement = 2,
localList = testlocalList,
suppressWarningNoDeconvolution = TRUE))
testStepR <- new.env()
teststat1 <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "jsmurfPS", filter = testfilter)
teststat2 <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(save = list(workspace = c("matrix", "matrixIncreased"),
fileSystem = c("matrix", "matrixIncreased")),
load = list(), envir = testStepR, dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list(), save = list()),
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 2L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat1)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[2]], teststat2)
expect_identical(length(list.files(file.path(R.cache::getCacheRootPath(), "testStepR"))), 2L)
expect_identical(R.cache::loadCache(attr(teststat1, "keyList"), dirs = "testStepR"), teststat1)
expect_identical(R.cache::loadCache(attr(teststat2, "keyList"), dirs = "testStepR"), teststat2)
remove(critValStepRTab, envir = testStepR)
unlink(file.path(R.cache::getCacheRootPath(), "testStepR"), recursive = TRUE)
testStepR <- new.env()
teststat1 <- stepR::monteCarloSimulation(n = length(testdata), r = 10L, family = "jsmurfPS", filter = testfilter)
teststat2 <- stepR::monteCarloSimulation(length(testdata), r = 10L, family = "LR", filter = testfilter,
localValue = mean)
expect_identical(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(save = list(workspace = c("matrix", "matrixIncreased"),
fileSystem = c("matrix", "matrixIncreased")),
load = list(), envir = testStepR, dirs = "testStepR"),
localValue = mean,
suppressWarningNoDeconvolution = TRUE, output = "everything"),
hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, r = 10L,
options = list(load = list(), save = list()),
localValue = mean,
suppressWarningNoDeconvolution = TRUE, output = "everything"))
expect_identical(length(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat), 1L)
expect_identical(get("critValStepRTab", envir = testStepR, inherits = FALSE)$stat[[1]], teststat1)
expect_identical(length(list.files(file.path(R.cache::getCacheRootPath(), "testStepR"))), 1L)
expect_identical(R.cache::loadCache(attr(teststat1, "keyList"), dirs = "testStepR"), teststat1)
remove(critValStepRTab, envir = testStepR)
unlink(file.path(R.cache::getCacheRootPath(), "testStepR"), recursive = TRUE)
ret <- hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS",
method = "LR", lengths = c(1:10, 21), r = 10L, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE)
expect_identical(length(ret$q2), 11L)
expect_identical(attr(ret$q2, "n"), 197L)
teststat <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "LR", filter = testfilter)
expect_error(hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS",
method = "LR", lengths = c(1:10, 21), stat = teststat, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE))
teststat <- stepR::monteCarloSimulation(n = 197L, r = 10L, family = "LR", filter = testfilter, lengths = c(5, 21:23),
output = "maximum", penalty = "sqrt")
expect_identical(hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), stat = teststat, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE),
hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), r = 10L, output = "everything",
options = list(load = list()), suppressWarningNoDeconvolution = TRUE))
expect_identical(hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), output = "everything", r = 10L,
options = list(simulation = "matrix",
save = list(fileSystem = c("matrix", "vector",
"matrixIncreased", "vectorIncreased")),
dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE),
hilde(data = testdata, filter = testfilter, q1 = testq, family = "jsmurfPS", penalty = "sqrt",
method = "LR", lengths = c(5, 21:23), output = "everything", stat = teststat,
options = list(simulation = "matrix",
save = list(fileSystem = c("matrix", "vector",
"matrixIncreased", "vectorIncreased")),
dirs = "testStepR"),
suppressWarningNoDeconvolution = TRUE))
expect_false(file_test(op = "-d", file.path(R.cache::getCacheRootPath(), "testStepR")))
testq1 <- getCritVal(n = length(testdata), filter = testfilter, family = "jsmurfPS", r = 10L)
testq2 <- getCritVal(n = length(testdata), filter = testfilter, family = "LR", r = 10L)
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
q = 1))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
alpha = 0.05))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
intervalSystem = "all"))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
n = 215))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
correlations = 1))
expect_error(hilde(family = "jsmurfPS", data = testdata, filter = testfilter,
method = "LR", lengths = 1:20, q1 = testq1, q2 = testq2,
suppressWarningNoDeconvolution = TRUE, output = "everything",
fit = 1))
})
Try the clampSeg package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.