Nothing
tests/testthat/test-extras.R
In spmodel: Spatial Statistical Modeling and Prediction
test_that("blank test", {
expect_null(NULL)
})
test_local <- FALSE # FALSE for CRAN
if (test_local) {
# SPMODEL PACKAGE NEEDS TO BE INSTALLED VIA DEVTOOLS::INSTALL() BEFORE RUNNING TESTS IF THOSE TESTS HAVE PARALLELIZATION
load(file = system.file("extdata", "exdata.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_M.rda", package = "spmodel"))
load(file = system.file("extdata", "newexdata.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_poly.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_Mpoly.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_Upoly.rda", package = "spmodel"))
##############################################################################
############################ AIC, AICc, BIC (test-aic.R)
##############################################################################
test_that("AIC and AICc works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
expect_error(AIC(spmod))
expect_error(AICc(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-cl")
expect_error(AIC(spmod))
expect_error(AICc(spmod))
expect_error(BIC(spmod))
})
test_that("AIC and AICc works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "reml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "ml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
})
test_that("AIC and AICc works for two models", {
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod1 <- splm(y ~ 1, exdata, spcov_type = "none", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
expect_error(AIC(spmod0, spmod1), NA)
expect_error(AICc(spmod0, spmod1), NA)
expect_error(BIC(spmod0, spmod1), NA)
})
test_that("Errors appropriately return", {
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
expect_error(AIC(spmod0))
expect_error(AICc(spmod0))
expect_error(BIC(spmod0))
expect_error(AIC(spmod0, spmod1))
expect_error(AICc(spmod0, spmod1))
expect_error(BIC(spmod0, spmod1))
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-cl")
expect_error(AIC(spmod0))
expect_error(AICc(spmod0))
expect_error(BIC(spmod0))
expect_error(AIC(spmod0, spmod1))
expect_error(AICc(spmod0, spmod1))
expect_error(BIC(spmod0, spmod1))
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod1 <- splm(y ~ 1, exdata, spcov_type = "none", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
expect_error(AICc(spmod0, spmod1, spmod0))
# removing tests after removing spmodel-specific AIC method
# expect_error(AIC(spmod0, spmod1, spmod0))
# expect_error(BIC(spmod0, spmod1, spmod0))
})
test_that("Warnings appropriately return", {
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod2 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
expect_warning(AICc(spmod0, spmod1))
expect_warning(AICc(spmod1, spmod2))
# removing tests after removing spmodel-specific AIC method
# expect_warning(AIC(spmod0, spmod1))
# expect_warning(AIC(spmod1, spmod2))
# expect_warning(BIC(spmod0, spmod1))
# expect_warning(BIC(spmod1, spmod2))
})
test_that("Matches for lm", {
spmod <- splm(y ~ x, exdata, "none", estmethod = "ml")
lmod <- lm(y ~ x, exdata)
expect_equal(AIC(spmod), AIC(lmod), tolerance = 0.001)
expect_equal(BIC(spmod), BIC(lmod), tolerance = 0.001)
})
##############################################################################
############################ anova (test-anova.R)
##############################################################################
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
# regular anova
expect_error(anova(spmod1), NA)
test_that("anova works geostatistical", {
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
spmod2 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
# regular anova
expect_error(anova(spmod1), NA)
expect_error(anova(spmod2), NA)
expect_error(anova(spmod1, spmod2), NA)
# LRT
expect_error(tidy(anova(spmod1)), NA)
expect_error(tidy(anova(spmod2)), NA)
expect_error(tidy(anova(spmod1, spmod2)), NA)
# Terms
expect_error(anova(spmod1, Terms = c("(Intercept)", "x")), NA)
expect_error(anova(spmod1, Terms = c(1, 2)), NA)
all.equal(anova(spmod1, Terms = c("(Intercept)", "x")), anova(spmod1, Terms = c(1, 2)))
# L
L <- diag(2)
expect_error(anova(spmod1, L = L), NA)
all.equal(anova(spmod1, L = L)$X2, anova(spmod1, Terms = c("(Intercept)", "x"))$X2)
})
test_that("anova works autoregressive", {
spmod1 <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "ml")
spmod2 <- spautor(y ~ 1, exdata_poly, spcov_type = "car", estmethod = "ml")
expect_error(anova(spmod1), NA)
expect_error(anova(spmod2), NA)
expect_error(anova(spmod1, spmod2), NA)
expect_error(tidy(anova(spmod1)), NA)
expect_error(tidy(anova(spmod2)), NA)
expect_error(tidy(anova(spmod1, spmod2)), NA)
})
test_that("Errors appropriately return", {
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod2 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod3 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
spmod4 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
# reml different fixed effects
expect_error(anova(spmod1, spmod2))
# reml vs ml
expect_error(anova(spmod2, spmod3))
# not reml and not ml
expect_error(anova(spmod2, spmod4))
})
##############################################################################
############################ augment (test-augment.R)
##############################################################################
test_that("augment works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(augment(spmod), NA)
expect_error(augment(spmod, se_fit = TRUE), NA)
expect_s3_class(augment(spmod), "tbl")
expect_error(augment(spmod, newdata = newexdata), NA)
augment(spmod, newdata = newexdata, interval = "confidence")
augment(spmod, newdata = newexdata, interval = "prediction")
expect_error(augment(spmod, newdata = newexdata, se_fit = TRUE), NA)
augment(spmod, newdata = newexdata, interval = "confidence", se_fit = TRUE)
augment(spmod, newdata = newexdata, interval = "prediction", se_fit = TRUE)
expect_s3_class(augment(spmod, newdata = newexdata), "tbl")
})
test_that("augment works auto", {
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
expect_error(augment(spmod), NA)
expect_error(augment(spmod, se_fit = TRUE), NA)
expect_s3_class(augment(spmod), "tbl")
expect_s3_class(augment(spmod), "sf")
expect_error(augment(spmod, newdata = spmod$newdata), NA)
augment(spmod, newdata = spmod$newdata, interval = "confidence")
augment(spmod, newdata = spmod$newdata, interval = "prediction")
expect_error(augment(spmod, newdata = spmod$newdata, se_fit = TRUE), NA)
augment(spmod, newdata = spmod$newdata, interval = "confidence", se_fit = TRUE)
augment(spmod, newdata = spmod$newdata, interval = "prediction", se_fit = TRUE)
expect_s3_class(augment(spmod, newdata = spmod$newdata), "tbl")
expect_s3_class(augment(spmod, newdata = spmod$newdata), "sf")
})
test_that("augment works with drop", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_equal(NCOL(aug_mod), 9)
aug_mod <- augment(spmod, drop = FALSE)
expect_equal(NCOL(aug_mod), 11)
aug_pred <- augment(spmod, newdata = newexdata)
expect_equal(NCOL(aug_pred), 6) # default drop = FALSE
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
aug_mod <- augment(spmod) # default drop = TRUE
expect_equal(NCOL(aug_mod), 8)
aug_mod <- augment(spmod, drop = FALSE)
expect_equal(NCOL(aug_mod), 11)
aug_pred <- augment(spmod, newdata = spmod$newdata)
expect_equal(NCOL(aug_pred), 7) # default drop = FALSE
})
test_that("augment works with types", {
exdata_sf <- sf::st_as_sf(exdata, coords = c("xcoord", "ycoord"), crs = 4326)
exdata_sf <- sf::st_transform(exdata_sf, crs = 5070)
newexdata_sf <- sf::st_as_sf(newexdata, coords = c("xcoord", "ycoord"), crs = 4326)
newexdata_sf <- sf::st_transform(exdata_sf, crs = 5070)
# newdata output type same as data output type
# df fit df pred
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata)
expect_true(inherits(aug_pred, "tbl"))
expect_false(inherits(aug_pred, "sf"))
# sf fit sf pred
spmod <- splm(y ~ x, exdata_sf, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata_sf)
expect_true(inherits(aug_pred, "tbl"))
expect_true(inherits(aug_pred, "sf"))
# df fit sf pred
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata_sf)
expect_true(inherits(aug_pred, "tbl"))
expect_false(inherits(aug_pred, "sf"))
# sf fit df pred
newexdata$.xcoord <- newexdata$xcoord
newexdata$.ycoord <- newexdata$ycoord
spmod <- splm(y ~ x, exdata_sf, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata)
expect_true(inherits(aug_pred, "tbl"))
expect_true(inherits(aug_pred, "sf"))
# sf in
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = spmod$newexdata)
expect_true(inherits(aug_pred, "tbl"))
expect_true(inherits(aug_pred, "sf"))
# df in
W <- 1 * sf::st_intersects(exdata_Mpoly, sparse = FALSE)
diag(W) <- 0
exdata_Mpoly_df <- st_drop_geometry(exdata_Mpoly)
spmod <- spautor(y ~ x, exdata_Mpoly_df, "car", W = W)
aug_mod <- augment(spmod)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = spmod$newdata)
expect_true(inherits(aug_pred, "tbl"))
expect_false(inherits(aug_pred, "sf"))
})
##############################################################################
############################ coef (test-coef.R)
##############################################################################
test_that("coef works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_null(coef(spmod, type = "randcov"))
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_null(coefficients(spmod, type = "randcov"))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, random = ~group)
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_error(coef(spmod, type = "randcov"), NA)
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_error(coefficients(spmod, type = "randcov"), NA)
})
test_that("coef works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_null(coef(spmod, type = "randcov"))
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_null(coefficients(spmod, type = "randcov"))
spmod <- spautor(y ~ x, exdata_poly, "car", random = ~group)
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_error(coef(spmod, type = "randcov"), NA)
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_error(coefficients(spmod, type = "randcov"), NA)
})
test_that("errors return", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(coef(spmod, type = "xyz"))
expect_error(coefficients(spmod, type = "xyz"))
})
##############################################################################
############################ confint (test-confint.R)
##############################################################################
test_that("confint works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(confint(spmod), NA)
expect_error(confint(spmod, parm = "(Intercept)", level = 0.99), NA)
expect_error(confint(spmod, parm = "x", level = 0.90), NA)
})
test_that("confint works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(confint(spmod), NA)
expect_error(confint(spmod, parm = "(Intercept)", level = 0.99), NA)
expect_error(confint(spmod, parm = "x", level = 0.90), NA)
})
##############################################################################
############################ cooks distance (test-cooks.distance.R)
##############################################################################
test_that("Cook's distance works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_vector(cooks.distance(spmod))
expect_true(min(cooks.distance(spmod)) >= 0)
})
test_that("Cook's distance works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_vector(cooks.distance(spmod))
expect_true(min(cooks.distance(spmod)) >= 0)
})
##############################################################################
############################ covmatrix (test-covmatrix.R)
##############################################################################
test_that("covmatrix works geostatistical", {
spcov_type <- "exponential"
spmod <- splm(y ~ x, exdata_M, spcov_type = spcov_type, xcoord = xcoord, ycoord = ycoord, random = ~group)
expect_equal(c(99, 99), dim(covmatrix(spmod)))
expect_equal(c(1, 99), dim(covmatrix(spmod, newdata = spmod$newdata)))
expect_equal(c(10, 99), dim(covmatrix(spmod, newdata = newexdata)))
})
test_that("covmatrix works autoregressive", {
spcov_type <- "car"
spmod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, random = ~group)
expect_equal(c(48, 48), dim(covmatrix(spmod)))
expect_equal(c(1, 48), dim(covmatrix(spmod, newdata = spmod$newdata)))
})
test_that("covmatrix works geostatistical", {
spcov_type <- "exponential"
spmod <- splm(y ~ x, exdata_M, spcov_type = spcov_type, xcoord = xcoord, ycoord = ycoord, partition_factor = ~group)
expect_equal(c(99, 99), dim(covmatrix(spmod)))
expect_equal(c(1, 99), dim(covmatrix(spmod, newdata = spmod$newdata)))
expect_equal(c(10, 99), dim(covmatrix(spmod, newdata = newexdata)))
})
test_that("covmatrix works autoregressive", {
spcov_type <- "car"
spmod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, partition_factor = ~group)
expect_equal(c(48, 48), dim(covmatrix(spmod)))
expect_equal(c(1, 48), dim(covmatrix(spmod, newdata = spmod$newdata)))
})
##############################################################################
############################ deviance (test-deviance.R)
##############################################################################
test_that("Deviance works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_vector(deviance(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
expect_vector(deviance(spmod))
})
test_that("Deviance works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_vector(deviance(spmod))
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "ml")
expect_vector(deviance(spmod))
})
test_that("Deviance errors", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
expect_error(deviance(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-cl")
expect_error(deviance(spmod))
})
##############################################################################
############################ esv (test-esv.R)
##############################################################################
test_that("esv works", {
# regular implementation
esv1 <- esv(y ~ x, exdata, xcoord, ycoord)
expect_s3_class(esv1, "esv")
expect_s3_class(esv1, "tbl_df")
expect_s3_class(esv1, "tbl")
expect_s3_class(esv1, "data.frame")
expect_equal(NROW(esv1), 15)
expect_equal(NCOL(esv1), 4)
esv1_q <- esv(y ~ x, exdata, "xcoord", "ycoord")
expect_s3_class(esv1_q, "esv")
expect_s3_class(esv1_q, "tbl_df")
expect_s3_class(esv1_q, "tbl")
expect_s3_class(esv1_q, "data.frame")
expect_equal(NROW(esv1_q), 15)
expect_equal(NCOL(esv1_q), 4)
# robust version implementation
esv1r <- esv(y ~ x, exdata, xcoord, ycoord, robust = TRUE)
expect_s3_class(esv1r, "esv")
expect_s3_class(esv1r, "tbl_df")
expect_s3_class(esv1r, "tbl")
expect_s3_class(esv1r, "data.frame")
expect_equal(NROW(esv1r), 15)
expect_equal(NCOL(esv1r), 4)
expect_true(!identical(esv1, esv1r))
expect_true(identical(esv1$bins, esv1r$bins))
expect_true(identical(esv1$dist, esv1r$dist))
expect_true(!identical(esv1$gamma, esv1r$gamma))
expect_true(identical(esv1$np, esv1r$np))
# quoting works (need to NULL out call attribute as that is different)
esv1_cn <- esv1
attr(esv1_cn, "call") <- NULL
esv1_q_cn <- esv1_q
attr(esv1_q_cn, "call") <- NULL
expect_equal(esv1_cn, esv1_q_cn)
# specifying bins and cutoff
esv2 <- esv(y ~ x, exdata, xcoord, ycoord, bins = 30, cutoff = 5)
expect_s3_class(esv2, "esv")
expect_s3_class(esv2, "tbl_df")
expect_s3_class(esv2, "tbl")
expect_s3_class(esv2, "data.frame")
expect_equal(NROW(esv2), 30)
expect_equal(NCOL(esv2), 4)
dist_matrix <- spdist(exdata, "xcoord", "ycoord")
# specifying distance matrix
esv3 <- esv(y ~ x, exdata, dist_matrix = dist_matrix)
expect_s3_class(esv3, "esv")
expect_s3_class(esv3, "tbl_df")
expect_s3_class(esv3, "tbl")
expect_s3_class(esv3, "data.frame")
expect_equal(NROW(esv3), 15)
expect_equal(NCOL(esv3), 4)
# specifying partition factor
esv4 <- esv(y ~ x, exdata, xcoord, ycoord, partition_factor = ~group)
expect_s3_class(esv4, "esv")
expect_s3_class(esv4, "tbl_df")
expect_s3_class(esv4, "tbl")
expect_s3_class(esv4, "data.frame")
expect_equal(NROW(esv4), 15)
expect_equal(NCOL(esv4), 4)
expect_false(identical(esv1, esv4)) # make sure results are not identical to full esv
# works with sf object
exdata_sf <- sf::st_as_sf(exdata, coords = c("xcoord", "ycoord"))
expect_error(esv(y ~ x, exdata_sf), NA)
esv5 <- esv(y ~ x, exdata_sf)
esv5_cn <- esv5
attr(esv5_cn, "call") <- NULL
expect_true(identical(esv1_cn, esv5_cn))
# works with one dimension
expect_error(esv(y ~ x, exdata, xcoord), NA)
# errors occur
expect_error(esv(y ~ x, exdata))
expect_error(esv(y ~ x, exdata, xcoord_xyz))
expect_error(esv(y ~ x, exdata, xcoord, ycoord_xyz))
# works with cloud argument
esv1c <- esv(y ~ x, exdata, xcoord, ycoord, cloud = TRUE)
expect_s3_class(esv1c, "esv")
expect_s3_class(esv1c, "tbl_df")
expect_s3_class(esv1c, "tbl")
expect_s3_class(esv1c, "data.frame")
expect_equal(NROW(esv1c), 3965)
expect_equal(NCOL(esv1c), 2)
# plot works
expect_error(plot(esv1), NA)
expect_error(plot(esv1, pch = 1), NA)
expect_error(plot(esv1c), NA)
expect_error(plot(esv1c, pch = 19), NA)
})
##############################################################################
############################ fitted (test-fitted.R)
##############################################################################
test_that("fitted distance works geostatistical", {
# no random effect
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_null(fitted(spmod, type = "randcov"))
expect_null(fitted.values(spmod, type = "randcov"))
# random effect
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, random = ~group)
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_vector(fitted(spmod, type = "randcov"))
expect_vector(fitted.values(spmod, type = "randcov"))
})
test_that("fitted distance works autoregressive", {
# no random effect
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_null(fitted(spmod, type = "randcov"))
expect_null(fitted.values(spmod, type = "randcov"))
# random effect
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", random = ~group)
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_vector(fitted(spmod, type = "randcov"))
expect_vector(fitted.values(spmod, type = "randcov"))
})
test_that("errors return", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(fitted(spmod, type = "xyz"))
expect_error(fitted.values(spmod, type = "xyz"))
})
##############################################################################
############################ formula (test-formula.R)
##############################################################################
test_that("formula works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_equal(formula(spmod), y ~ x)
spmod <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_equal(formula(spmod), y ~ 1)
})
test_that("formula works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_equal(formula(spmod), y ~ x)
spmod <- spautor(y ~ 1, exdata_poly, spcov_type = "car")
expect_equal(formula(spmod), y ~ 1)
})
##############################################################################
############################ FREE GENERICS (test-generics.R)
##############################################################################
test_that("free generics work geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_true(is.language(terms(spmod))) # works because there is an object spmod$terms
expect_true(is.call(getCall(spmod))) # works because there is an object spmod$call
})
test_that("free generics work geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_true(is.language(terms(spmod))) # works because there is an object spmod$terms
expect_true(is.call(getCall(spmod))) # works because there is an object spmod$call
expect_equal(update(formula(spmod), y ~ 1), y ~ 1) # works because formula(object) works (object has class spmod)
spmod <- update(spmod, y ~ 1, spcov_type = "spherical")
expect_s3_class(spmod, "splm")
expect_equal(formula(spmod), y ~ 1)
expect_s3_class(coefficients(spmod, type = "spcov"), "spherical")
spmod <- update(spmod, . ~ . + offset(x))
expect_vector(model.offset(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
expect_vector(model.response(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
})
test_that("free generics work autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_true(is.language(terms(spmod))) # works because there is an object spmod$terms
expect_true(is.call(getCall(spmod))) # works because there is an object spmod$call
expect_equal(update(formula(spmod), y ~ 1), y ~ 1) # works because formula(object) works (object has class spmod)
spmod <- update(spmod, y ~ 1, spcov_type = "sar")
expect_s3_class(spmod, "spautor")
expect_equal(formula(spmod), y ~ 1)
expect_s3_class(coefficients(spmod, type = "spcov"), "sar")
spmod <- update(spmod, . ~ . + offset(x))
expect_vector(model.offset(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
expect_vector(model.response(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
})
##############################################################################
############################ glance (test-glance.R)
##############################################################################
test_that("glance works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_s3_class(glance(spmod), "tbl")
expect_equal(NROW(glance(spmod)), 1)
expect_equal(NCOL(glance(spmod)), 10)
expect_false(any(is.na(glance(spmod))))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "sv-wls")
expect_s3_class(glance(spmod), "tbl")
expect_equal(NROW(glance(spmod)), 1)
expect_equal(NCOL(glance(spmod)), 10)
expect_true(any(is.na(glance(spmod))))
})
test_that("glance works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_s3_class(glance(spmod), "tbl")
expect_equal(NCOL(glance(spmod)), 10)
expect_false(any(is.na(glance(spmod))))
})
##############################################################################
############################ glances (test-glances.R)
##############################################################################
test_that("glances works geostatistical", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
spmod2 <- splm(y ~ x, exdata, "matern", xcoord, ycoord)
expect_s3_class(glances(spmod1, spmod2), "tbl")
expect_equal(NROW(glances(spmod1, spmod2)), 2)
expect_equal(NCOL(glances(spmod1, spmod2)), 11)
expect_equal(rbind(glance(spmod1), glance(spmod2)), glances(spmod1, spmod2)[, -1], ignore_attr = TRUE)
})
test_that("glances works autoregressive", {
spmod1 <- spautor(y ~ x, exdata_poly, "car")
spmod2 <- spautor(y ~ x, exdata_poly, "sar")
expect_s3_class(glances(spmod1, spmod2), "tbl")
expect_equal(NROW(glances(spmod1, spmod2)), 2)
expect_equal(NCOL(glances(spmod1, spmod2)), 11)
expect_equal(rbind(glance(spmod2), glance(spmod1)), glances(spmod1, spmod2)[, -1], ignore_attr = TRUE)
})
test_that("glances works iteratively splm spcov_type", {
spmod <- splm(y ~ x, exdata, c("exponential", "matern"), xcoord, ycoord)
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$exponential), glance(spmod$matern)), glances(spmod)[, -1], ignore_attr = TRUE)
})
test_that("glances works iteratively splm spcov_initial", {
spcov_init <- lapply(c("exponential", "matern"), function(x) spcov_initial(x, de = 1))
spmod <- splm(y ~ x, exdata, spcov_initial = spcov_init, xcoord = xcoord, ycoord = ycoord)
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$spcov_initial_1), glance(spmod$spcov_initial_2)), glances(spmod)[, -1], ignore_attr = TRUE)
})
test_that("glances works iteratively spautor spcov_type", {
spmod <- spautor(y ~ x, exdata_poly, c("car", "sar"))
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$car), glance(spmod$sar)), glances(spmod, sort_by = "order")[, -1], ignore_attr = TRUE)
# sort by order here because sort by is off in natural implementation by AICc
})
test_that("glances works iteratively spautor spcov_initial", {
spcov_init <- lapply(c("car", "sar"), function(x) spcov_initial(x, de = 1))
spmod <- spautor(y ~ x, exdata_poly, spcov_initial = spcov_init)
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$spcov_initial_1), glance(spmod$spcov_initial_2)), glances(spmod, sort_by = "order")[, -1], ignore_attr = TRUE)
})
test_that("glances throws proper warnings", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
spmod2 <- splm(y ~ x, exdata, "matern", xcoord, ycoord)
expect_warning(glances(spmod1, spmod2), NA)
spmod3 <- splm(y ~ 1, exdata, "exponential", xcoord, ycoord, estmethod = "ml")
expect_warning(glances(spmod1, spmod2, spmod3))
expect_warning(glances(spmod1, spmod2, spmod3, warning = FALSE), NA)
spmod4 <- splm(y ~ 1, exdata, "spherical", xcoord, ycoord, estmethod = "reml")
expect_warning(glances(spmod1, spmod2, spmod3))
expect_warning(glances(spmod1, spmod2, spmod3, warning = FALSE), NA)
spmod5 <- splm(y ~ 1, exdata, "spherical", xcoord, ycoord, estmethod = "sv-wls")
spmod6 <- splm(y ~ 1, exdata, "gaussian", xcoord, ycoord, estmethod = "sv-cl")
expect_warning(glances(spmod1, spmod2, spmod5, spmod6), NA)
spmod7 <- splm(y ~ x, exdata[-1, ], "exponential", xcoord, ycoord)
expect_warning(glances(spmod1, spmod7))
# glm families
spgmod1 <- spglm(y > 0 ~ x, data = exdata, family = "binomial", "exponential", xcoord, ycoord)
spgmod2 <- spglm(abs(y) / 10 ~ x, exdata, family = "beta", "exponential", xcoord, ycoord)
spgmod3 <- spglm(round(abs(y)) ~ x, exdata, family = "poisson", "exponential", xcoord, ycoord)
spgmod4 <- spglm(round(abs(y)) ~ x, exdata, family = "nbinomial", "exponential", xcoord, ycoord)
spgmod5 <- spglm(abs(y) ~ x, exdata, family = "Gamma", "exponential", xcoord, ycoord)
spgmod6 <- spglm(abs(y) ~ x, exdata, family = "inverse.gaussian", "exponential", xcoord, ycoord)
## no warnings
expect_warning(glances(spgmod1, spgmod1), NA)
expect_warning(glances(spgmod2, spgmod2), NA)
expect_warning(glances(spgmod3, spgmod3), NA)
expect_warning(glances(spgmod4, spgmod4), NA)
expect_warning(glances(spgmod5, spgmod5), NA)
expect_warning(glances(spgmod6, spgmod6), NA)
expect_warning(glances(spgmod3, spgmod4), NA)
expect_warning(glances(spgmod5, spgmod6), NA)
## warnings
expect_warning(glances(spgmod1, spgmod2))
expect_warning(glances(spgmod1, spgmod3))
expect_warning(glances(spgmod1, spgmod4))
expect_warning(glances(spgmod1, spgmod5))
expect_warning(glances(spgmod1, spgmod6))
expect_warning(glances(spgmod2, spgmod3))
expect_warning(glances(spgmod2, spgmod4))
expect_warning(glances(spgmod2, spgmod5))
expect_warning(glances(spgmod2, spgmod6))
expect_warning(glances(spgmod3, spgmod5))
expect_warning(glances(spgmod3, spgmod6))
expect_warning(glances(spgmod4, spgmod5))
expect_warning(glances(spgmod4, spgmod6))
})
##############################################################################
############################ hatvalues (test-hatvalues.R)
##############################################################################
test_that("hatvalues works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(hatvalues(spmod))
expect_true(min(hatvalues(spmod)) >= 0)
expect_true(max(hatvalues(spmod)) <= 1)
expect_equal(sum(hatvalues(spmod)), spmod$p)
})
test_that("hatvalues works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(hatvalues(spmod))
expect_true(min(hatvalues(spmod)) >= 0)
expect_true(max(hatvalues(spmod)) <= 1)
expect_equal(sum(hatvalues(spmod)), spmod$p)
})
##############################################################################
############################ influence (test-influence.R)
##############################################################################
test_that("influence works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(influence(spmod), NA)
expect_equal(NROW(influence(spmod)), 100)
expect_equal(NCOL(influence(spmod)), 4)
expect_equal(colnames(influence(spmod)), c(".resid", ".hat", ".cooksd", ".std.resid"))
expect_s3_class(influence(spmod), "tbl")
})
test_that("influence works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(influence(spmod), NA)
expect_equal(NROW(influence(spmod)), 49)
expect_equal(NCOL(influence(spmod)), 4)
expect_equal(colnames(influence(spmod)), c(".resid", ".hat", ".cooksd", ".std.resid"))
expect_s3_class(influence(spmod), "tbl")
})
##############################################################################
############################ labels (test-labels.R)
##############################################################################
test_that("labels works geostatistical", {
spmod <- splm(y ~ x + group, exdata, "exponential", xcoord, ycoord)
expect_equal(labels(spmod), c("x", "group"))
})
test_that("labels works autoregressive", {
spmod <- spautor(y ~ x + group, exdata_poly, "car")
expect_equal(labels(spmod), c("x", "group"))
})
##############################################################################
############################ logLik (test-logLik.R)
##############################################################################
test_that("logLik works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(logLik(spmod))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "ml")
expect_vector(logLik(spmod))
})
test_that("logLik works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(logLik(spmod))
spmod <- spautor(y ~ x, exdata_poly, "car", estmethod = "ml")
expect_vector(logLik(spmod))
})
test_that("logLik appropriately errors", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "sv-wls")
expect_error(logLik(spmod))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "sv-cl")
expect_error(logLik(spmod))
})
##############################################################################
############################ loocv (test-loocv.R)
##############################################################################
test_that("loocv works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# cores 2 for cran check
if (test_local) { ##### local test
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = TRUE)), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE)), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = TRUE)), 2)
}
# cores 2 for cran check
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, method = "all", ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, method = "all", ncores = 2))), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, method = "all", ncores = 2))), 2)
}
# random effects
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, random = ~group)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# iid
spmod <- splm(y ~ x, exdata, "none", xcoord, ycoord)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# cores 2 for cran check
if (test_local) { ##### local test
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE)), 2)
}
# cores 2 for cran check
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
})
test_that("loocv works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_type(loocv(spmod), "list")
# cores 2 for cran check
if (test_local) {
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
# cores 2 for cran check
if (test_local) {
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
# random effects
spmod <- spautor(y ~ x, exdata_poly, "car", random = ~group)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# missing data
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
expect_type(loocv(spmod), "list")
# cores 2 for cran check
if (test_local) {
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
# cores 2 for cran check
if (test_local) {
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
})
##############################################################################
############################ model.frame (test-model.frame.R)
##############################################################################
test_that("model.frame works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_equal(NCOL(model.frame(spmod)), 2)
expect_equal(NROW(model.frame(spmod)), 100)
expect_equal(model.frame(spmod), model.frame(y ~ x, exdata, drop.unused.levels = TRUE, na.action = na.omit))
})
test_that("model.frame works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_equal(NCOL(model.frame(spmod)), 2)
expect_equal(NROW(model.frame(spmod)), 49)
expect_equal(model.frame(spmod), model.frame(y ~ x, exdata_poly, drop.unused.levels = TRUE, na.action = na.omit))
})
##############################################################################
############################ model.matrix (test-model.matrix.R)
##############################################################################
test_that("model.matrix works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_equal(NCOL(model.matrix(spmod)), 2)
expect_equal(NROW(model.matrix(spmod)), 100)
expect_equal(model.matrix(spmod), model.matrix(y ~ x, model.frame(y ~ x, exdata, drop.unused.levels = TRUE, na.action = na.omit)))
})
test_that("model.matrix works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_equal(NCOL(model.matrix(spmod)), 2)
expect_equal(NROW(model.matrix(spmod)), 49)
expect_equal(model.matrix(spmod), model.matrix(y ~ x, model.frame(y ~ x, exdata_poly, drop.unused.levels = TRUE, na.action = na.omit)))
})
##############################################################################
############################ plot (test-plot.R)
##############################################################################
test_that("plot works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
# plot 1
expect_error(plot(spmod, which = 1), NA)
# plot 2
expect_error(plot(spmod, which = 2), NA)
# plot 3
expect_error(plot(spmod, which = 3), NA)
# plot 4
expect_error(plot(spmod, which = 4), NA)
# plot 5
expect_error(plot(spmod, which = 5), NA)
# plot 6
expect_error(plot(spmod, which = 6), NA)
# plot 7
expect_error(plot(spmod, which = 7), NA)
# plot 8
expect_error(plot(spmod, which = 8), NA)
# plot 9 (return error)
expect_error(plot(spmod, which = 9))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, anisotropy = TRUE)
# plot 8
expect_error(plot(spmod, which = 8), NA)
})
test_that("plot works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
# plot 1
expect_error(plot(spmod, which = 1), NA)
# plot 2
expect_error(plot(spmod, which = 2), NA)
# plot 3
expect_error(plot(spmod, which = 3), NA)
# plot 4
expect_error(plot(spmod, which = 4), NA)
# plot 5
expect_error(plot(spmod, which = 5), NA)
# plot 6
expect_error(plot(spmod, which = 6), NA)
# plot 7
expect_error(plot(spmod, which = 7))
# plot 8
expect_error(plot(spmod, which = 8))
})
##############################################################################
############################ predict (test-predict.R)
##############################################################################
test_that("Prediction for splm works", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for splm works anisotropy", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", anisotropy = TRUE)
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for splm works with random effects", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", random = ~group)
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
# variable with new level
newexdata2 <- newexdata
newexdata2$group <- as.factor(seq_len(NROW(newexdata2)))
expect_error(predict(smod, newexdata2), NA)
expect_error(predict(smod, newexdata2, interval = "prediction"), NA)
expect_error(predict(smod, newexdata2, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata2)), NROW(newexdata))
expect_true(all(predict(smod, newexdata2, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for splm works with partition factor", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", partition_factor = ~group)
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
# variable with new level
newexdata2 <- newexdata
newexdata2$group <- as.factor(seq_len(NROW(newexdata2)))
expect_error(predict(smod, newexdata2), NA)
expect_error(predict(smod, newexdata2, interval = "prediction"), NA)
expect_error(predict(smod, newexdata2, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata2)), NROW(newexdata))
expect_true(all(predict(smod, newexdata2, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction works for big data", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod, newexdata), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
# big data
expect_error(predict(smod, newexdata, local = TRUE), NA)
expect_error(predict(smod, newexdata, interval = "prediction", local = TRUE), NA)
expect_error(predict(smod, newexdata, interval = "confidence", local = TRUE), NA)
# CRAN FIXES CORES AT 2 MAX
expect_error(predict(smod, newexdata, local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, newexdata, interval = "prediction", local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, newexdata, interval = "confidence", local = list(parallel = TRUE, ncores = 2)), NA)
expect_equal(length(predict(smod, newexdata, local = TRUE)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, local = TRUE, se.fit = TRUE)$se.fit >= 0))
expect_error(predict(smod, newexdata, local = list(method = "distance")), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "distance"))), NROW(newexdata))
expect_error(predict(smod, newexdata, local = list(method = "covariance")), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "covariance"))), NROW(newexdata))
expect_error(predict(smod, newexdata, local = list(method = "distance", size = 10)), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "distance", size = 10))), NROW(newexdata))
expect_error(predict(smod, newexdata, local = list(method = "covariance", size = 10)), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "covariance", size = 10))), NROW(newexdata))
# random effects
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", random = ~ group)
expect_error(predict(smod, newexdata), NA)
# anisotropy
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", anisotropy = TRUE)
expect_error(predict(smod, newexdata), NA)
# partition factor
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", partition_factor = ~ group)
expect_error(predict(smod, newexdata), NA)
})
test_that("Prediction for splm works for missing data", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata_M, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_M$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works parallel", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml")
# CRAN FIXES CORES AT 2 MAX
expect_error(predict(smod, local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, interval = "prediction", local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, interval = "confidence", local = list(parallel = TRUE, ncores = 2)), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works with random effects", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml", random = ~group)
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works with partition factor", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml", partition = ~group)
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction works for other covariances", {
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "exponential", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "spherical", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "gaussian", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, spcov_type = "triangular", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "circular", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "none", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "cubic", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "pentaspherical", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, spcov_type = "cosine", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "wave", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "jbessel", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "gravity", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "rquad", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "magnetic", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "matern", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "cauchy", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "pexponential", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = "car", estmethod = "reml")
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = "sar", estmethod = "reml")
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
})
test_that("errors occur", {
spcov_type <- "exponential"
spmod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(spmod))
expect_error(predict(spmod, newexdata = newexdata, local = list(method = "xyz")))
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(predict(spmod))
})
test_that("prediction values match for both approaches", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ x, exdata_with_NA, "exponential", xcoord, ycoord)
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
spmod1 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata_with_NA, "exponential", xcoord, ycoord)
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
spmod1 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata_with_NA, "exponential", xcoord, ycoord)
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
})
test_that("prediction values match for both and lm comparison", {
# no poly
spmod1 <- splm(y ~ x, exdata, "none")
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ x, exdata_with_NA, "none")
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
## compare lm
lmod1 <- lm(y ~ x, exdata)
lmpred1 <- predict(lmod1, newexdata)
expect_equal(unname(pred1), unname(lmpred1))
# poly raw
spmod1 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata, "none")
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata_with_NA, "none")
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
## compare lm
lmod1 <- lm(y ~ poly(x, degree = 2, raw = TRUE), exdata)
lmpred1 <- predict(lmod1, newexdata)
expect_equal(unname(pred1), unname(lmpred1))
# poly no raw
spmod1 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata, "none")
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata_with_NA, "none")
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
## compare lm
lmod1 <- lm(y ~ poly(x, degree = 2, raw = FALSE), exdata)
lmpred1 <- predict(lmod1, newexdata)
expect_equal(unname(pred1), unname(lmpred1))
# terms matches
pt_spmod1 <- predict(spmod1, newdata = newexdata, type = "terms")
pt_lmod1 <- predict(lmod1, newdata = newexdata, type = "terms")
expect_equal(pt_spmod1, pt_lmod1, tolerance = 0.01)
expect_equal(attr(pt_spmod1, "constant"), attr(pt_lmod1, "constant"), tolerance = 0.01)
pt_spmod1 <- predict(spmod1, newdata = newexdata, type = "terms", se.fit = TRUE, interval = "confidence")
pt_lmod1 <- predict(spmod1, newdata = newexdata, type = "terms", se.fit = TRUE, interval = "confidence")
expect_true(all(names(pt_spmod1) %in% names(pt_lmod1)))
expect_equal(pt_spmod1$fit, pt_lmod1$fit, tolerance = 0.01)
expect_equal(attr(pt_spmod1$fit, "constant"), attr(pt_lmod1$fit, "constant"), tolerance = 0.01)
expect_equal(pt_spmod1$se.fit, pt_lmod1$se.fit, tolerance = 0.01)
# both attributes are null when returning se (i.e., for se, there is no constant attribute)
expect_equal(attr(pt_spmod1$se, "constant"), attr(pt_lmod1$se, "constant"), tolerance = 0.01)
expect_equal(pt_spmod1$lwr, pt_lmod1$lwr, tolerance = 0.01)
expect_equal(attr(pt_spmod1$lwr, "constant"), attr(pt_lmod1$lwr, "constant"), tolerance = 0.01)
expect_equal(pt_spmod1$upr, pt_lmod1$upr, tolerance = 0.01)
expect_equal(attr(pt_spmod1$upr, "constant"), attr(pt_lmod1$upr, "constant"), tolerance = 0.01)
})
test_that("prediction values match for both approaches autoregressive", {
spmod1 <- spautor(y ~ poly(x, degree = 2, raw = TRUE), exdata_Mpoly, "car")
expect_error(predict(spmod1), NA)
spmod1 <- spautor(y ~ poly(x, degree = 2, raw = FALSE), exdata_Mpoly, "car")
expect_error(predict(spmod1), NA)
})
test_that("prediction no error with order 2 polynomial one prediction row", {
# there is a bug in lm() trying to do the same thing
spmod <- splm(y ~ poly(xcoord, ycoord, degree = 1), exdata, "none")
expect_error(predict(spmod, newdata = newexdata), NA)
expect_error(predict(spmod, newdata = newexdata[1, , drop = FALSE]), NA)
expect_equal(predict(spmod, newdata = newexdata)[[1]], predict(spmod, newdata = newexdata[1, , drop = FALSE])[[1]])
# there is a bug in lm() trying to do the same thing
spmod <- splm(y ~ poly(xcoord, ycoord, degree = 1), exdata, "exponential", xcoord, ycoord)
expect_error(predict(spmod, newdata = newexdata), NA)
expect_error(predict(spmod, newdata = newexdata[1, , drop = FALSE]), NA)
expect_equal(predict(spmod, newdata = newexdata)[[1]], predict(spmod, newdata = newexdata[1, , drop = FALSE])[[1]])
# there is a bug in lm() trying to do the same thing
exdata_Mpoly$x2 <- rnorm(NROW(exdata_Mpoly))
spmod <- spautor(y ~ poly(x, x2, degree = 1), exdata_Mpoly, "car")
expect_error(predict(spmod), NA)
})
test_that("prediction works when newdata does not have all factor levels", {
# geostatistical
spmod <- splm(y ~ group, exdata, "exponential", xcoord, ycoord)
newexdata_sub <- newexdata[1, , drop = FALSE]
newexdata_sub$group <- as.character(newexdata_sub$group)
expect_error(predict(spmod, newexdata_sub), NA)
# autoregressive
exdata_Mpoly_new <- exdata_Mpoly
exdata_Mpoly_new$group <- as.character(exdata_Mpoly_new$group)
spmod <- spautor(y ~ group, exdata_Mpoly_new, "car")
expect_error(predict(spmod), NA)
})
test_that("prediction for splmRF works", {
spcov_type <- "exponential"
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod, newdata = newexdata))
exdata$y[1] <- NA
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod))
spcov_type <- c("exponential", "matern")
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod, newdata = newexdata)[[1]])
expect_vector(predict(sprfmod, newdata = newexdata)[[2]])
exdata$y[1] <- NA
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod)[[1]])
expect_vector(predict(sprfmod)[[2]])
})
test_that("prediction for spautorRF works", {
spcov_type <- "car"
sprfmod <- spautorRF(y ~ x, exdata_Mpoly, spcov_type = spcov_type)
expect_vector(predict(sprfmod))
spcov_type <- c("car", "sar")
sprfmod <- spautorRF(y ~ x, exdata_Mpoly, spcov_type = spcov_type)
expect_vector(predict(sprfmod))
expect_vector(predict(sprfmod)[[1]])
expect_vector(predict(sprfmod)[[2]])
})
test_that("prediction for splm offset works", {
exdata$offset <- 2
exdata$y2 <- exdata$y - exdata$offset
newexdata$offset <- 2
spmod1 <- splm(y ~ x + offset(offset), exdata, "exponential", xcoord, ycoord)
spmod2 <- splm(y2 ~ x, exdata, "exponential", xcoord, ycoord)
expect_equal(fitted(spmod1), fitted(spmod2) + exdata$offset)
})
test_that("prediction for spautor offset works", {
exdata_Mpoly$offset <- 2
exdata_Mpoly$y2 <- exdata_Mpoly$y - exdata_Mpoly$offset
spmod1 <- spautor(y ~ x + offset(offset), exdata_Mpoly, "car")
spmod2 <- spautor(y2 ~ x, exdata_Mpoly, "car")
expect_equal(fitted(spmod1), fitted(spmod2) + exdata_Mpoly$offset[!is.na(exdata_Mpoly$y)])
})
test_that("prediction for splm scale/df works", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newexdata, se.fit = TRUE, scale = 1, interval = "prediction")
pred2 <- predict(spmod1, newexdata, se.fit = TRUE, interval = "prediction")
expect_equal(pred1, pred2, tolerance = .01)
pred1 <- predict(spmod1, newexdata, se.fit = TRUE, scale = 2)
pred2 <- predict(spmod1, newexdata, se.fit = TRUE)
expect_equal(pred1$fit, pred2$fit, tolerance = 0.01)
expect_equal(pred1$se.fit / 2, pred2$se.fit, tolerance = 0.01)
df <- 4
pred1 <- predict(spmod1, newexdata, se.fit = TRUE, scale = 1, df = df, interval = "confidence")
pred2 <- predict(spmod1, newexdata, se.fit = TRUE, interval = "confidence")
expect_equal(pred1$fit[, "fit"], pred2$fit[, "fit"], tolerance = 0.01)
expect_equal(pred1$se.fit, pred2$se.fit, tolerance = 0.01)
level <- 0.95
tcrit <- qt(1 - (1 - level) / 2, df = df)
expect_equal(as.vector(pred1$fit[, "lwr"]), as.vector(pred2$fit[, "fit"] - tcrit * pred2$se.fit), tolerance = 0.01)
expect_equal(as.vector(pred1$fit[, "upr"]), as.vector(pred2$fit[, "fit"] + tcrit * pred2$se.fit), tolerance = 0.01)
})
##############################################################################
############################ print (test-print.R)
##############################################################################
test_that("printing works for geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_output(print(spmod))
expect_output(print(summary(spmod)))
expect_output(print(anova(spmod)))
})
test_that("printing works for auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_output(print(spmod))
expect_output(print(summary(spmod)))
expect_output(print(anova(spmod)))
})
##############################################################################
############################ pseudoR2 (test-pseudoR2.R)
##############################################################################
test_that("pseudoR2 works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(pseudoR2(spmod))
expect_vector(pseudoR2(spmod, adjust = TRUE))
})
test_that("pseudoR2 works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(pseudoR2(spmod))
expect_vector(pseudoR2(spmod, adjust = TRUE))
})
test_that("pseudoR2 matches classical r-squared", {
lmod <- lm(y ~ x, exdata)
spmod <- splm(y ~ x, exdata, "none")
expect_equal(summary(lmod)$r.squared, pseudoR2(spmod))
expect_equal(summary(lmod)$adj.r.squared, pseudoR2(spmod, adjust = TRUE))
})
##############################################################################
############################ residuals (test-residuals.R)
##############################################################################
test_that("residuals works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(residuals(spmod))
expect_equal(residuals(spmod), exdata$y - fitted(spmod))
expect_vector(residuals(spmod, type = "response"))
expect_vector(residuals(spmod, type = "pearson"))
expect_vector(residuals(spmod, type = "standardized"))
expect_equal(residuals(spmod, type = "standardized"), rstandard(spmod))
})
test_that("residuals works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(residuals(spmod))
expect_equal(residuals(spmod), exdata_poly$y - fitted(spmod))
expect_vector(residuals(spmod, type = "response"))
expect_vector(residuals(spmod, type = "pearson"))
expect_vector(residuals(spmod, type = "standardized"))
expect_equal(residuals(spmod, type = "standardized"), rstandard(spmod))
})
################################################################################
############################ sp_objects (test-sp_objects.R)
################################################################################
test_that("sp object error tests geostatistical", {
# first we make "fake" sp objects that can be loaded without also loading sp
exdata_sp <- exdata
attr(class(exdata_sp), "package") <- "sp"
expect_error(splm(y ~ x, exdata_sp, "exponential", xcoord = xcoord, ycoord = ycoord))
expect_error(esv(y ~ x, exdata_sp, xcoord = xcoord, ycoord = ycoord))
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_error(sprnorm(spcov_params_val, data = exdata_sp, xcoord = xcoord, ycoord = ycoord))
spmod <- splm(y ~ x, exdata, "exponential", xcoord = xcoord, ycoord = ycoord)
newexdata_sp <- newexdata
attr(class(newexdata_sp), "package") <- "sp"
expect_error(predict(spmod, newexdata_sp))
expect_error(augment(spmod, newdata = newexdata_sp))
})
test_that("sp object error tests autoregressive", {
# first we make "fake" sp objects that can be loaded without also loading sp
exdata_poly_sp <- exdata_poly
attr(class(exdata_poly_sp), "package") <- "sp"
expect_error(spautor(y ~ x, exdata_poly_sp, "car"))
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 0.5, extra = 0)
expect_error(sprnorm(spcov_params_val, data = exdata_poly_sp))
})
##############################################################################
############################ sprnorm (test-sprnorm.R)
##############################################################################
test_that("the simulation runs for exponential", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for exponential anisotropy", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord, anisotropy = TRUE))
})
test_that("the simulation runs for exponential random effect", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
randcov_params_val <- randcov_params(group = 1)
expect_vector(sprnorm(spcov_params_val,
data = exdata, xcoord = xcoord, ycoord = ycoord,
random = ~group, randcov_params = randcov_params_val
))
})
test_that("the simulation runs for exponential partitioning", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord, partition_factor = ~group))
})
test_that("the simulation runs for exponential (matrix)", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
sprnorm_matrix <- sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord, samples = 5)
expect_equal(nrow(sprnorm_matrix), nrow(exdata))
expect_equal(ncol(sprnorm_matrix), 5)
})
test_that("the simulation runs for car", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly))
})
test_that("the simulation runs for car unconnected", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata_Upoly))
})
test_that("the simulation runs for none random effect", {
spcov_params_val <- spcov_params("none", ie = 1)
randcov_params_val <- randcov_params(group = 1)
expect_vector(sprnorm(spcov_params_val,
data = exdata, xcoord = xcoord, ycoord = ycoord,
random = ~group, randcov_params = randcov_params_val
))
})
test_that("the simulation runs for car random effects", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly))
randcov_params_val <- randcov_params(group = 1)
expect_vector(sprnorm(spcov_params_val,
data = exdata_poly, xcoord = xcoord, ycoord = ycoord,
random = ~group, randcov_params = randcov_params_val
))
})
test_that("the simulation runs for car partition factor", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly, partition_factor = ~group))
})
test_that("the simulation runs for spherical", {
spcov_params_val <- spcov_params("spherical", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for gaussian", {
spcov_params_val <- spcov_params("gaussian", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for triangular", {
spcov_params_val <- spcov_params("triangular", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord))
})
test_that("the simulation runs for circular", {
spcov_params_val <- spcov_params("circular", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for cubic", {
spcov_params_val <- spcov_params("cubic", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for pentaspherical", {
spcov_params_val <- spcov_params("pentaspherical", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for cosine", {
spcov_params_val <- spcov_params("cosine", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord))
})
test_that("the simulation runs for wave", {
spcov_params_val <- spcov_params("wave", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for jbessel", {
spcov_params_val <- spcov_params("jbessel", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for gravity", {
spcov_params_val <- spcov_params("gravity", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for rquad", {
spcov_params_val <- spcov_params("rquad", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for magnetic", {
spcov_params_val <- spcov_params("magnetic", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for none", {
spcov_params_val <- spcov_params("none", ie = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4))
})
test_that("the simulation runs for matern", {
spcov_params_val <- spcov_params("matern", de = 1, ie = 1, range = 1, extra = 1 / 2)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for cauchy", {
spcov_params_val <- spcov_params("cauchy", de = 1, ie = 1, range = 1, extra = 1 / 2)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for pexponential", {
spcov_params_val <- spcov_params("pexponential", de = 1, ie = 1, range = 1, extra = 1 / 2)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for sar", {
spcov_params_val <- spcov_params("sar", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly))
})
test_that("the simulation runs for sar unconnected", {
spcov_params_val <- spcov_params("sar", de = 1, ie = 1, range = 1 / 2, extra = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata_Upoly))
})
test_that("quoting works", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = "xcoord", ycoord = "ycoord"))
})
test_that("sf works", {
exdata_sf <- sf::st_as_sf(exdata, coords = c("xcoord", "ycoord"))
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata_sf))
})
##############################################################################
############################ summary (test-summary.R)
##############################################################################
test_that("summary works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(summary(spmod), NA)
})
test_that("summary works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(summary(spmod), NA)
})
##############################################################################
############################ tidy (test-tidy.R)
##############################################################################
test_that("tidy works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_null(tidy(spmod, effects = "randcov"))
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
test_that("tidy works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, random = ~group)
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_s3_class(tidy(spmod, effects = "randcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "randcov")), 3)
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
test_that("tidy works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_null(tidy(spmod, effects = "randcov"))
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
test_that("tidy works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car", random = ~group)
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_s3_class(tidy(spmod, effects = "randcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "randcov")), 3)
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
##############################################################################
############################ varcomp (test-varcomp.R)
##############################################################################
test_that("varcomp works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 3)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works geostatistical random", {
spmod <- splm(y ~ x, exdata,
spcov_type = "exponential", xcoord = xcoord,
ycoord = ycoord, estmethod = "reml", random = ~group
)
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 4)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "reml")
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 3)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works autoregressive random", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "reml", random = ~group)
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 4)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works unconnected autoregressive", {
spmod <- spautor(y ~ x, exdata_Upoly, spcov_type = "car", estmethod = "reml")
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val$connected), 3)
expect_equal(sum(varcomp_val$connected$proportion), 1)
expect_equal(NROW(varcomp_val$unconnected), 2)
expect_equal(sum(varcomp_val$unconnected$proportion), 1)
expect_equal(length(varcomp_val$ratio), 1)
})
test_that("varcomp works unconnected autoregressive random", {
spmod <- spautor(y ~ x, exdata_Upoly, spcov_type = "car", estmethod = "reml", random = ~group)
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val$connected), 4)
expect_equal(sum(varcomp_val$connected$proportion), 1)
expect_equal(NROW(varcomp_val$unconnected), 3)
expect_equal(sum(varcomp_val$unconnected$proportion), 1)
expect_equal(length(varcomp_val$ratio), 1)
})
##############################################################################
############################ vcov (test-vcov.R)
##############################################################################
test_that("vcov works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_true(isSymmetric(vcov(spmod)))
expect_true(all(diag(vcov(spmod)) >= 0))
})
test_that("vcov works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_true(isSymmetric(vcov(spmod)))
expect_true(all(diag(vcov(spmod)) >= 0))
})
}
Try the spmodel package in your browser
Any scripts or data that you put into this service are public.
spmodel documentation built on April 4, 2025, 1:39 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.
test_that("blank test", {
expect_null(NULL)
})
test_local <- FALSE # FALSE for CRAN
if (test_local) {
# SPMODEL PACKAGE NEEDS TO BE INSTALLED VIA DEVTOOLS::INSTALL() BEFORE RUNNING TESTS IF THOSE TESTS HAVE PARALLELIZATION
load(file = system.file("extdata", "exdata.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_M.rda", package = "spmodel"))
load(file = system.file("extdata", "newexdata.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_poly.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_Mpoly.rda", package = "spmodel"))
load(file = system.file("extdata", "exdata_Upoly.rda", package = "spmodel"))
##############################################################################
############################ AIC, AICc, BIC (test-aic.R)
##############################################################################
test_that("AIC and AICc works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
expect_error(AIC(spmod))
expect_error(AICc(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-cl")
expect_error(AIC(spmod))
expect_error(AICc(spmod))
expect_error(BIC(spmod))
})
test_that("AIC and AICc works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "reml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "ml")
expect_vector(AIC(spmod))
expect_vector(AICc(spmod))
expect_vector(BIC(spmod))
})
test_that("AIC and AICc works for two models", {
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod1 <- splm(y ~ 1, exdata, spcov_type = "none", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
expect_error(AIC(spmod0, spmod1), NA)
expect_error(AICc(spmod0, spmod1), NA)
expect_error(BIC(spmod0, spmod1), NA)
})
test_that("Errors appropriately return", {
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
expect_error(AIC(spmod0))
expect_error(AICc(spmod0))
expect_error(BIC(spmod0))
expect_error(AIC(spmod0, spmod1))
expect_error(AICc(spmod0, spmod1))
expect_error(BIC(spmod0, spmod1))
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-cl")
expect_error(AIC(spmod0))
expect_error(AICc(spmod0))
expect_error(BIC(spmod0))
expect_error(AIC(spmod0, spmod1))
expect_error(AICc(spmod0, spmod1))
expect_error(BIC(spmod0, spmod1))
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod1 <- splm(y ~ 1, exdata, spcov_type = "none", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
expect_error(AICc(spmod0, spmod1, spmod0))
# removing tests after removing spmodel-specific AIC method
# expect_error(AIC(spmod0, spmod1, spmod0))
# expect_error(BIC(spmod0, spmod1, spmod0))
})
test_that("Warnings appropriately return", {
spmod0 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod2 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
expect_warning(AICc(spmod0, spmod1))
expect_warning(AICc(spmod1, spmod2))
# removing tests after removing spmodel-specific AIC method
# expect_warning(AIC(spmod0, spmod1))
# expect_warning(AIC(spmod1, spmod2))
# expect_warning(BIC(spmod0, spmod1))
# expect_warning(BIC(spmod1, spmod2))
})
test_that("Matches for lm", {
spmod <- splm(y ~ x, exdata, "none", estmethod = "ml")
lmod <- lm(y ~ x, exdata)
expect_equal(AIC(spmod), AIC(lmod), tolerance = 0.001)
expect_equal(BIC(spmod), BIC(lmod), tolerance = 0.001)
})
##############################################################################
############################ anova (test-anova.R)
##############################################################################
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
# regular anova
expect_error(anova(spmod1), NA)
test_that("anova works geostatistical", {
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
spmod2 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
# regular anova
expect_error(anova(spmod1), NA)
expect_error(anova(spmod2), NA)
expect_error(anova(spmod1, spmod2), NA)
# LRT
expect_error(tidy(anova(spmod1)), NA)
expect_error(tidy(anova(spmod2)), NA)
expect_error(tidy(anova(spmod1, spmod2)), NA)
# Terms
expect_error(anova(spmod1, Terms = c("(Intercept)", "x")), NA)
expect_error(anova(spmod1, Terms = c(1, 2)), NA)
all.equal(anova(spmod1, Terms = c("(Intercept)", "x")), anova(spmod1, Terms = c(1, 2)))
# L
L <- diag(2)
expect_error(anova(spmod1, L = L), NA)
all.equal(anova(spmod1, L = L)$X2, anova(spmod1, Terms = c("(Intercept)", "x"))$X2)
})
test_that("anova works autoregressive", {
spmod1 <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "ml")
spmod2 <- spautor(y ~ 1, exdata_poly, spcov_type = "car", estmethod = "ml")
expect_error(anova(spmod1), NA)
expect_error(anova(spmod2), NA)
expect_error(anova(spmod1, spmod2), NA)
expect_error(tidy(anova(spmod1)), NA)
expect_error(tidy(anova(spmod2)), NA)
expect_error(tidy(anova(spmod1, spmod2)), NA)
})
test_that("Errors appropriately return", {
spmod1 <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod2 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
spmod3 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
spmod4 <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
# reml different fixed effects
expect_error(anova(spmod1, spmod2))
# reml vs ml
expect_error(anova(spmod2, spmod3))
# not reml and not ml
expect_error(anova(spmod2, spmod4))
})
##############################################################################
############################ augment (test-augment.R)
##############################################################################
test_that("augment works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(augment(spmod), NA)
expect_error(augment(spmod, se_fit = TRUE), NA)
expect_s3_class(augment(spmod), "tbl")
expect_error(augment(spmod, newdata = newexdata), NA)
augment(spmod, newdata = newexdata, interval = "confidence")
augment(spmod, newdata = newexdata, interval = "prediction")
expect_error(augment(spmod, newdata = newexdata, se_fit = TRUE), NA)
augment(spmod, newdata = newexdata, interval = "confidence", se_fit = TRUE)
augment(spmod, newdata = newexdata, interval = "prediction", se_fit = TRUE)
expect_s3_class(augment(spmod, newdata = newexdata), "tbl")
})
test_that("augment works auto", {
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
expect_error(augment(spmod), NA)
expect_error(augment(spmod, se_fit = TRUE), NA)
expect_s3_class(augment(spmod), "tbl")
expect_s3_class(augment(spmod), "sf")
expect_error(augment(spmod, newdata = spmod$newdata), NA)
augment(spmod, newdata = spmod$newdata, interval = "confidence")
augment(spmod, newdata = spmod$newdata, interval = "prediction")
expect_error(augment(spmod, newdata = spmod$newdata, se_fit = TRUE), NA)
augment(spmod, newdata = spmod$newdata, interval = "confidence", se_fit = TRUE)
augment(spmod, newdata = spmod$newdata, interval = "prediction", se_fit = TRUE)
expect_s3_class(augment(spmod, newdata = spmod$newdata), "tbl")
expect_s3_class(augment(spmod, newdata = spmod$newdata), "sf")
})
test_that("augment works with drop", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_equal(NCOL(aug_mod), 9)
aug_mod <- augment(spmod, drop = FALSE)
expect_equal(NCOL(aug_mod), 11)
aug_pred <- augment(spmod, newdata = newexdata)
expect_equal(NCOL(aug_pred), 6) # default drop = FALSE
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
aug_mod <- augment(spmod) # default drop = TRUE
expect_equal(NCOL(aug_mod), 8)
aug_mod <- augment(spmod, drop = FALSE)
expect_equal(NCOL(aug_mod), 11)
aug_pred <- augment(spmod, newdata = spmod$newdata)
expect_equal(NCOL(aug_pred), 7) # default drop = FALSE
})
test_that("augment works with types", {
exdata_sf <- sf::st_as_sf(exdata, coords = c("xcoord", "ycoord"), crs = 4326)
exdata_sf <- sf::st_transform(exdata_sf, crs = 5070)
newexdata_sf <- sf::st_as_sf(newexdata, coords = c("xcoord", "ycoord"), crs = 4326)
newexdata_sf <- sf::st_transform(exdata_sf, crs = 5070)
# newdata output type same as data output type
# df fit df pred
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata)
expect_true(inherits(aug_pred, "tbl"))
expect_false(inherits(aug_pred, "sf"))
# sf fit sf pred
spmod <- splm(y ~ x, exdata_sf, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata_sf)
expect_true(inherits(aug_pred, "tbl"))
expect_true(inherits(aug_pred, "sf"))
# df fit sf pred
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata_sf)
expect_true(inherits(aug_pred, "tbl"))
expect_false(inherits(aug_pred, "sf"))
# sf fit df pred
newexdata$.xcoord <- newexdata$xcoord
newexdata$.ycoord <- newexdata$ycoord
spmod <- splm(y ~ x, exdata_sf, "exponential", xcoord, ycoord)
aug_mod <- augment(spmod) # default drop = TRUE
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = newexdata)
expect_true(inherits(aug_pred, "tbl"))
expect_true(inherits(aug_pred, "sf"))
# sf in
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_true(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = spmod$newexdata)
expect_true(inherits(aug_pred, "tbl"))
expect_true(inherits(aug_pred, "sf"))
# df in
W <- 1 * sf::st_intersects(exdata_Mpoly, sparse = FALSE)
diag(W) <- 0
exdata_Mpoly_df <- st_drop_geometry(exdata_Mpoly)
spmod <- spautor(y ~ x, exdata_Mpoly_df, "car", W = W)
aug_mod <- augment(spmod)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_mod <- augment(spmod, drop = FALSE)
expect_true(inherits(aug_mod, "tbl"))
expect_false(inherits(aug_mod, "sf"))
aug_pred <- augment(spmod, newdata = spmod$newdata)
expect_true(inherits(aug_pred, "tbl"))
expect_false(inherits(aug_pred, "sf"))
})
##############################################################################
############################ coef (test-coef.R)
##############################################################################
test_that("coef works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_null(coef(spmod, type = "randcov"))
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_null(coefficients(spmod, type = "randcov"))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, random = ~group)
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_error(coef(spmod, type = "randcov"), NA)
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_error(coefficients(spmod, type = "randcov"), NA)
})
test_that("coef works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_null(coef(spmod, type = "randcov"))
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_null(coefficients(spmod, type = "randcov"))
spmod <- spautor(y ~ x, exdata_poly, "car", random = ~group)
expect_error(coef(spmod), NA)
expect_error(coef(spmod, type = "spcov"), NA)
expect_error(coef(spmod, type = "randcov"), NA)
expect_error(coefficients(spmod), NA)
expect_error(coefficients(spmod, type = "spcov"), NA)
expect_error(coefficients(spmod, type = "randcov"), NA)
})
test_that("errors return", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(coef(spmod, type = "xyz"))
expect_error(coefficients(spmod, type = "xyz"))
})
##############################################################################
############################ confint (test-confint.R)
##############################################################################
test_that("confint works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(confint(spmod), NA)
expect_error(confint(spmod, parm = "(Intercept)", level = 0.99), NA)
expect_error(confint(spmod, parm = "x", level = 0.90), NA)
})
test_that("confint works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(confint(spmod), NA)
expect_error(confint(spmod, parm = "(Intercept)", level = 0.99), NA)
expect_error(confint(spmod, parm = "x", level = 0.90), NA)
})
##############################################################################
############################ cooks distance (test-cooks.distance.R)
##############################################################################
test_that("Cook's distance works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_vector(cooks.distance(spmod))
expect_true(min(cooks.distance(spmod)) >= 0)
})
test_that("Cook's distance works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_vector(cooks.distance(spmod))
expect_true(min(cooks.distance(spmod)) >= 0)
})
##############################################################################
############################ covmatrix (test-covmatrix.R)
##############################################################################
test_that("covmatrix works geostatistical", {
spcov_type <- "exponential"
spmod <- splm(y ~ x, exdata_M, spcov_type = spcov_type, xcoord = xcoord, ycoord = ycoord, random = ~group)
expect_equal(c(99, 99), dim(covmatrix(spmod)))
expect_equal(c(1, 99), dim(covmatrix(spmod, newdata = spmod$newdata)))
expect_equal(c(10, 99), dim(covmatrix(spmod, newdata = newexdata)))
})
test_that("covmatrix works autoregressive", {
spcov_type <- "car"
spmod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, random = ~group)
expect_equal(c(48, 48), dim(covmatrix(spmod)))
expect_equal(c(1, 48), dim(covmatrix(spmod, newdata = spmod$newdata)))
})
test_that("covmatrix works geostatistical", {
spcov_type <- "exponential"
spmod <- splm(y ~ x, exdata_M, spcov_type = spcov_type, xcoord = xcoord, ycoord = ycoord, partition_factor = ~group)
expect_equal(c(99, 99), dim(covmatrix(spmod)))
expect_equal(c(1, 99), dim(covmatrix(spmod, newdata = spmod$newdata)))
expect_equal(c(10, 99), dim(covmatrix(spmod, newdata = newexdata)))
})
test_that("covmatrix works autoregressive", {
spcov_type <- "car"
spmod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, partition_factor = ~group)
expect_equal(c(48, 48), dim(covmatrix(spmod)))
expect_equal(c(1, 48), dim(covmatrix(spmod, newdata = spmod$newdata)))
})
##############################################################################
############################ deviance (test-deviance.R)
##############################################################################
test_that("Deviance works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_vector(deviance(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "ml")
expect_vector(deviance(spmod))
})
test_that("Deviance works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_vector(deviance(spmod))
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "ml")
expect_vector(deviance(spmod))
})
test_that("Deviance errors", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-wls")
expect_error(deviance(spmod))
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "sv-cl")
expect_error(deviance(spmod))
})
##############################################################################
############################ esv (test-esv.R)
##############################################################################
test_that("esv works", {
# regular implementation
esv1 <- esv(y ~ x, exdata, xcoord, ycoord)
expect_s3_class(esv1, "esv")
expect_s3_class(esv1, "tbl_df")
expect_s3_class(esv1, "tbl")
expect_s3_class(esv1, "data.frame")
expect_equal(NROW(esv1), 15)
expect_equal(NCOL(esv1), 4)
esv1_q <- esv(y ~ x, exdata, "xcoord", "ycoord")
expect_s3_class(esv1_q, "esv")
expect_s3_class(esv1_q, "tbl_df")
expect_s3_class(esv1_q, "tbl")
expect_s3_class(esv1_q, "data.frame")
expect_equal(NROW(esv1_q), 15)
expect_equal(NCOL(esv1_q), 4)
# robust version implementation
esv1r <- esv(y ~ x, exdata, xcoord, ycoord, robust = TRUE)
expect_s3_class(esv1r, "esv")
expect_s3_class(esv1r, "tbl_df")
expect_s3_class(esv1r, "tbl")
expect_s3_class(esv1r, "data.frame")
expect_equal(NROW(esv1r), 15)
expect_equal(NCOL(esv1r), 4)
expect_true(!identical(esv1, esv1r))
expect_true(identical(esv1$bins, esv1r$bins))
expect_true(identical(esv1$dist, esv1r$dist))
expect_true(!identical(esv1$gamma, esv1r$gamma))
expect_true(identical(esv1$np, esv1r$np))
# quoting works (need to NULL out call attribute as that is different)
esv1_cn <- esv1
attr(esv1_cn, "call") <- NULL
esv1_q_cn <- esv1_q
attr(esv1_q_cn, "call") <- NULL
expect_equal(esv1_cn, esv1_q_cn)
# specifying bins and cutoff
esv2 <- esv(y ~ x, exdata, xcoord, ycoord, bins = 30, cutoff = 5)
expect_s3_class(esv2, "esv")
expect_s3_class(esv2, "tbl_df")
expect_s3_class(esv2, "tbl")
expect_s3_class(esv2, "data.frame")
expect_equal(NROW(esv2), 30)
expect_equal(NCOL(esv2), 4)
dist_matrix <- spdist(exdata, "xcoord", "ycoord")
# specifying distance matrix
esv3 <- esv(y ~ x, exdata, dist_matrix = dist_matrix)
expect_s3_class(esv3, "esv")
expect_s3_class(esv3, "tbl_df")
expect_s3_class(esv3, "tbl")
expect_s3_class(esv3, "data.frame")
expect_equal(NROW(esv3), 15)
expect_equal(NCOL(esv3), 4)
# specifying partition factor
esv4 <- esv(y ~ x, exdata, xcoord, ycoord, partition_factor = ~group)
expect_s3_class(esv4, "esv")
expect_s3_class(esv4, "tbl_df")
expect_s3_class(esv4, "tbl")
expect_s3_class(esv4, "data.frame")
expect_equal(NROW(esv4), 15)
expect_equal(NCOL(esv4), 4)
expect_false(identical(esv1, esv4)) # make sure results are not identical to full esv
# works with sf object
exdata_sf <- sf::st_as_sf(exdata, coords = c("xcoord", "ycoord"))
expect_error(esv(y ~ x, exdata_sf), NA)
esv5 <- esv(y ~ x, exdata_sf)
esv5_cn <- esv5
attr(esv5_cn, "call") <- NULL
expect_true(identical(esv1_cn, esv5_cn))
# works with one dimension
expect_error(esv(y ~ x, exdata, xcoord), NA)
# errors occur
expect_error(esv(y ~ x, exdata))
expect_error(esv(y ~ x, exdata, xcoord_xyz))
expect_error(esv(y ~ x, exdata, xcoord, ycoord_xyz))
# works with cloud argument
esv1c <- esv(y ~ x, exdata, xcoord, ycoord, cloud = TRUE)
expect_s3_class(esv1c, "esv")
expect_s3_class(esv1c, "tbl_df")
expect_s3_class(esv1c, "tbl")
expect_s3_class(esv1c, "data.frame")
expect_equal(NROW(esv1c), 3965)
expect_equal(NCOL(esv1c), 2)
# plot works
expect_error(plot(esv1), NA)
expect_error(plot(esv1, pch = 1), NA)
expect_error(plot(esv1c), NA)
expect_error(plot(esv1c, pch = 19), NA)
})
##############################################################################
############################ fitted (test-fitted.R)
##############################################################################
test_that("fitted distance works geostatistical", {
# no random effect
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_null(fitted(spmod, type = "randcov"))
expect_null(fitted.values(spmod, type = "randcov"))
# random effect
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, random = ~group)
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_vector(fitted(spmod, type = "randcov"))
expect_vector(fitted.values(spmod, type = "randcov"))
})
test_that("fitted distance works autoregressive", {
# no random effect
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_null(fitted(spmod, type = "randcov"))
expect_null(fitted.values(spmod, type = "randcov"))
# random effect
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", random = ~group)
expect_vector(fitted(spmod))
expect_vector(fitted.values(spmod))
expect_vector(fitted(spmod, type = "spcov"))
expect_vector(fitted.values(spmod, type = "spcov"))
expect_vector(fitted(spmod, type = "randcov"))
expect_vector(fitted.values(spmod, type = "randcov"))
})
test_that("errors return", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(fitted(spmod, type = "xyz"))
expect_error(fitted.values(spmod, type = "xyz"))
})
##############################################################################
############################ formula (test-formula.R)
##############################################################################
test_that("formula works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_equal(formula(spmod), y ~ x)
spmod <- splm(y ~ 1, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord)
expect_equal(formula(spmod), y ~ 1)
})
test_that("formula works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car")
expect_equal(formula(spmod), y ~ x)
spmod <- spautor(y ~ 1, exdata_poly, spcov_type = "car")
expect_equal(formula(spmod), y ~ 1)
})
##############################################################################
############################ FREE GENERICS (test-generics.R)
##############################################################################
test_that("free generics work geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_true(is.language(terms(spmod))) # works because there is an object spmod$terms
expect_true(is.call(getCall(spmod))) # works because there is an object spmod$call
})
test_that("free generics work geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_true(is.language(terms(spmod))) # works because there is an object spmod$terms
expect_true(is.call(getCall(spmod))) # works because there is an object spmod$call
expect_equal(update(formula(spmod), y ~ 1), y ~ 1) # works because formula(object) works (object has class spmod)
spmod <- update(spmod, y ~ 1, spcov_type = "spherical")
expect_s3_class(spmod, "splm")
expect_equal(formula(spmod), y ~ 1)
expect_s3_class(coefficients(spmod, type = "spcov"), "spherical")
spmod <- update(spmod, . ~ . + offset(x))
expect_vector(model.offset(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
expect_vector(model.response(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
})
test_that("free generics work autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_true(is.language(terms(spmod))) # works because there is an object spmod$terms
expect_true(is.call(getCall(spmod))) # works because there is an object spmod$call
expect_equal(update(formula(spmod), y ~ 1), y ~ 1) # works because formula(object) works (object has class spmod)
spmod <- update(spmod, y ~ 1, spcov_type = "sar")
expect_s3_class(spmod, "spautor")
expect_equal(formula(spmod), y ~ 1)
expect_s3_class(coefficients(spmod, type = "spcov"), "sar")
spmod <- update(spmod, . ~ . + offset(x))
expect_vector(model.offset(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
expect_vector(model.response(model.frame(spmod))) # works because model.frame(object) works (object has class spmod)
})
##############################################################################
############################ glance (test-glance.R)
##############################################################################
test_that("glance works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_s3_class(glance(spmod), "tbl")
expect_equal(NROW(glance(spmod)), 1)
expect_equal(NCOL(glance(spmod)), 10)
expect_false(any(is.na(glance(spmod))))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "sv-wls")
expect_s3_class(glance(spmod), "tbl")
expect_equal(NROW(glance(spmod)), 1)
expect_equal(NCOL(glance(spmod)), 10)
expect_true(any(is.na(glance(spmod))))
})
test_that("glance works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_s3_class(glance(spmod), "tbl")
expect_equal(NCOL(glance(spmod)), 10)
expect_false(any(is.na(glance(spmod))))
})
##############################################################################
############################ glances (test-glances.R)
##############################################################################
test_that("glances works geostatistical", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
spmod2 <- splm(y ~ x, exdata, "matern", xcoord, ycoord)
expect_s3_class(glances(spmod1, spmod2), "tbl")
expect_equal(NROW(glances(spmod1, spmod2)), 2)
expect_equal(NCOL(glances(spmod1, spmod2)), 11)
expect_equal(rbind(glance(spmod1), glance(spmod2)), glances(spmod1, spmod2)[, -1], ignore_attr = TRUE)
})
test_that("glances works autoregressive", {
spmod1 <- spautor(y ~ x, exdata_poly, "car")
spmod2 <- spautor(y ~ x, exdata_poly, "sar")
expect_s3_class(glances(spmod1, spmod2), "tbl")
expect_equal(NROW(glances(spmod1, spmod2)), 2)
expect_equal(NCOL(glances(spmod1, spmod2)), 11)
expect_equal(rbind(glance(spmod2), glance(spmod1)), glances(spmod1, spmod2)[, -1], ignore_attr = TRUE)
})
test_that("glances works iteratively splm spcov_type", {
spmod <- splm(y ~ x, exdata, c("exponential", "matern"), xcoord, ycoord)
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$exponential), glance(spmod$matern)), glances(spmod)[, -1], ignore_attr = TRUE)
})
test_that("glances works iteratively splm spcov_initial", {
spcov_init <- lapply(c("exponential", "matern"), function(x) spcov_initial(x, de = 1))
spmod <- splm(y ~ x, exdata, spcov_initial = spcov_init, xcoord = xcoord, ycoord = ycoord)
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$spcov_initial_1), glance(spmod$spcov_initial_2)), glances(spmod)[, -1], ignore_attr = TRUE)
})
test_that("glances works iteratively spautor spcov_type", {
spmod <- spautor(y ~ x, exdata_poly, c("car", "sar"))
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$car), glance(spmod$sar)), glances(spmod, sort_by = "order")[, -1], ignore_attr = TRUE)
# sort by order here because sort by is off in natural implementation by AICc
})
test_that("glances works iteratively spautor spcov_initial", {
spcov_init <- lapply(c("car", "sar"), function(x) spcov_initial(x, de = 1))
spmod <- spautor(y ~ x, exdata_poly, spcov_initial = spcov_init)
expect_s3_class(glances(spmod), "tbl")
expect_equal(NROW(glances(spmod)), 2)
expect_equal(NCOL(glances(spmod)), 11)
expect_equal(rbind(glance(spmod$spcov_initial_1), glance(spmod$spcov_initial_2)), glances(spmod, sort_by = "order")[, -1], ignore_attr = TRUE)
})
test_that("glances throws proper warnings", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
spmod2 <- splm(y ~ x, exdata, "matern", xcoord, ycoord)
expect_warning(glances(spmod1, spmod2), NA)
spmod3 <- splm(y ~ 1, exdata, "exponential", xcoord, ycoord, estmethod = "ml")
expect_warning(glances(spmod1, spmod2, spmod3))
expect_warning(glances(spmod1, spmod2, spmod3, warning = FALSE), NA)
spmod4 <- splm(y ~ 1, exdata, "spherical", xcoord, ycoord, estmethod = "reml")
expect_warning(glances(spmod1, spmod2, spmod3))
expect_warning(glances(spmod1, spmod2, spmod3, warning = FALSE), NA)
spmod5 <- splm(y ~ 1, exdata, "spherical", xcoord, ycoord, estmethod = "sv-wls")
spmod6 <- splm(y ~ 1, exdata, "gaussian", xcoord, ycoord, estmethod = "sv-cl")
expect_warning(glances(spmod1, spmod2, spmod5, spmod6), NA)
spmod7 <- splm(y ~ x, exdata[-1, ], "exponential", xcoord, ycoord)
expect_warning(glances(spmod1, spmod7))
# glm families
spgmod1 <- spglm(y > 0 ~ x, data = exdata, family = "binomial", "exponential", xcoord, ycoord)
spgmod2 <- spglm(abs(y) / 10 ~ x, exdata, family = "beta", "exponential", xcoord, ycoord)
spgmod3 <- spglm(round(abs(y)) ~ x, exdata, family = "poisson", "exponential", xcoord, ycoord)
spgmod4 <- spglm(round(abs(y)) ~ x, exdata, family = "nbinomial", "exponential", xcoord, ycoord)
spgmod5 <- spglm(abs(y) ~ x, exdata, family = "Gamma", "exponential", xcoord, ycoord)
spgmod6 <- spglm(abs(y) ~ x, exdata, family = "inverse.gaussian", "exponential", xcoord, ycoord)
## no warnings
expect_warning(glances(spgmod1, spgmod1), NA)
expect_warning(glances(spgmod2, spgmod2), NA)
expect_warning(glances(spgmod3, spgmod3), NA)
expect_warning(glances(spgmod4, spgmod4), NA)
expect_warning(glances(spgmod5, spgmod5), NA)
expect_warning(glances(spgmod6, spgmod6), NA)
expect_warning(glances(spgmod3, spgmod4), NA)
expect_warning(glances(spgmod5, spgmod6), NA)
## warnings
expect_warning(glances(spgmod1, spgmod2))
expect_warning(glances(spgmod1, spgmod3))
expect_warning(glances(spgmod1, spgmod4))
expect_warning(glances(spgmod1, spgmod5))
expect_warning(glances(spgmod1, spgmod6))
expect_warning(glances(spgmod2, spgmod3))
expect_warning(glances(spgmod2, spgmod4))
expect_warning(glances(spgmod2, spgmod5))
expect_warning(glances(spgmod2, spgmod6))
expect_warning(glances(spgmod3, spgmod5))
expect_warning(glances(spgmod3, spgmod6))
expect_warning(glances(spgmod4, spgmod5))
expect_warning(glances(spgmod4, spgmod6))
})
##############################################################################
############################ hatvalues (test-hatvalues.R)
##############################################################################
test_that("hatvalues works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(hatvalues(spmod))
expect_true(min(hatvalues(spmod)) >= 0)
expect_true(max(hatvalues(spmod)) <= 1)
expect_equal(sum(hatvalues(spmod)), spmod$p)
})
test_that("hatvalues works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(hatvalues(spmod))
expect_true(min(hatvalues(spmod)) >= 0)
expect_true(max(hatvalues(spmod)) <= 1)
expect_equal(sum(hatvalues(spmod)), spmod$p)
})
##############################################################################
############################ influence (test-influence.R)
##############################################################################
test_that("influence works geostatistical", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(influence(spmod), NA)
expect_equal(NROW(influence(spmod)), 100)
expect_equal(NCOL(influence(spmod)), 4)
expect_equal(colnames(influence(spmod)), c(".resid", ".hat", ".cooksd", ".std.resid"))
expect_s3_class(influence(spmod), "tbl")
})
test_that("influence works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(influence(spmod), NA)
expect_equal(NROW(influence(spmod)), 49)
expect_equal(NCOL(influence(spmod)), 4)
expect_equal(colnames(influence(spmod)), c(".resid", ".hat", ".cooksd", ".std.resid"))
expect_s3_class(influence(spmod), "tbl")
})
##############################################################################
############################ labels (test-labels.R)
##############################################################################
test_that("labels works geostatistical", {
spmod <- splm(y ~ x + group, exdata, "exponential", xcoord, ycoord)
expect_equal(labels(spmod), c("x", "group"))
})
test_that("labels works autoregressive", {
spmod <- spautor(y ~ x + group, exdata_poly, "car")
expect_equal(labels(spmod), c("x", "group"))
})
##############################################################################
############################ logLik (test-logLik.R)
##############################################################################
test_that("logLik works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(logLik(spmod))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "ml")
expect_vector(logLik(spmod))
})
test_that("logLik works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(logLik(spmod))
spmod <- spautor(y ~ x, exdata_poly, "car", estmethod = "ml")
expect_vector(logLik(spmod))
})
test_that("logLik appropriately errors", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "sv-wls")
expect_error(logLik(spmod))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, estmethod = "sv-cl")
expect_error(logLik(spmod))
})
##############################################################################
############################ loocv (test-loocv.R)
##############################################################################
test_that("loocv works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# cores 2 for cran check
if (test_local) { ##### local test
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = TRUE)), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE)), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = TRUE)), 2)
}
# cores 2 for cran check
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, method = "all", ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, method = "all", ncores = 2))), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, method = "all", ncores = 2))), 2)
}
# random effects
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, random = ~group)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# iid
spmod <- splm(y ~ x, exdata, "none", xcoord, ycoord)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# cores 2 for cran check
if (test_local) { ##### local test
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE)), 2)
}
# cores 2 for cran check
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
if (test_local) { ##### local test
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
})
test_that("loocv works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_type(loocv(spmod), "list")
# cores 2 for cran check
if (test_local) {
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
# cores 2 for cran check
if (test_local) {
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
# random effects
spmod <- spautor(y ~ x, exdata_poly, "car", random = ~group)
expect_type(loocv(spmod), "list")
expect_type(loocv(spmod, local = TRUE), "list")
# missing data
spmod <- spautor(y ~ x, exdata_Mpoly, "car")
expect_type(loocv(spmod), "list")
# cores 2 for cran check
if (test_local) {
expect_type(loocv(spmod, local = list(parallel = TRUE, ncores = 2)), "list")
expect_equal(length(loocv(spmod, cv_predict = TRUE)), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE)), 3)
# cores 2 for cran check
if (test_local) {
expect_equal(length(loocv(spmod, cv_predict = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
expect_equal(length(loocv(spmod, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 2)
}
expect_equal(length(loocv(spmod, cv_predict = TRUE, se.fit = TRUE, local = list(parallel = TRUE, ncores = 2))), 3)
})
##############################################################################
############################ model.frame (test-model.frame.R)
##############################################################################
test_that("model.frame works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_equal(NCOL(model.frame(spmod)), 2)
expect_equal(NROW(model.frame(spmod)), 100)
expect_equal(model.frame(spmod), model.frame(y ~ x, exdata, drop.unused.levels = TRUE, na.action = na.omit))
})
test_that("model.frame works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_equal(NCOL(model.frame(spmod)), 2)
expect_equal(NROW(model.frame(spmod)), 49)
expect_equal(model.frame(spmod), model.frame(y ~ x, exdata_poly, drop.unused.levels = TRUE, na.action = na.omit))
})
##############################################################################
############################ model.matrix (test-model.matrix.R)
##############################################################################
test_that("model.matrix works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_equal(NCOL(model.matrix(spmod)), 2)
expect_equal(NROW(model.matrix(spmod)), 100)
expect_equal(model.matrix(spmod), model.matrix(y ~ x, model.frame(y ~ x, exdata, drop.unused.levels = TRUE, na.action = na.omit)))
})
test_that("model.matrix works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_equal(NCOL(model.matrix(spmod)), 2)
expect_equal(NROW(model.matrix(spmod)), 49)
expect_equal(model.matrix(spmod), model.matrix(y ~ x, model.frame(y ~ x, exdata_poly, drop.unused.levels = TRUE, na.action = na.omit)))
})
##############################################################################
############################ plot (test-plot.R)
##############################################################################
test_that("plot works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
# plot 1
expect_error(plot(spmod, which = 1), NA)
# plot 2
expect_error(plot(spmod, which = 2), NA)
# plot 3
expect_error(plot(spmod, which = 3), NA)
# plot 4
expect_error(plot(spmod, which = 4), NA)
# plot 5
expect_error(plot(spmod, which = 5), NA)
# plot 6
expect_error(plot(spmod, which = 6), NA)
# plot 7
expect_error(plot(spmod, which = 7), NA)
# plot 8
expect_error(plot(spmod, which = 8), NA)
# plot 9 (return error)
expect_error(plot(spmod, which = 9))
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, anisotropy = TRUE)
# plot 8
expect_error(plot(spmod, which = 8), NA)
})
test_that("plot works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
# plot 1
expect_error(plot(spmod, which = 1), NA)
# plot 2
expect_error(plot(spmod, which = 2), NA)
# plot 3
expect_error(plot(spmod, which = 3), NA)
# plot 4
expect_error(plot(spmod, which = 4), NA)
# plot 5
expect_error(plot(spmod, which = 5), NA)
# plot 6
expect_error(plot(spmod, which = 6), NA)
# plot 7
expect_error(plot(spmod, which = 7))
# plot 8
expect_error(plot(spmod, which = 8))
})
##############################################################################
############################ predict (test-predict.R)
##############################################################################
test_that("Prediction for splm works", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for splm works anisotropy", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", anisotropy = TRUE)
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for splm works with random effects", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", random = ~group)
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
# variable with new level
newexdata2 <- newexdata
newexdata2$group <- as.factor(seq_len(NROW(newexdata2)))
expect_error(predict(smod, newexdata2), NA)
expect_error(predict(smod, newexdata2, interval = "prediction"), NA)
expect_error(predict(smod, newexdata2, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata2)), NROW(newexdata))
expect_true(all(predict(smod, newexdata2, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for splm works with partition factor", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", partition_factor = ~group)
expect_error(predict(smod, newexdata), NA)
expect_error(predict(smod, newexdata, interval = "prediction"), NA)
expect_error(predict(smod, newexdata, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, se.fit = TRUE)$se.fit >= 0))
# variable with new level
newexdata2 <- newexdata
newexdata2$group <- as.factor(seq_len(NROW(newexdata2)))
expect_error(predict(smod, newexdata2), NA)
expect_error(predict(smod, newexdata2, interval = "prediction"), NA)
expect_error(predict(smod, newexdata2, interval = "confidence"), NA)
expect_equal(length(predict(smod, newexdata2)), NROW(newexdata))
expect_true(all(predict(smod, newexdata2, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction works for big data", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod, newexdata), NA)
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
# big data
expect_error(predict(smod, newexdata, local = TRUE), NA)
expect_error(predict(smod, newexdata, interval = "prediction", local = TRUE), NA)
expect_error(predict(smod, newexdata, interval = "confidence", local = TRUE), NA)
# CRAN FIXES CORES AT 2 MAX
expect_error(predict(smod, newexdata, local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, newexdata, interval = "prediction", local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, newexdata, interval = "confidence", local = list(parallel = TRUE, ncores = 2)), NA)
expect_equal(length(predict(smod, newexdata, local = TRUE)), NROW(newexdata))
expect_true(all(predict(smod, newexdata, local = TRUE, se.fit = TRUE)$se.fit >= 0))
expect_error(predict(smod, newexdata, local = list(method = "distance")), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "distance"))), NROW(newexdata))
expect_error(predict(smod, newexdata, local = list(method = "covariance")), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "covariance"))), NROW(newexdata))
expect_error(predict(smod, newexdata, local = list(method = "distance", size = 10)), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "distance", size = 10))), NROW(newexdata))
expect_error(predict(smod, newexdata, local = list(method = "covariance", size = 10)), NA)
expect_equal(length(predict(smod, newexdata, local = list(method = "covariance", size = 10))), NROW(newexdata))
# random effects
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", random = ~ group)
expect_error(predict(smod, newexdata), NA)
# anisotropy
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", anisotropy = TRUE)
expect_error(predict(smod, newexdata), NA)
# partition factor
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml", partition_factor = ~ group)
expect_error(predict(smod, newexdata), NA)
})
test_that("Prediction for splm works for missing data", {
spcov_type <- "exponential"
smod <- splm(y ~ x, exdata_M, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_M$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works parallel", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml")
# CRAN FIXES CORES AT 2 MAX
expect_error(predict(smod, local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, interval = "prediction", local = list(parallel = TRUE, ncores = 2)), NA)
expect_error(predict(smod, interval = "confidence", local = list(parallel = TRUE, ncores = 2)), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works with random effects", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml", random = ~group)
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction for spautor works with partition factor", {
spcov_type <- "car"
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = spcov_type, estmethod = "reml", partition = ~group)
expect_error(predict(smod), NA)
expect_error(predict(smod, interval = "prediction"), NA)
expect_error(predict(smod, interval = "confidence"), NA)
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
expect_true(all(predict(smod, se.fit = TRUE)$se.fit >= 0))
})
test_that("Prediction works for other covariances", {
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "exponential", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "spherical", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "gaussian", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, spcov_type = "triangular", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "circular", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "none", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "cubic", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "pentaspherical", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, spcov_type = "cosine", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "wave", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "jbessel", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "gravity", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "rquad", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "magnetic", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "matern", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "cauchy", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = "pexponential", estmethod = "reml")
expect_equal(length(predict(smod, newexdata)), NROW(newexdata))
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = "car", estmethod = "reml")
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
smod <- spautor(y ~ x, exdata_Mpoly, spcov_type = "sar", estmethod = "reml")
expect_equal(length(predict(smod)), sum(is.na(exdata_Mpoly$y)))
})
test_that("errors occur", {
spcov_type <- "exponential"
spmod <- splm(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_error(predict(spmod))
expect_error(predict(spmod, newexdata = newexdata, local = list(method = "xyz")))
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(predict(spmod))
})
test_that("prediction values match for both approaches", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ x, exdata_with_NA, "exponential", xcoord, ycoord)
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
spmod1 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata_with_NA, "exponential", xcoord, ycoord)
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
spmod1 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata_with_NA, "exponential", xcoord, ycoord)
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
})
test_that("prediction values match for both and lm comparison", {
# no poly
spmod1 <- splm(y ~ x, exdata, "none")
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ x, exdata_with_NA, "none")
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
## compare lm
lmod1 <- lm(y ~ x, exdata)
lmpred1 <- predict(lmod1, newexdata)
expect_equal(unname(pred1), unname(lmpred1))
# poly raw
spmod1 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata, "none")
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = TRUE), exdata_with_NA, "none")
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
## compare lm
lmod1 <- lm(y ~ poly(x, degree = 2, raw = TRUE), exdata)
lmpred1 <- predict(lmod1, newexdata)
expect_equal(unname(pred1), unname(lmpred1))
# poly no raw
spmod1 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata, "none")
pred1 <- predict(spmod1, newdata = newexdata)
newexdata$y <- NA
exdata_with_NA <- rbind(exdata, newexdata)
spmod2 <- splm(y ~ poly(x, degree = 2, raw = FALSE), exdata_with_NA, "none")
pred2 <- predict(spmod2)
pred3 <- predict(spmod2, newdata = spmod2$newdata)
spmod1$call <- NULL # calls are different among two splm() calls
spmod2$call <- NULL
names(pred1) <- NULL # names start at 1
names(pred2) <- NULL # names start at index in data
names(pred3) <- NULL # names start at 1
expect_equal(summary(spmod1), summary(spmod2))
expect_equal(pred1, pred2)
expect_equal(pred2, pred3)
## compare lm
lmod1 <- lm(y ~ poly(x, degree = 2, raw = FALSE), exdata)
lmpred1 <- predict(lmod1, newexdata)
expect_equal(unname(pred1), unname(lmpred1))
# terms matches
pt_spmod1 <- predict(spmod1, newdata = newexdata, type = "terms")
pt_lmod1 <- predict(lmod1, newdata = newexdata, type = "terms")
expect_equal(pt_spmod1, pt_lmod1, tolerance = 0.01)
expect_equal(attr(pt_spmod1, "constant"), attr(pt_lmod1, "constant"), tolerance = 0.01)
pt_spmod1 <- predict(spmod1, newdata = newexdata, type = "terms", se.fit = TRUE, interval = "confidence")
pt_lmod1 <- predict(spmod1, newdata = newexdata, type = "terms", se.fit = TRUE, interval = "confidence")
expect_true(all(names(pt_spmod1) %in% names(pt_lmod1)))
expect_equal(pt_spmod1$fit, pt_lmod1$fit, tolerance = 0.01)
expect_equal(attr(pt_spmod1$fit, "constant"), attr(pt_lmod1$fit, "constant"), tolerance = 0.01)
expect_equal(pt_spmod1$se.fit, pt_lmod1$se.fit, tolerance = 0.01)
# both attributes are null when returning se (i.e., for se, there is no constant attribute)
expect_equal(attr(pt_spmod1$se, "constant"), attr(pt_lmod1$se, "constant"), tolerance = 0.01)
expect_equal(pt_spmod1$lwr, pt_lmod1$lwr, tolerance = 0.01)
expect_equal(attr(pt_spmod1$lwr, "constant"), attr(pt_lmod1$lwr, "constant"), tolerance = 0.01)
expect_equal(pt_spmod1$upr, pt_lmod1$upr, tolerance = 0.01)
expect_equal(attr(pt_spmod1$upr, "constant"), attr(pt_lmod1$upr, "constant"), tolerance = 0.01)
})
test_that("prediction values match for both approaches autoregressive", {
spmod1 <- spautor(y ~ poly(x, degree = 2, raw = TRUE), exdata_Mpoly, "car")
expect_error(predict(spmod1), NA)
spmod1 <- spautor(y ~ poly(x, degree = 2, raw = FALSE), exdata_Mpoly, "car")
expect_error(predict(spmod1), NA)
})
test_that("prediction no error with order 2 polynomial one prediction row", {
# there is a bug in lm() trying to do the same thing
spmod <- splm(y ~ poly(xcoord, ycoord, degree = 1), exdata, "none")
expect_error(predict(spmod, newdata = newexdata), NA)
expect_error(predict(spmod, newdata = newexdata[1, , drop = FALSE]), NA)
expect_equal(predict(spmod, newdata = newexdata)[[1]], predict(spmod, newdata = newexdata[1, , drop = FALSE])[[1]])
# there is a bug in lm() trying to do the same thing
spmod <- splm(y ~ poly(xcoord, ycoord, degree = 1), exdata, "exponential", xcoord, ycoord)
expect_error(predict(spmod, newdata = newexdata), NA)
expect_error(predict(spmod, newdata = newexdata[1, , drop = FALSE]), NA)
expect_equal(predict(spmod, newdata = newexdata)[[1]], predict(spmod, newdata = newexdata[1, , drop = FALSE])[[1]])
# there is a bug in lm() trying to do the same thing
exdata_Mpoly$x2 <- rnorm(NROW(exdata_Mpoly))
spmod <- spautor(y ~ poly(x, x2, degree = 1), exdata_Mpoly, "car")
expect_error(predict(spmod), NA)
})
test_that("prediction works when newdata does not have all factor levels", {
# geostatistical
spmod <- splm(y ~ group, exdata, "exponential", xcoord, ycoord)
newexdata_sub <- newexdata[1, , drop = FALSE]
newexdata_sub$group <- as.character(newexdata_sub$group)
expect_error(predict(spmod, newexdata_sub), NA)
# autoregressive
exdata_Mpoly_new <- exdata_Mpoly
exdata_Mpoly_new$group <- as.character(exdata_Mpoly_new$group)
spmod <- spautor(y ~ group, exdata_Mpoly_new, "car")
expect_error(predict(spmod), NA)
})
test_that("prediction for splmRF works", {
spcov_type <- "exponential"
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod, newdata = newexdata))
exdata$y[1] <- NA
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod))
spcov_type <- c("exponential", "matern")
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod, newdata = newexdata)[[1]])
expect_vector(predict(sprfmod, newdata = newexdata)[[2]])
exdata$y[1] <- NA
sprfmod <- splmRF(y ~ x, exdata, xcoord = xcoord, ycoord = ycoord, spcov_type = spcov_type, estmethod = "reml")
expect_vector(predict(sprfmod)[[1]])
expect_vector(predict(sprfmod)[[2]])
})
test_that("prediction for spautorRF works", {
spcov_type <- "car"
sprfmod <- spautorRF(y ~ x, exdata_Mpoly, spcov_type = spcov_type)
expect_vector(predict(sprfmod))
spcov_type <- c("car", "sar")
sprfmod <- spautorRF(y ~ x, exdata_Mpoly, spcov_type = spcov_type)
expect_vector(predict(sprfmod))
expect_vector(predict(sprfmod)[[1]])
expect_vector(predict(sprfmod)[[2]])
})
test_that("prediction for splm offset works", {
exdata$offset <- 2
exdata$y2 <- exdata$y - exdata$offset
newexdata$offset <- 2
spmod1 <- splm(y ~ x + offset(offset), exdata, "exponential", xcoord, ycoord)
spmod2 <- splm(y2 ~ x, exdata, "exponential", xcoord, ycoord)
expect_equal(fitted(spmod1), fitted(spmod2) + exdata$offset)
})
test_that("prediction for spautor offset works", {
exdata_Mpoly$offset <- 2
exdata_Mpoly$y2 <- exdata_Mpoly$y - exdata_Mpoly$offset
spmod1 <- spautor(y ~ x + offset(offset), exdata_Mpoly, "car")
spmod2 <- spautor(y2 ~ x, exdata_Mpoly, "car")
expect_equal(fitted(spmod1), fitted(spmod2) + exdata_Mpoly$offset[!is.na(exdata_Mpoly$y)])
})
test_that("prediction for splm scale/df works", {
spmod1 <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
pred1 <- predict(spmod1, newexdata, se.fit = TRUE, scale = 1, interval = "prediction")
pred2 <- predict(spmod1, newexdata, se.fit = TRUE, interval = "prediction")
expect_equal(pred1, pred2, tolerance = .01)
pred1 <- predict(spmod1, newexdata, se.fit = TRUE, scale = 2)
pred2 <- predict(spmod1, newexdata, se.fit = TRUE)
expect_equal(pred1$fit, pred2$fit, tolerance = 0.01)
expect_equal(pred1$se.fit / 2, pred2$se.fit, tolerance = 0.01)
df <- 4
pred1 <- predict(spmod1, newexdata, se.fit = TRUE, scale = 1, df = df, interval = "confidence")
pred2 <- predict(spmod1, newexdata, se.fit = TRUE, interval = "confidence")
expect_equal(pred1$fit[, "fit"], pred2$fit[, "fit"], tolerance = 0.01)
expect_equal(pred1$se.fit, pred2$se.fit, tolerance = 0.01)
level <- 0.95
tcrit <- qt(1 - (1 - level) / 2, df = df)
expect_equal(as.vector(pred1$fit[, "lwr"]), as.vector(pred2$fit[, "fit"] - tcrit * pred2$se.fit), tolerance = 0.01)
expect_equal(as.vector(pred1$fit[, "upr"]), as.vector(pred2$fit[, "fit"] + tcrit * pred2$se.fit), tolerance = 0.01)
})
##############################################################################
############################ print (test-print.R)
##############################################################################
test_that("printing works for geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_output(print(spmod))
expect_output(print(summary(spmod)))
expect_output(print(anova(spmod)))
})
test_that("printing works for auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_output(print(spmod))
expect_output(print(summary(spmod)))
expect_output(print(anova(spmod)))
})
##############################################################################
############################ pseudoR2 (test-pseudoR2.R)
##############################################################################
test_that("pseudoR2 works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(pseudoR2(spmod))
expect_vector(pseudoR2(spmod, adjust = TRUE))
})
test_that("pseudoR2 works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(pseudoR2(spmod))
expect_vector(pseudoR2(spmod, adjust = TRUE))
})
test_that("pseudoR2 matches classical r-squared", {
lmod <- lm(y ~ x, exdata)
spmod <- splm(y ~ x, exdata, "none")
expect_equal(summary(lmod)$r.squared, pseudoR2(spmod))
expect_equal(summary(lmod)$adj.r.squared, pseudoR2(spmod, adjust = TRUE))
})
##############################################################################
############################ residuals (test-residuals.R)
##############################################################################
test_that("residuals works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_vector(residuals(spmod))
expect_equal(residuals(spmod), exdata$y - fitted(spmod))
expect_vector(residuals(spmod, type = "response"))
expect_vector(residuals(spmod, type = "pearson"))
expect_vector(residuals(spmod, type = "standardized"))
expect_equal(residuals(spmod, type = "standardized"), rstandard(spmod))
})
test_that("residuals works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_vector(residuals(spmod))
expect_equal(residuals(spmod), exdata_poly$y - fitted(spmod))
expect_vector(residuals(spmod, type = "response"))
expect_vector(residuals(spmod, type = "pearson"))
expect_vector(residuals(spmod, type = "standardized"))
expect_equal(residuals(spmod, type = "standardized"), rstandard(spmod))
})
################################################################################
############################ sp_objects (test-sp_objects.R)
################################################################################
test_that("sp object error tests geostatistical", {
# first we make "fake" sp objects that can be loaded without also loading sp
exdata_sp <- exdata
attr(class(exdata_sp), "package") <- "sp"
expect_error(splm(y ~ x, exdata_sp, "exponential", xcoord = xcoord, ycoord = ycoord))
expect_error(esv(y ~ x, exdata_sp, xcoord = xcoord, ycoord = ycoord))
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_error(sprnorm(spcov_params_val, data = exdata_sp, xcoord = xcoord, ycoord = ycoord))
spmod <- splm(y ~ x, exdata, "exponential", xcoord = xcoord, ycoord = ycoord)
newexdata_sp <- newexdata
attr(class(newexdata_sp), "package") <- "sp"
expect_error(predict(spmod, newexdata_sp))
expect_error(augment(spmod, newdata = newexdata_sp))
})
test_that("sp object error tests autoregressive", {
# first we make "fake" sp objects that can be loaded without also loading sp
exdata_poly_sp <- exdata_poly
attr(class(exdata_poly_sp), "package") <- "sp"
expect_error(spautor(y ~ x, exdata_poly_sp, "car"))
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 0.5, extra = 0)
expect_error(sprnorm(spcov_params_val, data = exdata_poly_sp))
})
##############################################################################
############################ sprnorm (test-sprnorm.R)
##############################################################################
test_that("the simulation runs for exponential", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for exponential anisotropy", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord, anisotropy = TRUE))
})
test_that("the simulation runs for exponential random effect", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
randcov_params_val <- randcov_params(group = 1)
expect_vector(sprnorm(spcov_params_val,
data = exdata, xcoord = xcoord, ycoord = ycoord,
random = ~group, randcov_params = randcov_params_val
))
})
test_that("the simulation runs for exponential partitioning", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord, partition_factor = ~group))
})
test_that("the simulation runs for exponential (matrix)", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
sprnorm_matrix <- sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord, samples = 5)
expect_equal(nrow(sprnorm_matrix), nrow(exdata))
expect_equal(ncol(sprnorm_matrix), 5)
})
test_that("the simulation runs for car", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly))
})
test_that("the simulation runs for car unconnected", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata_Upoly))
})
test_that("the simulation runs for none random effect", {
spcov_params_val <- spcov_params("none", ie = 1)
randcov_params_val <- randcov_params(group = 1)
expect_vector(sprnorm(spcov_params_val,
data = exdata, xcoord = xcoord, ycoord = ycoord,
random = ~group, randcov_params = randcov_params_val
))
})
test_that("the simulation runs for car random effects", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly))
randcov_params_val <- randcov_params(group = 1)
expect_vector(sprnorm(spcov_params_val,
data = exdata_poly, xcoord = xcoord, ycoord = ycoord,
random = ~group, randcov_params = randcov_params_val
))
})
test_that("the simulation runs for car partition factor", {
spcov_params_val <- spcov_params("car", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly, partition_factor = ~group))
})
test_that("the simulation runs for spherical", {
spcov_params_val <- spcov_params("spherical", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for gaussian", {
spcov_params_val <- spcov_params("gaussian", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for triangular", {
spcov_params_val <- spcov_params("triangular", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord))
})
test_that("the simulation runs for circular", {
spcov_params_val <- spcov_params("circular", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for cubic", {
spcov_params_val <- spcov_params("cubic", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for pentaspherical", {
spcov_params_val <- spcov_params("pentaspherical", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for cosine", {
spcov_params_val <- spcov_params("cosine", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord))
})
test_that("the simulation runs for wave", {
spcov_params_val <- spcov_params("wave", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for jbessel", {
spcov_params_val <- spcov_params("jbessel", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for gravity", {
spcov_params_val <- spcov_params("gravity", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for rquad", {
spcov_params_val <- spcov_params("rquad", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for magnetic", {
spcov_params_val <- spcov_params("magnetic", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for none", {
spcov_params_val <- spcov_params("none", ie = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, mean = 4))
})
test_that("the simulation runs for matern", {
spcov_params_val <- spcov_params("matern", de = 1, ie = 1, range = 1, extra = 1 / 2)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for cauchy", {
spcov_params_val <- spcov_params("cauchy", de = 1, ie = 1, range = 1, extra = 1 / 2)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for pexponential", {
spcov_params_val <- spcov_params("pexponential", de = 1, ie = 1, range = 1, extra = 1 / 2)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = xcoord, ycoord = ycoord))
})
test_that("the simulation runs for sar", {
spcov_params_val <- spcov_params("sar", de = 1, ie = 1, range = 1 / 2, extra = 0)
expect_vector(sprnorm(spcov_params_val, data = exdata_poly))
})
test_that("the simulation runs for sar unconnected", {
spcov_params_val <- spcov_params("sar", de = 1, ie = 1, range = 1 / 2, extra = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata_Upoly))
})
test_that("quoting works", {
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata, xcoord = "xcoord", ycoord = "ycoord"))
})
test_that("sf works", {
exdata_sf <- sf::st_as_sf(exdata, coords = c("xcoord", "ycoord"))
spcov_params_val <- spcov_params("exponential", de = 1, ie = 1, range = 1)
expect_vector(sprnorm(spcov_params_val, data = exdata_sf))
})
##############################################################################
############################ summary (test-summary.R)
##############################################################################
test_that("summary works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_error(summary(spmod), NA)
})
test_that("summary works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_error(summary(spmod), NA)
})
##############################################################################
############################ tidy (test-tidy.R)
##############################################################################
test_that("tidy works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_null(tidy(spmod, effects = "randcov"))
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
test_that("tidy works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord, random = ~group)
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_s3_class(tidy(spmod, effects = "randcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "randcov")), 3)
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
test_that("tidy works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_null(tidy(spmod, effects = "randcov"))
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
test_that("tidy works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car", random = ~group)
expect_s3_class(tidy(spmod), "tbl")
expect_equal(ncol(tidy(spmod)), 5)
expect_s3_class(tidy(spmod, effects = "spcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "spcov")), 3)
expect_s3_class(tidy(spmod, effects = "randcov"), "tbl")
expect_equal(ncol(tidy(spmod, effects = "randcov")), 3)
expect_s3_class(tidy(anova(spmod)), "tbl")
expect_equal(ncol(tidy(anova(spmod))), 4)
})
##############################################################################
############################ varcomp (test-varcomp.R)
##############################################################################
test_that("varcomp works geostatistical", {
spmod <- splm(y ~ x, exdata, spcov_type = "exponential", xcoord = xcoord, ycoord = ycoord, estmethod = "reml")
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 3)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works geostatistical random", {
spmod <- splm(y ~ x, exdata,
spcov_type = "exponential", xcoord = xcoord,
ycoord = ycoord, estmethod = "reml", random = ~group
)
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 4)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works autoregressive", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "reml")
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 3)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works autoregressive random", {
spmod <- spautor(y ~ x, exdata_poly, spcov_type = "car", estmethod = "reml", random = ~group)
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val), 4)
expect_equal(sum(varcomp_val$proportion), 1)
})
test_that("varcomp works unconnected autoregressive", {
spmod <- spautor(y ~ x, exdata_Upoly, spcov_type = "car", estmethod = "reml")
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val$connected), 3)
expect_equal(sum(varcomp_val$connected$proportion), 1)
expect_equal(NROW(varcomp_val$unconnected), 2)
expect_equal(sum(varcomp_val$unconnected$proportion), 1)
expect_equal(length(varcomp_val$ratio), 1)
})
test_that("varcomp works unconnected autoregressive random", {
spmod <- spautor(y ~ x, exdata_Upoly, spcov_type = "car", estmethod = "reml", random = ~group)
varcomp_val <- varcomp(spmod)
expect_equal(NROW(varcomp_val$connected), 4)
expect_equal(sum(varcomp_val$connected$proportion), 1)
expect_equal(NROW(varcomp_val$unconnected), 3)
expect_equal(sum(varcomp_val$unconnected$proportion), 1)
expect_equal(length(varcomp_val$ratio), 1)
})
##############################################################################
############################ vcov (test-vcov.R)
##############################################################################
test_that("vcov works geo", {
spmod <- splm(y ~ x, exdata, "exponential", xcoord, ycoord)
expect_true(isSymmetric(vcov(spmod)))
expect_true(all(diag(vcov(spmod)) >= 0))
})
test_that("vcov works auto", {
spmod <- spautor(y ~ x, exdata_poly, "car")
expect_true(isSymmetric(vcov(spmod)))
expect_true(all(diag(vcov(spmod)) >= 0))
})
}
Try the spmodel 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.