Nothing
tests/testthat/test-monteCarloSimulation.R
In stepR: Multiscale Change-Point Inference
context("monteCarloSimulation")
testrnorm1 <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector")
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum")
set.seed(testseed)
for (i in 1:testr) {
y <- rnorm(testn)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector", sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum", sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("gauss"), digits = 6), testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("gauss"), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testrnorm <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector")
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum")
set.seed(testseed)
for (i in 1:testr) {
y <- rnorm(testn)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector"),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum"),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hsmuce"), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hsmuce"), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testrand.genMDependent <- function(data) {
ma <- testcomputeMA(data$covariances)
as.numeric(arima.sim(n = data$n, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
}
testrand.genJsmurf <- function(data) {
ma <- testcomputeMA(data$filter$acf)
as.numeric(arima.sim(n = data$n, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
}
testcomputeMA <- function(cov) {
N <- length(cov) - 1
alpha <- matrix(rep(0, N * N), nrow = N, ncol = N)
vs <- rep(cov[1], N + 1)
for(i in 1:N){
alpha[i, 1:i] <- rep(0, i)
alpha[i, i] <- cov[i + 1] / vs[1]
if(i > 1) {
for(k in 1:(i - 1)) {
js <- 0:(k - 1)
alpha[i, i - k] <- (cov[i - k + 1] - sum(alpha[i, i - js] * alpha[k, k - js] * vs[js + 1])) / vs[k + 1]
}
}
js <- 0:(i - 1)
vs[i + 1] <- vs[i + 1] - sum(alpha[i, i - js]^2 * vs[js + 1])
}
alpha[N, ]
}
testbyfilter <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testcovariances, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", covariances = testcovariances)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", covariances = testcovariances)
set.seed(testseed)
ma <- testcomputeMA(testcovariances)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
covariances = testcovariances),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
covariances = testcovariances),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("mDependentPS", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("mDependentPS", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testJsmurf <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter, sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter, sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("jsmurf", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("jsmurf", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testJsmurfPS <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter, sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter, sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("jsmurfPS", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("jsmurfPS", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testJsmurfLR <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter, sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter, sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("jsmurfLR", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("jsmurfLR", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testHjsmurf <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hjsmurf", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hjsmurf", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testHjsmurfSPS <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hjsmurfSPS", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hjsmurfSPS", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testHjsmurfLR <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hjsmurfLR", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hjsmurfLR", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testLR <- function(testn, testr, testseed, testfamily, tolerance, testfilter, allLengths, save = TRUE, ...) {
ret <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = "all", output = "vector", filter = testfilter, ...)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
testfit <- stepblock(0, 0, testn / testfilter$sr, 0)
expect_equal(computeStat(y, family = testfamily, penalty = "none", output = "vector",
filter = testfilter, fit = testfit, ...),
ret[ ,i], tolerance = tolerance)
}
testkeyList <- list(testn,
digest::sha1(list("LR", testfilter$type, unname(testfilter$param),
testfilter$sr, testfilter$len), digits = 6),
"all")
testkey <- digest::digest(testkeyList)
expect_identical(attr(ret, "keyList"), testkeyList)
expect_identical(attr(ret, "key"), testkey)
expect_identical(attr(ret, "n"), testn)
expect_identical(attr(ret, "lengths"), allLengths)
expect_identical(attr(ret, "save"), save)
expect_s3_class(ret, "MCSimulationVector")
expect_identical(names(attributes(ret)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
}
test2Param <- function(testn, testr, testseed, testfamily, tolerance, testfilter, allLengths, save = TRUE, ...) {
ret <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = "all", output = "vector", filter = testfilter, ...)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
testfit <- stepblock(0, 0, testn / testfilter$sr, 0)
expect_equal(computeStat(y, family = testfamily, penalty = "none", output = "vector",
filter = testfilter, fit = testfit, ...),
ret[ ,i], tolerance = tolerance)
}
testkeyList <- list(testn,
digest::sha1(list("2Param", testfilter$type, unname(testfilter$param),
testfilter$sr, testfilter$len), digits = 6),
"all")
testkey <- digest::digest(testkeyList)
expect_identical(attr(ret, "keyList"), testkeyList)
expect_identical(attr(ret, "key"), testkey)
expect_identical(attr(ret, "n"), testn)
expect_identical(attr(ret, "lengths"), allLengths)
expect_identical(attr(ret, "save"), save)
expect_s3_class(ret, "MCSimulationVector")
expect_identical(names(attributes(ret)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
}
test_that("argument n is tested and works", {
expect_error(monteCarloSimulation())
expect_error(monteCarloSimulation(n = "s"))
expect_error(monteCarloSimulation(n = c(1L, 2L)))
expect_error(monteCarloSimulation(n = NA))
expect_error(monteCarloSimulation(n = Inf))
expect_error(monteCarloSimulation(n = 0L))
expect_error(monteCarloSimulation(n = -1L))
expect_identical(monteCarloSimulation(n = 32), monteCarloSimulation(n = 32L))
expect_identical(monteCarloSimulation(n = 32.5), monteCarloSimulation(n = 32L))
expect_equal(monteCarloSimulation(n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = function(data) rnorm(data$n),
family = "gauss", intervalSystem = "all", lengths = NULL,
penalty = "none", output = "vector", sd = 1), check.attributes = FALSE)
testrnorm1(testn = 32L, testr = 10L, testseed = 1L, testfamily = "gauss", testintervalSystem = "all",
testlengths = 1:32, testpenalty = "none", tolerance = 1e-14)
})
test_that("argument r is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, r = "s"))
expect_error(monteCarloSimulation(n = 32L, r = c(1L, 2L)))
expect_error(monteCarloSimulation(n = 32L, r = NA))
expect_error(monteCarloSimulation(n = 32L, r = Inf))
expect_error(monteCarloSimulation(n = 32L, r = 0L))
expect_error(monteCarloSimulation(n = 32L, r = -1L))
expect_identical(monteCarloSimulation(n = 32L), monteCarloSimulation(n = 32L, r = 1e4L))
expect_identical(monteCarloSimulation(n = 32L, r = 100), monteCarloSimulation(n = 32L, r = 100L))
expect_identical(monteCarloSimulation(n = 32L, r = 100.5), monteCarloSimulation(n = 32L, r = 100L))
})
test_that("argument seed is tested and works", {
testthat::skip_on_cran()
expect_error(suppressWarnings(monteCarloSimulation(n = 32L, seed = "s")))
expect_error(suppressWarnings(monteCarloSimulation(n = 32L, seed = NA)))
expect_error(suppressWarnings(monteCarloSimulation(n = 32L, seed = Inf)))
set.seed(0L)
expect_identical(monteCarloSimulation(n = 32L, r = 100L, seed = "no"),
monteCarloSimulation(n = 32L, r = 100L, seed = 0L))
expect_identical(monteCarloSimulation(n = 32L, r = 100L),
monteCarloSimulation(n = 32L, r = 100L, seed = 32L))
expect_identical(monteCarloSimulation(n = 32L, r = 100L, seed = 0),
monteCarloSimulation(n = 32L, r = 100L, seed = 0L))
expect_identical(monteCarloSimulation(n = 32L, r = 100L, seed = 0.5),
monteCarloSimulation(n = 32L, r = 100L, seed = 0L))
testrnorm1(testn = 32L, testr = 10L, testseed = -1L, testfamily = "gauss", testintervalSystem = "all",
testlengths = 1:32, testpenalty = "none", tolerance = 1e-14)
})
test_that("argument rand.gen is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, rand.gen = "s"))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function() {}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(test) {rnorm(32)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {rnorm(31)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {c(rnorm(31), NA)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {c(rnorm(31), "NA")}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {c(rnorm(31), Inf)}))
ret <- monteCarloSimulation(n = 32L, r = 100L, rand.gen = function(data) {rnorm(32)})
expect_equal(monteCarloSimulation(n = 32L, r = 100L), ret, check.attributes = FALSE)
expect_false(attr(ret, "save"))
})
test_that("argument messages is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, messages = "s"))
expect_error(monteCarloSimulation(n = 32L, messages = c(1L, 2L)))
expect_error(monteCarloSimulation(n = 32L, messages = NA))
expect_error(monteCarloSimulation(n = 32L, messages = Inf))
expect_error(monteCarloSimulation(n = 32L, messages = 0L))
expect_error(monteCarloSimulation(n = 32L, messages = -1L))
expect_identical(suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 10L)),
monteCarloSimulation(n = 32L, r = 100L))
expect_identical(suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 3)),
suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 3.5)))
expect_identical(suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 10L)),
monteCarloSimulation(n = 32L, r = 100L))
})
test_that("argument family is tested and works in the default case", { # other families below
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, family = ""))
expect_error(monteCarloSimulation(n = 32L, family = c("gauss", "hsmuce")))
expect_identical(monteCarloSimulation(n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, family = "gauss"))
})
test_that("argument intervalSystem is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, intervalSystem = ""))
expect_error(monteCarloSimulation(n = 32L, intervalSystem = "dya"))
expect_error(monteCarloSimulation(n = 32L, intervalSystem = "dyalen"))
expect_error(monteCarloSimulation(n = 32L, intervalSystem = "dyapar"))
expect_identical(monteCarloSimulation(n = 34L, r = 10L),
monteCarloSimulation(n = 34L, r = 10L, intervalSystem = "all"))
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = as.integer(2^(0:4)), testpenalty = "sqrt", tolerance = 1e-14)
testrnorm1(testn = 33L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = as.integer(2^(0:5)), testpenalty = "sqrt", tolerance = 1e-14)
})
test_that("argument lengths is tested and works", {
testthat::skip_on_cran()
expect_warning(ret <- monteCarloSimulation(n = 32L, r = 10L, lengths = 1:10))
expect_identical(ret, monteCarloSimulation(n = 32L, r = 10L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = "s"))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = c(1:10, NA)))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = c(1:10, Inf)))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = 0:10))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = -1L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = c(1L, 46L)))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaLen", lengths = 3L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaLen", lengths = 64L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaPar", lengths = 3L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaPar", lengths = 64L))
expect_identical(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1, 4, 10)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1L, 4L, 10L)))
expect_warning(ret <- monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10, 10)))
expect_identical(ret, monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10)))
expect_identical(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(10:1)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10)))
expect_identical(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10 + 0.5)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10)))
expect_equal(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = 2^(0:5)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, intervalSystem = "dyaLen"),
check.attributes = FALSE)
expect_equal(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = 2^(3:4)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, intervalSystem = "dyaLen",
lengths = 2^(3:4)), check.attributes = FALSE)
testlengths <- c(1L, 3:5, 10:23)
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = 1:28)
testlengths <- c(1L, 4L, 32L)
testrnorm1(testn = 32L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm1(testn = 24L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:4)))
expect_warning(ret <- monteCarloSimulation(10L, r = 10L, lengths = integer(0), output = "maximum"))
compare <- rep(-Inf, 10)
class(compare) <- "MCSimulationMaximum"
expect_equal(ret, compare, check.attributes = FALSE)
})
test_that("argument penalty is tested and works in the default case", {
testthat::skip_on_cran()
expect_warning(ret <- monteCarloSimulation(n = 32L, r = 10L, penalty = "log"))
expect_identical(ret, monteCarloSimulation(n = 32L, r = 10L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", penalty = ""))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", penalty = c("gauss")))
expect_identical(monteCarloSimulation(n = 32L, r = 10L, sd = 1),
monteCarloSimulation(n = 32L, r = 10L, penalty = "none", sd = 1))
testlengths <- c(1L, 3:5, 10:23)
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = 1:28)
testlengths <- c(1L, 4L, 32L)
testrnorm1(testn = 32L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm1(testn = 24L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:4)))
testlengths <- c(1L, 3:5, 10:23)
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = 1:28)
testlengths <- c(1L, 4L, 32L)
testrnorm1(testn = 32L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(0:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm1(testn = 24L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(0:4)))
})
test_that("argument output is tested and works in the default case", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, output = 1))
expect_error(monteCarloSimulation(n = 32L, output = "mu"))
expect_identical(monteCarloSimulation(n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, output = "vector"))
})
test_that("... is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, familty = "hsmuce"))
expect_error(monteCarloSimulation(n = 32L, sd = "s"))
expect_identical(monteCarloSimulation(n = 32L, r = 1e2),
monteCarloSimulation(n = 32L, r = 1e2, sd = 5))
})
test_that("family 'hsmuce' works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(family = "hsmuce"))
expect_error(monteCarloSimulation(family = "hsmuce", n = "s"))
expect_identical(monteCarloSimulation(family = "hsmuce", n = 32),
monteCarloSimulation(family = "hsmuce", n = 32L))
expect_identical(monteCarloSimulation(family = "hsmuce", n = 32.5),
monteCarloSimulation(family = "hsmuce", n = 32L))
expect_equal(monteCarloSimulation(family = "hsmuce", n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = function(data) rnorm(data$n),
family = "hsmuce", intervalSystem = "dyaPar", output = "vector"),
check.attributes = FALSE)
testrnorm(testn = 32L, testr = 10L, testseed = 1L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = 2:32, testpenalty = "none", tolerance = 1e-14)
testrnorm(testn = 32L, testr = 10L, testseed = -1L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = as.integer(2^(1:5)), testpenalty = "none", tolerance = 1e-14)
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = "s"))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = function() {}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = function(test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = function(data) {rnorm(31)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data) {c(rnorm(31), NA)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data) {c(rnorm(31), "NA")}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data) {c(rnorm(31), Inf)}))
expect_equal(monteCarloSimulation(family = "hsmuce", n = 32L, r = 100L),
monteCarloSimulation(family = "hsmuce", n = 32L, r = 100L,
rand.gen = function(data) {rnorm(32)}), check.attributes = FALSE)
expect_identical(monteCarloSimulation(family = "hsmuce", n = 34L, r = 10L),
monteCarloSimulation(family = "hsmuce", n = 34L, r = 10L, intervalSystem = "dyaPar"))
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = 2:28, testpenalty = "none", tolerance = 1e-14)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = as.integer(2^(1:4)), testpenalty = "none", tolerance = 1e-14)
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, lengths = 1L))
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, lengths = c(33L)))
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, intervalSystem = "all",
lengths = 1L))
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, intervalSystem = "dyaLen",
lengths = 1L))
expect_equal(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "all", lengths = 2^(1:5)),
monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "dyaLen"), check.attributes = FALSE)
expect_equal(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "all", lengths = 2^(3:4)),
monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "dyaLen", lengths = 2^(3:4)), check.attributes = FALSE)
testlengths <- c(2:5, 10:23)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "none", tolerance = 1e-14, allLengths = 2:28)
testlengths <- c(2L, 4L, 8L)
testrnorm(testn = 32L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "none", tolerance = 1e-14, allLengths = as.integer(2^(1:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm(testn = 24L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "none", tolerance = 1e-14, allLengths = as.integer(2^(1:4)))
expect_identical(monteCarloSimulation(family = "hsmuce", n = 32L, r = 10L),
monteCarloSimulation(family = "hsmuce", n = 32L, r = 10L, penalty = "none"))
expect_identical(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L),
monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L, penalty = "none"))
testlengths <- c(2:5, 8L, 10:23)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = 2:28)
testlengths <- c(2L, 4L, 32L)
testrnorm(testn = 32L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(1:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm(testn = 24L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(1:4)))
testlengths <- c(2:5, 8L, 10:23)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = 2:28)
testlengths <- c(2L, 4L, 32L)
testrnorm(testn = 32L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(1:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm(testn = 24L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(1:4)))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, intervalsystem = "dyaPar"))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, sd = 1))
ret <- monteCarloSimulation(1L, family = "hsmuce", r = 10L)
compare <- matrix(ncol = 10, nrow = 0)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
})
test_that("family 'mDependentPS' works", {
testthat::skip_on_cran()
testcovariances <- as.numeric(ARMAacf(ar = c(), ma = c(0.7, 0.4, 0.3, 0.1), lag.max = 4))
expect_error(monteCarloSimulation(family = "mDependentPS", covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = "s", covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 32, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 32.5, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, covariances = testcovariances))
expect_equal(monteCarloSimulation(family = "mDependentPS", n = 32L, covariances = testcovariances, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = testrand.genMDependent,
family = "mDependentPS", intervalSystem = "dyaLen", output = "vector",
covariances = testcovariances), tolerance = 1e-14, check.attributes = FALSE)
testbyfilter(testn = 32L, testr = 10L, testseed = 1L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(0:5)), testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
testbyfilter(testn = 17L, testr = 8L, testseed = -1L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(0:4)), testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L, rand.gen = "s",
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L, rand.gen = function() {},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(test) {rnorm(32)}, covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data, test) {rnorm(32)},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {rnorm(31)}, covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {c(rnorm(31), NA)},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {c(rnorm(31), "NA")},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {c(rnorm(31), Inf)},
covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 34L, r = 10L, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 34L, r = 10L, covariances = testcovariances,
intervalSystem = "dyaLen"))
testbyfilter(testn = 28L, testr = 7L, testseed = 1L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = 1:28, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
testbyfilter(testn = 28L, testr = 6L, testseed = 1L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = as.integer(2^(0:4)), testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
expect_error(monteCarloSimulation(family = "mDependentPS", output = "maximum", n = 32L, lengths = c(33L),
covariances = testcovariances))
expect_equal(monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "all",
output = "maximum", lengths = 2^(0:5), covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "dyaLen",
output = "maximum", covariances = testcovariances),
check.attributes = FALSE)
expect_equal(monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "all",
output = "maximum", lengths = 2^(3:4), covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "dyaLen",
output = "maximum", lengths = 2^(3:4), covariances = testcovariances),
check.attributes = FALSE)
testlengths <- c(2:5, 10:23)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = 1:28)
testlengths <- c(2L, 4L, 8L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2L, 4L, 16L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, penalty = "none",
covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", output = "maximum", n = 32L, r = 10L,
covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", output = "maximum", n = 32L, r = 10L,
penalty = "sqrt", covariances = testcovariances))
testlengths <- c(2:5, 10:23)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "sqrt",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = 1:28)
testlengths <- c(2L, 4L, 8L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = testlengths, testpenalty = "sqrt",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2L, 4L, 16L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = testlengths, testpenalty = "sqrt",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2:5, 10:23)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "log",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = 1:28)
testlengths <- c(2L, 4L, 8L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = testlengths, testpenalty = "log",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2L, 4L, 16L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = testlengths, testpenalty = "log",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L, intervalsystem = "dyaPar",
covariances = testcovariances))
expect_identical(monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances * 2),
monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances))
expect_error(monteCarloSimulation(10L, family = "mDependentPS"))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(testcovariances, "s")))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(0.01, testcovariances)))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(-10, testcovariances)))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(testcovariances, 0)))
expect_identical(monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances * 2),
monteCarloSimulation(10L, r = 100, family = "mDependentPS", correlations = testcovariances))
expect_equal(monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances * 2),
monteCarloSimulation(10L, r = 100, family = "mDependentPS",
correlations = testcovariances, sd = 3))
})
test_that("family 'jsmurf' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "jsmurf", filter = testfilter))
expect_error(monteCarloSimulation(family = "jsmurf", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "jsmurf", n = 32, r = 100L, filter = testfilter),
monteCarloSimulation(family = "jsmurf", n = 32L, r = 100L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "jsmurf", n = 32.5, r = 100L, filter = testfilter),
monteCarloSimulation(family = "jsmurf", n = 32L, r = 100L, filter = testfilter))
expect_equal(monteCarloSimulation(family = "jsmurf", n = 32L, filter = testfilter, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = testrand.genJsmurf,
family = "jsmurf", intervalSystem = "dyaLen", output = "vector",
filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
testJsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "sqrt",
tolerance = 1e-14, testfilter = testfilter)
testJsmurfPS(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurfPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "sqrt",
tolerance = 1e-14, testfilter = testfilter)
testJsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurfLR",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "sqrt",
tolerance = 1e-14, testfilter = testfilter)
expect_identical(monteCarloSimulation(family = "jsmurfPS", n = 34L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "jsmurfPS", n = 34L, r = 10L, filter = testfilter,
intervalSystem = "dyaLen"))
testJsmurf(testn = 32L, testr = 10L, testseed = 1L, testfamily = "jsmurf",
testintervalSystem = "all", testlengths = as.integer(c(12:32)), testpenalty = "log",
tolerance = 1e-14, testfilter = testfilter, allLengths = as.integer(c(12:32)))
testJsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurfLR",
testintervalSystem = "dyaPar", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testlengths <- c(12:15, 23L)
testJsmurfPS(testn = 28L, testr = 10L, testseed = 10L, testfamily = "jsmurfPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter, allLengths = 12:28)
expect_error(monteCarloSimulation(n = 32L, r = 10L, filter = testfilter, family = "jsmurf",
output = "maximum", lengths = c(8, 16)))
ret <- monteCarloSimulation(10L, family = "jsmurfPS", filter = testfilter, r = 10L)
compare <- matrix(ncol = 10, nrow = 0)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
testfilter2 <- lowpassFilter::lowpassFilter(param = list(pole = 4, cutoff = 0.1), sr = 10, shift = 0.8)
expect_identical(monteCarloSimulation(10L, r = 100, family = "jsmurfPS", filter = testfilter),
monteCarloSimulation(10L, r = 100, family = "jsmurfPS", filter = testfilter2))
expect_identical(monteCarloSimulation(10L, r = 100, family = "jsmurf", filter = testfilter),
monteCarloSimulation(10L, r = 100, family = "jsmurf", filter = testfilter, sd = 3))
testfilter <- lowpassFilter::lowpassFilter(param = list(pole = 3, cutoff = 0.025), len = 15, shift = 0.12)
testJsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
})
test_that("family 'hjsmurf' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "hjsmurf", filter = testfilter))
expect_error(monteCarloSimulation(family = "hjsmurf", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "hjsmurf", n = 32, r = 100L, filter = testfilter),
monteCarloSimulation(family = "hjsmurf", n = 32L, r = 100L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "hjsmurf", n = 32.5, r = 100L, filter = testfilter),
monteCarloSimulation(family = "hjsmurf", n = 32L, r = 100L, filter = testfilter))
expect_equal(monteCarloSimulation(family = "hjsmurf", n = 32L, filter = testfilter, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = testrand.genJsmurf,
family = "hjsmurf", intervalSystem = "dyaLen", output = "vector",
filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
testHjsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testHjsmurfSPS(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurfSPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testHjsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurfLR",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
expect_identical(monteCarloSimulation(family = "hjsmurfSPS", n = 34L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "hjsmurfSPS", n = 34L, r = 10L, filter = testfilter,
intervalSystem = "dyaLen"))
testHjsmurf(testn = 32L, testr = 10L, testseed = 1L, testfamily = "hjsmurf",
testintervalSystem = "all", testlengths = as.integer(c(13:32)), testpenalty = "log",
tolerance = 1e-14, testfilter = testfilter, allLengths = as.integer(c(13:32)))
testHjsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurfLR",
testintervalSystem = "dyaPar", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testlengths <- c(13:15, 23L)
testHjsmurfSPS(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hjsmurfSPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter, allLengths = 13:28)
expect_error(monteCarloSimulation(n = 32L, r = 10L, filter = testfilter, family = "hjsmurf",
output = "maximum", lengths = c(8, 16)))
ret <- monteCarloSimulation(10L, family = "hjsmurfSPS", filter = testfilter, r = 10L)
compare <- matrix(ncol = 10, nrow = 0)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
testfilter2 <- lowpassFilter::lowpassFilter(param = list(pole = 4, cutoff = 0.1), sr = 10, shift = 0.8)
expect_identical(monteCarloSimulation(10L, r = 100, family = "hjsmurfSPS", filter = testfilter),
monteCarloSimulation(10L, r = 100, family = "hjsmurfSPS", filter = testfilter2))
testfilter <- lowpassFilter::lowpassFilter(param = list(pole = 3, cutoff = 0.025), len = 14, shift = 0.12)
testHjsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
})
test_that("family 'LR' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "LR", filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32.5, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
# takes very long
# expect_equal(monteCarloSimulation(family = "LR", n = 32L, filter = testfilter),
# monteCarloSimulation(n = 32L, r = 1e4L, seed = 32L, rand.gen = testrand.genJsmurf,
# family = "LR", intervalSystem = "all", output = "vector",
# filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20)
expect_error(monteCarloSimulation(family = "LR", n = 32L, filter = testfilter,
rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "LR", n = 32L,
rand.gen = function(data) {rnorm(31)}, filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 34L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 34L, r = 10L, filter = testfilter,
intervalSystem = "all"))
expect_error(monteCarloSimulation(family = "LR", output = "maximum", n = 32L, lengths = c(33L),
filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, penalty = "none",
filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", output = "maximum", n = 32L, r = 10L,
filter = testfilter),
monteCarloSimulation(family = "LR", output = "maximum", n = 32L, r = 10L,
penalty = "weights", filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = 32L, intervalsystem = "dyaPar",
filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = 32L, intervalSystem = "dyaPar",
filter = testfilter))
ret <- monteCarloSimulation(20L, family = "LR", filter = testfilter, r = 10L)
compare <- matrix(-Inf, ncol = 10, nrow = 20)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
expect_error(monteCarloSimulation(family = "LR", n = 32L, filter = unclass(testfilter)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, fit = stepblock(1)),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
startTime = 0, thresholdLongSegment = 10L, localValue = stats::median,
regularization = 1, suppressWarningNoDeconvolution = FALSE, localList = NULL),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = NA))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = c(0, 1)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = -100),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = 0.001),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, thresholdLongSegment = NA))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, thresholdLongSegment = -1L))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = c(10L, 23L)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = 10.5),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, thresholdLongSegment = 8L, save = FALSE)
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, thresholdLongSegment = 12L, save = FALSE)
testLR(testn = 30L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20)
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, localValue = 1))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, localValue = function() 1))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, localValue = function(a) NA))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
localValue = function(a) c(1, 2)))
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, localValue = mean, save = FALSE)
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, regularization = NULL))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, regularization = c(1, NA)))
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, regularization = 2, save = TRUE)
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, regularization = c(2, 1), save = TRUE)
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = "s"))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = c(Inf, 3)))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = c(1, 0)))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 3
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
correlations = testcor),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
regularization = 2))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 2
ret <- monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = testcor)
expect_true(attr(ret, "save"))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = 1))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = as.logical(NA)))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = c(TRUE, TRUE)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = TRUE),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
})
test_that("family '2Param' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "2Param", filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "2Param", n = 64, r = 3L, filter = testfilter),
monteCarloSimulation(family = "2Param", n = 64L, r = 3L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "2Param", n = 64.5, r = 3L, filter = testfilter),
monteCarloSimulation(family = "2Param", n = 64L, r = 3L, filter = testfilter))
# only r = 2L, since it takes very long
# expect_equal(monteCarloSimulation(family = "2Param", n = 64L, filter = testfilter, r = 2L),
# monteCarloSimulation(n = 64L, r = 2L, seed = 64L, rand.gen = testrand.genJsmurf,
# family = "2Param", intervalSystem = "all", output = "vector",
# filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
test2Param(testn = 64L, testr = 2L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, filter = testfilter,
rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "2Param", n = 32L,
rand.gen = function(data) {rnorm(31)}, filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", output = "maximum", n = 32L, lengths = c(33L),
filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, intervalsystem = "dyaPar",
filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, intervalSystem = "dyaPar",
filter = testfilter))
ret <- monteCarloSimulation(20L, family = "2Param", filter = testfilter, r = 2L)
compare <- matrix(-Inf, ncol = 2, nrow = 20)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, filter = unclass(testfilter)))
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter, fit = stepblock(1)),
monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter))
filter <- testfilter
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 2L, filter = testfilter,
startTime = 0, thresholdLongSegment = 25L, localValue = stats::median,
localVar = function(data) sdrobnorm(data, lag = filter$len + 1L)^2,
regularization = 1, suppressWarningNoDeconvolution = FALSE, localList = NULL),
monteCarloSimulation(family = "2Param", n = 64L, r = 2L, filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = NA))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = c(0, 1)))
expect_identical(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = -0.001),
monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_identical(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = 100),
monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = NA))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = -1L))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = c(10L, 23L)))
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter,
thresholdLongSegment = 25.5),
monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter))
test2Param(testn = 64L, testr = 2L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64, thresholdLongSegment = 20L, save = FALSE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, localValue = 1))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
localValue = function() 1))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localValue = function(a) NA))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localValue = function(a) c(1, 2)))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, localVar = 1))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
localVar = function() 1))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localVar = function(a) NA))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localVar = function(a) c(1, 2)))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localVar = function(a) -1))
test2Param(testn = 64L, testr = 1L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64, localValue = mean, localVar = function(a) 1, save = FALSE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, regularization = NULL))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
regularization = c(1, NA)))
test2Param(testn = 64L, testr = 1L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64, regularization = c(2, 1), save = TRUE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, correlations = "s"))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, correlations = c(Inf, 3)))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, correlations = c(1, 0)))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 3
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter,
correlations = testcor),
monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter,
regularization = 2))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 2
ret <- monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter, correlations = testcor)
expect_true(attr(ret, "save"))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = 1))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = as.logical(NA)))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = c(TRUE, TRUE)))
})
Try the stepR package in your browser
Any scripts or data that you put into this service are public.
stepR documentation built on Nov. 14, 2023, 1:09 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("monteCarloSimulation")
testrnorm1 <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector")
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum")
set.seed(testseed)
for (i in 1:testr) {
y <- rnorm(testn)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector", sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum", sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("gauss"), digits = 6), testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("gauss"), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testrnorm <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector")
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum")
set.seed(testseed)
for (i in 1:testr) {
y <- rnorm(testn)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector"),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum"),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hsmuce"), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hsmuce"), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testrand.genMDependent <- function(data) {
ma <- testcomputeMA(data$covariances)
as.numeric(arima.sim(n = data$n, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
}
testrand.genJsmurf <- function(data) {
ma <- testcomputeMA(data$filter$acf)
as.numeric(arima.sim(n = data$n, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
}
testcomputeMA <- function(cov) {
N <- length(cov) - 1
alpha <- matrix(rep(0, N * N), nrow = N, ncol = N)
vs <- rep(cov[1], N + 1)
for(i in 1:N){
alpha[i, 1:i] <- rep(0, i)
alpha[i, i] <- cov[i + 1] / vs[1]
if(i > 1) {
for(k in 1:(i - 1)) {
js <- 0:(k - 1)
alpha[i, i - k] <- (cov[i - k + 1] - sum(alpha[i, i - js] * alpha[k, k - js] * vs[js + 1])) / vs[k + 1]
}
}
js <- 0:(i - 1)
vs[i + 1] <- vs[i + 1] - sum(alpha[i, i - js]^2 * vs[js + 1])
}
alpha[N, ]
}
testbyfilter <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testcovariances, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", covariances = testcovariances)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", covariances = testcovariances)
set.seed(testseed)
ma <- testcomputeMA(testcovariances)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
covariances = testcovariances),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
covariances = testcovariances),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("mDependentPS", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("mDependentPS", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testJsmurf <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter, sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter, sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("jsmurf", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("jsmurf", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testJsmurfPS <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter, sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter, sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("jsmurfPS", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("jsmurfPS", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testJsmurfLR <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter, sd = 1),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter, sd = 1),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("jsmurfLR", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("jsmurfLR", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testHjsmurf <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hjsmurf", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hjsmurf", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testHjsmurfSPS <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hjsmurfSPS", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hjsmurfSPS", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testHjsmurfLR <- function(testn, testr, testseed, testfamily, testintervalSystem, testlengths, testpenalty,
tolerance, testfilter, allLengths = testlengths, save = TRUE) {
retvector <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = NULL,
penalty = NULL, output = "vector", filter = testfilter)
retmax <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = testintervalSystem, lengths = testlengths,
penalty = testpenalty, output = "maximum", filter = testfilter)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = NULL, penalty = "none", output = "vector",
filter = testfilter),
retvector[ ,i], tolerance = tolerance)
expect_equal(computeStat(y, family = testfamily, intervalSystem = testintervalSystem,
lengths = testlengths, penalty = testpenalty, output = "maximum",
filter = testfilter),
retmax[i], tolerance = tolerance)
}
testkeyList <- list(testn, digest::sha1(list("hjsmurfLR", ma), digits = 6),
testintervalSystem)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retvector, "keyList"), testkeyList)
expect_identical(attr(retvector, "key"), testkey)
expect_identical(attr(retvector, "n"), testn)
expect_identical(attr(retvector, "lengths"), allLengths)
expect_identical(attr(retvector, "save"), save)
expect_s3_class(retvector, "MCSimulationVector")
expect_identical(names(attributes(retvector)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
testkeyList <- list(testn, digest::sha1(list("hjsmurfLR", ma), digits = 6),
testintervalSystem, as.integer(testlengths), testpenalty)
testkey <- digest::digest(testkeyList)
expect_identical(attr(retmax, "keyList"), testkeyList)
expect_identical(attr(retmax, "key"), testkey)
expect_identical(attr(retmax, "n"), testn)
expect_identical(attr(retmax, "lengths"), testlengths)
expect_identical(attr(retmax, "save"), save)
expect_s3_class(retmax, "MCSimulationMaximum")
expect_identical(names(attributes(retmax)), c("class", "keyList", "key", "n", "lengths", "save"))
}
testLR <- function(testn, testr, testseed, testfamily, tolerance, testfilter, allLengths, save = TRUE, ...) {
ret <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = "all", output = "vector", filter = testfilter, ...)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
testfit <- stepblock(0, 0, testn / testfilter$sr, 0)
expect_equal(computeStat(y, family = testfamily, penalty = "none", output = "vector",
filter = testfilter, fit = testfit, ...),
ret[ ,i], tolerance = tolerance)
}
testkeyList <- list(testn,
digest::sha1(list("LR", testfilter$type, unname(testfilter$param),
testfilter$sr, testfilter$len), digits = 6),
"all")
testkey <- digest::digest(testkeyList)
expect_identical(attr(ret, "keyList"), testkeyList)
expect_identical(attr(ret, "key"), testkey)
expect_identical(attr(ret, "n"), testn)
expect_identical(attr(ret, "lengths"), allLengths)
expect_identical(attr(ret, "save"), save)
expect_s3_class(ret, "MCSimulationVector")
expect_identical(names(attributes(ret)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
}
test2Param <- function(testn, testr, testseed, testfamily, tolerance, testfilter, allLengths, save = TRUE, ...) {
ret <- monteCarloSimulation(n = testn, r = testr, seed = testseed, family = testfamily,
intervalSystem = "all", output = "vector", filter = testfilter, ...)
set.seed(testseed)
ma <- testcomputeMA(testfilter$acf)
for (i in 1:testr) {
y <- as.numeric(arima.sim(n = testn, list(ma = ma), sd = 1)) / sqrt(sum(c(1, ma)^2))
testfit <- stepblock(0, 0, testn / testfilter$sr, 0)
expect_equal(computeStat(y, family = testfamily, penalty = "none", output = "vector",
filter = testfilter, fit = testfit, ...),
ret[ ,i], tolerance = tolerance)
}
testkeyList <- list(testn,
digest::sha1(list("2Param", testfilter$type, unname(testfilter$param),
testfilter$sr, testfilter$len), digits = 6),
"all")
testkey <- digest::digest(testkeyList)
expect_identical(attr(ret, "keyList"), testkeyList)
expect_identical(attr(ret, "key"), testkey)
expect_identical(attr(ret, "n"), testn)
expect_identical(attr(ret, "lengths"), allLengths)
expect_identical(attr(ret, "save"), save)
expect_s3_class(ret, "MCSimulationVector")
expect_identical(names(attributes(ret)), c("dim", "class", "keyList", "key", "n", "lengths", "save"))
}
test_that("argument n is tested and works", {
expect_error(monteCarloSimulation())
expect_error(monteCarloSimulation(n = "s"))
expect_error(monteCarloSimulation(n = c(1L, 2L)))
expect_error(monteCarloSimulation(n = NA))
expect_error(monteCarloSimulation(n = Inf))
expect_error(monteCarloSimulation(n = 0L))
expect_error(monteCarloSimulation(n = -1L))
expect_identical(monteCarloSimulation(n = 32), monteCarloSimulation(n = 32L))
expect_identical(monteCarloSimulation(n = 32.5), monteCarloSimulation(n = 32L))
expect_equal(monteCarloSimulation(n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = function(data) rnorm(data$n),
family = "gauss", intervalSystem = "all", lengths = NULL,
penalty = "none", output = "vector", sd = 1), check.attributes = FALSE)
testrnorm1(testn = 32L, testr = 10L, testseed = 1L, testfamily = "gauss", testintervalSystem = "all",
testlengths = 1:32, testpenalty = "none", tolerance = 1e-14)
})
test_that("argument r is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, r = "s"))
expect_error(monteCarloSimulation(n = 32L, r = c(1L, 2L)))
expect_error(monteCarloSimulation(n = 32L, r = NA))
expect_error(monteCarloSimulation(n = 32L, r = Inf))
expect_error(monteCarloSimulation(n = 32L, r = 0L))
expect_error(monteCarloSimulation(n = 32L, r = -1L))
expect_identical(monteCarloSimulation(n = 32L), monteCarloSimulation(n = 32L, r = 1e4L))
expect_identical(monteCarloSimulation(n = 32L, r = 100), monteCarloSimulation(n = 32L, r = 100L))
expect_identical(monteCarloSimulation(n = 32L, r = 100.5), monteCarloSimulation(n = 32L, r = 100L))
})
test_that("argument seed is tested and works", {
testthat::skip_on_cran()
expect_error(suppressWarnings(monteCarloSimulation(n = 32L, seed = "s")))
expect_error(suppressWarnings(monteCarloSimulation(n = 32L, seed = NA)))
expect_error(suppressWarnings(monteCarloSimulation(n = 32L, seed = Inf)))
set.seed(0L)
expect_identical(monteCarloSimulation(n = 32L, r = 100L, seed = "no"),
monteCarloSimulation(n = 32L, r = 100L, seed = 0L))
expect_identical(monteCarloSimulation(n = 32L, r = 100L),
monteCarloSimulation(n = 32L, r = 100L, seed = 32L))
expect_identical(monteCarloSimulation(n = 32L, r = 100L, seed = 0),
monteCarloSimulation(n = 32L, r = 100L, seed = 0L))
expect_identical(monteCarloSimulation(n = 32L, r = 100L, seed = 0.5),
monteCarloSimulation(n = 32L, r = 100L, seed = 0L))
testrnorm1(testn = 32L, testr = 10L, testseed = -1L, testfamily = "gauss", testintervalSystem = "all",
testlengths = 1:32, testpenalty = "none", tolerance = 1e-14)
})
test_that("argument rand.gen is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, rand.gen = "s"))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function() {}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(test) {rnorm(32)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {rnorm(31)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {c(rnorm(31), NA)}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {c(rnorm(31), "NA")}))
expect_error(monteCarloSimulation(n = 32L, rand.gen = function(data) {c(rnorm(31), Inf)}))
ret <- monteCarloSimulation(n = 32L, r = 100L, rand.gen = function(data) {rnorm(32)})
expect_equal(monteCarloSimulation(n = 32L, r = 100L), ret, check.attributes = FALSE)
expect_false(attr(ret, "save"))
})
test_that("argument messages is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, messages = "s"))
expect_error(monteCarloSimulation(n = 32L, messages = c(1L, 2L)))
expect_error(monteCarloSimulation(n = 32L, messages = NA))
expect_error(monteCarloSimulation(n = 32L, messages = Inf))
expect_error(monteCarloSimulation(n = 32L, messages = 0L))
expect_error(monteCarloSimulation(n = 32L, messages = -1L))
expect_identical(suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 10L)),
monteCarloSimulation(n = 32L, r = 100L))
expect_identical(suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 3)),
suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 3.5)))
expect_identical(suppressMessages(monteCarloSimulation(n = 32L, r = 100L, messages = 10L)),
monteCarloSimulation(n = 32L, r = 100L))
})
test_that("argument family is tested and works in the default case", { # other families below
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, family = ""))
expect_error(monteCarloSimulation(n = 32L, family = c("gauss", "hsmuce")))
expect_identical(monteCarloSimulation(n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, family = "gauss"))
})
test_that("argument intervalSystem is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, intervalSystem = ""))
expect_error(monteCarloSimulation(n = 32L, intervalSystem = "dya"))
expect_error(monteCarloSimulation(n = 32L, intervalSystem = "dyalen"))
expect_error(monteCarloSimulation(n = 32L, intervalSystem = "dyapar"))
expect_identical(monteCarloSimulation(n = 34L, r = 10L),
monteCarloSimulation(n = 34L, r = 10L, intervalSystem = "all"))
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = as.integer(2^(0:4)), testpenalty = "sqrt", tolerance = 1e-14)
testrnorm1(testn = 33L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = as.integer(2^(0:5)), testpenalty = "sqrt", tolerance = 1e-14)
})
test_that("argument lengths is tested and works", {
testthat::skip_on_cran()
expect_warning(ret <- monteCarloSimulation(n = 32L, r = 10L, lengths = 1:10))
expect_identical(ret, monteCarloSimulation(n = 32L, r = 10L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = "s"))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = c(1:10, NA)))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = c(1:10, Inf)))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = 0:10))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = -1L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", lengths = c(1L, 46L)))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaLen", lengths = 3L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaLen", lengths = 64L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaPar", lengths = 3L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", intervalSystem = "dyaPar", lengths = 64L))
expect_identical(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1, 4, 10)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1L, 4L, 10L)))
expect_warning(ret <- monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10, 10)))
expect_identical(ret, monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10)))
expect_identical(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(10:1)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10)))
expect_identical(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10 + 0.5)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = c(1:10)))
expect_equal(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = 2^(0:5)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, intervalSystem = "dyaLen"),
check.attributes = FALSE)
expect_equal(monteCarloSimulation(n = 32L, output = "maximum", r = 10L, lengths = 2^(3:4)),
monteCarloSimulation(n = 32L, output = "maximum", r = 10L, intervalSystem = "dyaLen",
lengths = 2^(3:4)), check.attributes = FALSE)
testlengths <- c(1L, 3:5, 10:23)
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = 1:28)
testlengths <- c(1L, 4L, 32L)
testrnorm1(testn = 32L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm1(testn = 24L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:4)))
expect_warning(ret <- monteCarloSimulation(10L, r = 10L, lengths = integer(0), output = "maximum"))
compare <- rep(-Inf, 10)
class(compare) <- "MCSimulationMaximum"
expect_equal(ret, compare, check.attributes = FALSE)
})
test_that("argument penalty is tested and works in the default case", {
testthat::skip_on_cran()
expect_warning(ret <- monteCarloSimulation(n = 32L, r = 10L, penalty = "log"))
expect_identical(ret, monteCarloSimulation(n = 32L, r = 10L))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", penalty = ""))
expect_error(monteCarloSimulation(n = 32L, output = "maximum", penalty = c("gauss")))
expect_identical(monteCarloSimulation(n = 32L, r = 10L, sd = 1),
monteCarloSimulation(n = 32L, r = 10L, penalty = "none", sd = 1))
testlengths <- c(1L, 3:5, 10:23)
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = 1:28)
testlengths <- c(1L, 4L, 32L)
testrnorm1(testn = 32L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm1(testn = 24L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(0:4)))
testlengths <- c(1L, 3:5, 10:23)
testrnorm1(testn = 28L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = 1:28)
testlengths <- c(1L, 4L, 32L)
testrnorm1(testn = 32L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(0:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm1(testn = 24L, testr = 10L, testseed = 10L, testfamily = "gauss", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(0:4)))
})
test_that("argument output is tested and works in the default case", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, output = 1))
expect_error(monteCarloSimulation(n = 32L, output = "mu"))
expect_identical(monteCarloSimulation(n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, output = "vector"))
})
test_that("... is tested and works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(n = 32L, familty = "hsmuce"))
expect_error(monteCarloSimulation(n = 32L, sd = "s"))
expect_identical(monteCarloSimulation(n = 32L, r = 1e2),
monteCarloSimulation(n = 32L, r = 1e2, sd = 5))
})
test_that("family 'hsmuce' works", {
testthat::skip_on_cran()
expect_error(monteCarloSimulation(family = "hsmuce"))
expect_error(monteCarloSimulation(family = "hsmuce", n = "s"))
expect_identical(monteCarloSimulation(family = "hsmuce", n = 32),
monteCarloSimulation(family = "hsmuce", n = 32L))
expect_identical(monteCarloSimulation(family = "hsmuce", n = 32.5),
monteCarloSimulation(family = "hsmuce", n = 32L))
expect_equal(monteCarloSimulation(family = "hsmuce", n = 32L, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = function(data) rnorm(data$n),
family = "hsmuce", intervalSystem = "dyaPar", output = "vector"),
check.attributes = FALSE)
testrnorm(testn = 32L, testr = 10L, testseed = 1L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = 2:32, testpenalty = "none", tolerance = 1e-14)
testrnorm(testn = 32L, testr = 10L, testseed = -1L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = as.integer(2^(1:5)), testpenalty = "none", tolerance = 1e-14)
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = "s"))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = function() {}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = function(test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, rand.gen = function(data) {rnorm(31)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data) {c(rnorm(31), NA)}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data) {c(rnorm(31), "NA")}))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L,
rand.gen = function(data) {c(rnorm(31), Inf)}))
expect_equal(monteCarloSimulation(family = "hsmuce", n = 32L, r = 100L),
monteCarloSimulation(family = "hsmuce", n = 32L, r = 100L,
rand.gen = function(data) {rnorm(32)}), check.attributes = FALSE)
expect_identical(monteCarloSimulation(family = "hsmuce", n = 34L, r = 10L),
monteCarloSimulation(family = "hsmuce", n = 34L, r = 10L, intervalSystem = "dyaPar"))
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = 2:28, testpenalty = "none", tolerance = 1e-14)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = as.integer(2^(1:4)), testpenalty = "none", tolerance = 1e-14)
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, lengths = 1L))
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, lengths = c(33L)))
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, intervalSystem = "all",
lengths = 1L))
expect_error(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, intervalSystem = "dyaLen",
lengths = 1L))
expect_equal(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "all", lengths = 2^(1:5)),
monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "dyaLen"), check.attributes = FALSE)
expect_equal(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "all", lengths = 2^(3:4)),
monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L,
intervalSystem = "dyaLen", lengths = 2^(3:4)), check.attributes = FALSE)
testlengths <- c(2:5, 10:23)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "none", tolerance = 1e-14, allLengths = 2:28)
testlengths <- c(2L, 4L, 8L)
testrnorm(testn = 32L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "none", tolerance = 1e-14, allLengths = as.integer(2^(1:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm(testn = 24L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "none", tolerance = 1e-14, allLengths = as.integer(2^(1:4)))
expect_identical(monteCarloSimulation(family = "hsmuce", n = 32L, r = 10L),
monteCarloSimulation(family = "hsmuce", n = 32L, r = 10L, penalty = "none"))
expect_identical(monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L),
monteCarloSimulation(family = "hsmuce", output = "maximum", n = 32L, r = 10L, penalty = "none"))
testlengths <- c(2:5, 8L, 10:23)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = 2:28)
testlengths <- c(2L, 4L, 32L)
testrnorm(testn = 32L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(1:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm(testn = 24L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "sqrt", tolerance = 1e-14, allLengths = as.integer(2^(1:4)))
testlengths <- c(2:5, 8L, 10:23)
testrnorm(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "all",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = 2:28)
testlengths <- c(2L, 4L, 32L)
testrnorm(testn = 32L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaLen",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(1:5)))
testlengths <- c(2L, 4L, 16L)
testrnorm(testn = 24L, testr = 10L, testseed = 10L, testfamily = "hsmuce", testintervalSystem = "dyaPar",
testlengths = testlengths, testpenalty = "log", tolerance = 1e-14, allLengths = as.integer(2^(1:4)))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, intervalsystem = "dyaPar"))
expect_error(monteCarloSimulation(family = "hsmuce", n = 32L, sd = 1))
ret <- monteCarloSimulation(1L, family = "hsmuce", r = 10L)
compare <- matrix(ncol = 10, nrow = 0)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
})
test_that("family 'mDependentPS' works", {
testthat::skip_on_cran()
testcovariances <- as.numeric(ARMAacf(ar = c(), ma = c(0.7, 0.4, 0.3, 0.1), lag.max = 4))
expect_error(monteCarloSimulation(family = "mDependentPS", covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = "s", covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 32, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 32.5, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, covariances = testcovariances))
expect_equal(monteCarloSimulation(family = "mDependentPS", n = 32L, covariances = testcovariances, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = testrand.genMDependent,
family = "mDependentPS", intervalSystem = "dyaLen", output = "vector",
covariances = testcovariances), tolerance = 1e-14, check.attributes = FALSE)
testbyfilter(testn = 32L, testr = 10L, testseed = 1L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(0:5)), testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
testbyfilter(testn = 17L, testr = 8L, testseed = -1L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(0:4)), testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L, rand.gen = "s",
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L, rand.gen = function() {},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(test) {rnorm(32)}, covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data, test) {rnorm(32)},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {rnorm(31)}, covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {c(rnorm(31), NA)},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {c(rnorm(31), "NA")},
covariances = testcovariances))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L,
rand.gen = function(data) {c(rnorm(31), Inf)},
covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 34L, r = 10L, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 34L, r = 10L, covariances = testcovariances,
intervalSystem = "dyaLen"))
testbyfilter(testn = 28L, testr = 7L, testseed = 1L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = 1:28, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
testbyfilter(testn = 28L, testr = 6L, testseed = 1L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = as.integer(2^(0:4)), testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances)
expect_error(monteCarloSimulation(family = "mDependentPS", output = "maximum", n = 32L, lengths = c(33L),
covariances = testcovariances))
expect_equal(monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "all",
output = "maximum", lengths = 2^(0:5), covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "dyaLen",
output = "maximum", covariances = testcovariances),
check.attributes = FALSE)
expect_equal(monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "all",
output = "maximum", lengths = 2^(3:4), covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, intervalSystem = "dyaLen",
output = "maximum", lengths = 2^(3:4), covariances = testcovariances),
check.attributes = FALSE)
testlengths <- c(2:5, 10:23)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = 1:28)
testlengths <- c(2L, 4L, 8L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2L, 4L, 16L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
expect_identical(monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", n = 32L, r = 10L, penalty = "none",
covariances = testcovariances))
expect_identical(monteCarloSimulation(family = "mDependentPS", output = "maximum", n = 32L, r = 10L,
covariances = testcovariances),
monteCarloSimulation(family = "mDependentPS", output = "maximum", n = 32L, r = 10L,
penalty = "sqrt", covariances = testcovariances))
testlengths <- c(2:5, 10:23)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "sqrt",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = 1:28)
testlengths <- c(2L, 4L, 8L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = testlengths, testpenalty = "sqrt",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2L, 4L, 16L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = testlengths, testpenalty = "sqrt",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2:5, 10:23)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "log",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = 1:28)
testlengths <- c(2L, 4L, 8L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaLen", testlengths = testlengths, testpenalty = "log",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
testlengths <- c(2L, 4L, 16L)
testbyfilter(testn = 28L, testr = 10L, testseed = 10L, testfamily = "mDependentPS",
testintervalSystem = "dyaPar", testlengths = testlengths, testpenalty = "log",
tolerance = 1e-14, testcovariances = testcovariances, allLengths = as.integer(2^(0:4)))
expect_error(monteCarloSimulation(family = "mDependentPS", n = 32L, intervalsystem = "dyaPar",
covariances = testcovariances))
expect_identical(monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances * 2),
monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances))
expect_error(monteCarloSimulation(10L, family = "mDependentPS"))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(testcovariances, "s")))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(0.01, testcovariances)))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(-10, testcovariances)))
expect_error(monteCarloSimulation(10L, family = "mDependentPS", covariances = c(testcovariances, 0)))
expect_identical(monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances * 2),
monteCarloSimulation(10L, r = 100, family = "mDependentPS", correlations = testcovariances))
expect_equal(monteCarloSimulation(10L, r = 100, family = "mDependentPS", covariances = testcovariances * 2),
monteCarloSimulation(10L, r = 100, family = "mDependentPS",
correlations = testcovariances, sd = 3))
})
test_that("family 'jsmurf' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "jsmurf", filter = testfilter))
expect_error(monteCarloSimulation(family = "jsmurf", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "jsmurf", n = 32, r = 100L, filter = testfilter),
monteCarloSimulation(family = "jsmurf", n = 32L, r = 100L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "jsmurf", n = 32.5, r = 100L, filter = testfilter),
monteCarloSimulation(family = "jsmurf", n = 32L, r = 100L, filter = testfilter))
expect_equal(monteCarloSimulation(family = "jsmurf", n = 32L, filter = testfilter, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = testrand.genJsmurf,
family = "jsmurf", intervalSystem = "dyaLen", output = "vector",
filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
testJsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "sqrt",
tolerance = 1e-14, testfilter = testfilter)
testJsmurfPS(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurfPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "sqrt",
tolerance = 1e-14, testfilter = testfilter)
testJsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurfLR",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "sqrt",
tolerance = 1e-14, testfilter = testfilter)
expect_identical(monteCarloSimulation(family = "jsmurfPS", n = 34L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "jsmurfPS", n = 34L, r = 10L, filter = testfilter,
intervalSystem = "dyaLen"))
testJsmurf(testn = 32L, testr = 10L, testseed = 1L, testfamily = "jsmurf",
testintervalSystem = "all", testlengths = as.integer(c(12:32)), testpenalty = "log",
tolerance = 1e-14, testfilter = testfilter, allLengths = as.integer(c(12:32)))
testJsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurfLR",
testintervalSystem = "dyaPar", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testlengths <- c(12:15, 23L)
testJsmurfPS(testn = 28L, testr = 10L, testseed = 10L, testfamily = "jsmurfPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter, allLengths = 12:28)
expect_error(monteCarloSimulation(n = 32L, r = 10L, filter = testfilter, family = "jsmurf",
output = "maximum", lengths = c(8, 16)))
ret <- monteCarloSimulation(10L, family = "jsmurfPS", filter = testfilter, r = 10L)
compare <- matrix(ncol = 10, nrow = 0)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
testfilter2 <- lowpassFilter::lowpassFilter(param = list(pole = 4, cutoff = 0.1), sr = 10, shift = 0.8)
expect_identical(monteCarloSimulation(10L, r = 100, family = "jsmurfPS", filter = testfilter),
monteCarloSimulation(10L, r = 100, family = "jsmurfPS", filter = testfilter2))
expect_identical(monteCarloSimulation(10L, r = 100, family = "jsmurf", filter = testfilter),
monteCarloSimulation(10L, r = 100, family = "jsmurf", filter = testfilter, sd = 3))
testfilter <- lowpassFilter::lowpassFilter(param = list(pole = 3, cutoff = 0.025), len = 15, shift = 0.12)
testJsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "jsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
})
test_that("family 'hjsmurf' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "hjsmurf", filter = testfilter))
expect_error(monteCarloSimulation(family = "hjsmurf", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "hjsmurf", n = 32, r = 100L, filter = testfilter),
monteCarloSimulation(family = "hjsmurf", n = 32L, r = 100L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "hjsmurf", n = 32.5, r = 100L, filter = testfilter),
monteCarloSimulation(family = "hjsmurf", n = 32L, r = 100L, filter = testfilter))
expect_equal(monteCarloSimulation(family = "hjsmurf", n = 32L, filter = testfilter, r = 10L),
monteCarloSimulation(n = 32L, r = 10L, seed = 32L,
rand.gen = testrand.genJsmurf,
family = "hjsmurf", intervalSystem = "dyaLen", output = "vector",
filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
testHjsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testHjsmurfSPS(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurfSPS",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testHjsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurfLR",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
expect_identical(monteCarloSimulation(family = "hjsmurfSPS", n = 34L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "hjsmurfSPS", n = 34L, r = 10L, filter = testfilter,
intervalSystem = "dyaLen"))
testHjsmurf(testn = 32L, testr = 10L, testseed = 1L, testfamily = "hjsmurf",
testintervalSystem = "all", testlengths = as.integer(c(13:32)), testpenalty = "log",
tolerance = 1e-14, testfilter = testfilter, allLengths = as.integer(c(13:32)))
testHjsmurfLR(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurfLR",
testintervalSystem = "dyaPar", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
testlengths <- c(13:15, 23L)
testHjsmurfSPS(testn = 28L, testr = 10L, testseed = 10L, testfamily = "hjsmurfSPS",
testintervalSystem = "all", testlengths = testlengths, testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter, allLengths = 13:28)
expect_error(monteCarloSimulation(n = 32L, r = 10L, filter = testfilter, family = "hjsmurf",
output = "maximum", lengths = c(8, 16)))
ret <- monteCarloSimulation(10L, family = "hjsmurfSPS", filter = testfilter, r = 10L)
compare <- matrix(ncol = 10, nrow = 0)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
testfilter2 <- lowpassFilter::lowpassFilter(param = list(pole = 4, cutoff = 0.1), sr = 10, shift = 0.8)
expect_identical(monteCarloSimulation(10L, r = 100, family = "hjsmurfSPS", filter = testfilter),
monteCarloSimulation(10L, r = 100, family = "hjsmurfSPS", filter = testfilter2))
testfilter <- lowpassFilter::lowpassFilter(param = list(pole = 3, cutoff = 0.025), len = 14, shift = 0.12)
testHjsmurf(testn = 64L, testr = 10L, testseed = 1L, testfamily = "hjsmurf",
testintervalSystem = "dyaLen", testlengths = as.integer(2^(4:6)), testpenalty = "none",
tolerance = 1e-14, testfilter = testfilter)
})
test_that("family 'LR' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "LR", filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32.5, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
# takes very long
# expect_equal(monteCarloSimulation(family = "LR", n = 32L, filter = testfilter),
# monteCarloSimulation(n = 32L, r = 1e4L, seed = 32L, rand.gen = testrand.genJsmurf,
# family = "LR", intervalSystem = "all", output = "vector",
# filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20)
expect_error(monteCarloSimulation(family = "LR", n = 32L, filter = testfilter,
rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "LR", n = 32L,
rand.gen = function(data) {rnorm(31)}, filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 34L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 34L, r = 10L, filter = testfilter,
intervalSystem = "all"))
expect_error(monteCarloSimulation(family = "LR", output = "maximum", n = 32L, lengths = c(33L),
filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, penalty = "none",
filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", output = "maximum", n = 32L, r = 10L,
filter = testfilter),
monteCarloSimulation(family = "LR", output = "maximum", n = 32L, r = 10L,
penalty = "weights", filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = 32L, intervalsystem = "dyaPar",
filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = 32L, intervalSystem = "dyaPar",
filter = testfilter))
ret <- monteCarloSimulation(20L, family = "LR", filter = testfilter, r = 10L)
compare <- matrix(-Inf, ncol = 10, nrow = 20)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
expect_error(monteCarloSimulation(family = "LR", n = 32L, filter = unclass(testfilter)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, fit = stepblock(1)),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
startTime = 0, thresholdLongSegment = 10L, localValue = stats::median,
regularization = 1, suppressWarningNoDeconvolution = FALSE, localList = NULL),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = NA))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = c(0, 1)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = -100),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = 0.001),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, thresholdLongSegment = NA))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, thresholdLongSegment = -1L))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = c(10L, 23L)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = 10.5),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, thresholdLongSegment = 8L, save = FALSE)
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, thresholdLongSegment = 12L, save = FALSE)
testLR(testn = 30L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20)
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, localValue = 1))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, localValue = function() 1))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, localValue = function(a) NA))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
localValue = function(a) c(1, 2)))
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, localValue = mean, save = FALSE)
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, regularization = NULL))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, regularization = c(1, NA)))
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, regularization = 2, save = TRUE)
testLR(testn = 32L, testr = 10L, testseed = 1L, testfamily = "LR", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:20, regularization = c(2, 1), save = TRUE)
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = "s"))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = c(Inf, 3)))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = c(1, 0)))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 3
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
correlations = testcor),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
regularization = 2))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 2
ret <- monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter, correlations = testcor)
expect_true(attr(ret, "save"))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = 1))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = as.logical(NA)))
expect_error(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = c(TRUE, TRUE)))
expect_identical(monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = TRUE),
monteCarloSimulation(family = "LR", n = 32L, r = 10L, filter = testfilter))
})
test_that("family '2Param' works", {
testthat::skip_on_cran()
testfilter <- lowpassFilter::lowpassFilter(type = "bessel", param = list(pole = 4L, cutoff = 0.1), sr = 1e4)
expect_error(monteCarloSimulation(family = "2Param", filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = "s", filter = testfilter))
expect_identical(monteCarloSimulation(family = "2Param", n = 64, r = 3L, filter = testfilter),
monteCarloSimulation(family = "2Param", n = 64L, r = 3L, filter = testfilter))
expect_identical(monteCarloSimulation(family = "2Param", n = 64.5, r = 3L, filter = testfilter),
monteCarloSimulation(family = "2Param", n = 64L, r = 3L, filter = testfilter))
# only r = 2L, since it takes very long
# expect_equal(monteCarloSimulation(family = "2Param", n = 64L, filter = testfilter, r = 2L),
# monteCarloSimulation(n = 64L, r = 2L, seed = 64L, rand.gen = testrand.genJsmurf,
# family = "2Param", intervalSystem = "all", output = "vector",
# filter = testfilter), tolerance = 1e-14, check.attributes = FALSE)
test2Param(testn = 64L, testr = 2L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, filter = testfilter,
rand.gen = function(data, test) {rnorm(32)}))
expect_error(monteCarloSimulation(family = "2Param", n = 32L,
rand.gen = function(data) {rnorm(31)}, filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", output = "maximum", n = 32L, lengths = c(33L),
filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, intervalsystem = "dyaPar",
filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, intervalSystem = "dyaPar",
filter = testfilter))
ret <- monteCarloSimulation(20L, family = "2Param", filter = testfilter, r = 2L)
compare <- matrix(-Inf, ncol = 2, nrow = 20)
class(compare) <- "MCSimulationVector"
expect_equal(ret, compare, check.attributes = FALSE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, filter = unclass(testfilter)))
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter, fit = stepblock(1)),
monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter))
filter <- testfilter
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 2L, filter = testfilter,
startTime = 0, thresholdLongSegment = 25L, localValue = stats::median,
localVar = function(data) sdrobnorm(data, lag = filter$len + 1L)^2,
regularization = 1, suppressWarningNoDeconvolution = FALSE, localList = NULL),
monteCarloSimulation(family = "2Param", n = 64L, r = 2L, filter = testfilter))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = NA))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = c(0, 1)))
expect_identical(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = -0.001),
monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_identical(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = 100),
monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, startTime = 0))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = NA))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = -1L))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
thresholdLongSegment = c(10L, 23L)))
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter,
thresholdLongSegment = 25.5),
monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter))
test2Param(testn = 64L, testr = 2L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64, thresholdLongSegment = 20L, save = FALSE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, localValue = 1))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
localValue = function() 1))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localValue = function(a) NA))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localValue = function(a) c(1, 2)))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, localVar = 1))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
localVar = function() 1))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localVar = function(a) NA))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localVar = function(a) c(1, 2)))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
localVar = function(a) -1))
test2Param(testn = 64L, testr = 1L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64, localValue = mean, localVar = function(a) 1, save = FALSE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, regularization = NULL))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
regularization = c(1, NA)))
test2Param(testn = 64L, testr = 1L, testseed = 1L, testfamily = "2Param", tolerance = 1e-12,
testfilter = testfilter, allLengths = 1:64, regularization = c(2, 1), save = TRUE)
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, correlations = "s"))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, correlations = c(Inf, 3)))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter, correlations = c(1, 0)))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 3
expect_identical(monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter,
correlations = testcor),
monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter,
regularization = 2))
testcor <- testfilter$acf
testcor[1] <- testcor[1] * 2
ret <- monteCarloSimulation(family = "2Param", n = 64L, r = 1L, filter = testfilter, correlations = testcor)
expect_true(attr(ret, "save"))
expect_error(monteCarloSimulation(family = "2Param", n = 64L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = 1))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = as.logical(NA)))
expect_error(monteCarloSimulation(family = "2Param", n = 32L, r = 10L, filter = testfilter,
suppressWarningNoDeconvolution = c(TRUE, TRUE)))
})
Try the stepR 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.