Nothing
default_number <- RcppParallel::defaultNumThreads()
test_that("The number of cores for RcppParallel", {
expect_error(setCores("test"),
"Please enter valid type - but got character")
expect_error(setCores(0),
"The number of cores is not greater than 1 - but got 0")
expect_error(
setCores(default_number + 1),
cat(
"The input number of cores is invalid - default is ",
default_number
)
)
expect_true(setCores(default_number))
expect_null(setCores())
})
x_1D <- as.matrix(seq(-5, 5, length = 10))
x_2D <- matrix(c(1, 2), ncol = 2)
test_that("Scale locations", {
expect_equal(sum(scaleLocation(x_1D)), 5)
expect_equal(min(scaleLocation(x_1D)), 0)
expect_equal(max(scaleLocation(x_1D)), 1)
expect_equal(scaleLocation(x_2D), x_2D)
})
set.seed(1234)
tol <- 1e-6
num_cores <- 2
x_1D <- as.matrix(seq(-5, 5, length = 4))
Phi_1D <- exp(-x_1D ^ 2) / norm(exp(-x_1D ^ 2), "F")
Y_1D <- {
rnorm(n = 100, sd = 3) %*% t(Phi_1D) +
matrix(rnorm(n = 100 * 4), 100, 4)
}
cv_1D <- spatpca(x = x_1D, Y = Y_1D, num_cores = num_cores)
x_1Dnew <- as.matrix(seq(6, 7, length = 4))
# Test `predict`
test_that("check new locations for a spatpca object", {
expect_error(
checkNewLocationsForSpatpcaObject(NULL, NULL),
cat("Invalid object! Please enter a `spatpca` object")
)
expect_error(
checkNewLocationsForSpatpcaObject(cv_1D, NULL),
cat("New locations cannot be NULL")
)
expect_error(
checkNewLocationsForSpatpcaObject(cv_1D, matrix(c(1, 2), ncol = 2)),
cat("Inconsistent dimension of locations - original dimension is 1")
)
expect_null(checkNewLocationsForSpatpcaObject(cv_1D, x_1Dnew))
})
# Test invalid input
test_that("check input of spatpca", {
expect_error(
checkInputData(x = as.matrix(1), Y = Y_1D),
cat(
"The number of rows of x should be equal to the number of columns of Y."
)
)
expect_error(
checkInputData(x = matrix(1:10, ncol = 10), Y = matrix(1)),
cat("Number of locations must be larger than 2.")
)
expect_error(checkInputData(x = matrix(1:40, ncol = 10), Y = Y_1D),
cat("Dimension of locations must be less than 4."))
expect_error(
checkInputData(x = x_1D, Y = Y_1D, M = 1000),
cat("Number of folds must be less than sample size.")
)
})
# Test detrend
test_that("check detrending", {
expect_equal(detrend(Y_1D, FALSE), Y_1D)
expect_lte(sum(detrend(Y_1D, TRUE)), tol)
})
# Test tuning parameters
test_that("check the number of eigenfunctons", {
expect_equal(fetchUpperBoundNumberEigenfunctions(Y_1D, 5), 4)
expect_null(setNumberEigenfunctions(NULL, Y_1D, 5))
expect_warning(setNumberEigenfunctions(300, Y_1D, 5))
expect_warning(setNumberEigenfunctions(3, Y_1D, 5), NA)
})
test_that("check turning parameter - tau1", {
expect_equal(min(setTau1(NULL, 5)), 0)
expect_equal(max(setTau1(NULL, 5)), 1)
expect_lte(median(setTau1(NULL, 5)), 0.0004641589)
expect_equal(median(setTau1(NULL, 1)), 1)
expect_equal(setTau1(c(1, 2), 5), c(1, 2))
expect_equal(setTau1(c(1, 2), 1), 2)
})
test_that("check turning parameter - tau2", {
expect_equal(setTau2(NULL, 5), 0)
expect_equal(setTau2(NULL, 1), 0)
expect_equal(setTau2(c(1, 2), 5), c(1, 2))
expect_equal(setTau2(c(1, 2), 1), 2)
})
test_that("check inner turning parameter based on tau2 - l2", {
expect_equal(setL2(c(1, 2)), 1)
expect_equal(setL2(-1), 1)
expect_equal(max(setL2(1)), 1)
expect_equal(min(setL2(1)), 0)
expect_lte(median(setL2(1)) - 0.005994843, tol)
})
test_that("check turning parameter - gamma", {
expect_equal(setGamma(c(1, 2)), c(1, 2))
expect_lte(max(setGamma(NULL, Y_1D)) - 11.14708, tol)
expect_equal(min(setGamma(NULL, Y_1D)), 0)
expect_lte(median(setGamma(NULL, Y_1D)) - 0.06682497, tol)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.