# This file was generated, do not edit by hand
# Please edit inst/srr_template_spatial_yardstick.R instead
test_that("srr: expected failures for ww_local_getis_ord_g_pvalue", {
worldclim_predicted <- worldclim_simulation
worldclim_predicted$predicted <- predict(
lm(response ~ bio2 * bio10 * bio13 * bio19, data = worldclim_simulation),
worldclim_simulation
)
worldclim_weights <- ww_build_weights(worldclim_simulation)
# Note that this test isn't applicable to data-frame input, which enforces
# constant column lengths
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G2.0} Truth and estimate are equal in length:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(
worldclim_predicted$response,
tail(worldclim_predicted$predicted, -1),
worldclim_weights
),
error = TRUE
)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G2.0} Truth and estimate are equal in length:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(
tail(worldclim_predicted$response, -1),
worldclim_predicted$predicted,
worldclim_weights
),
error = TRUE
)
worldclim_predicted$predicted <- as.character(worldclim_predicted$predicted)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G5.8b} Data of unsupported types
#' @srrstats {G2.1} Truth and estimate are numeric:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response),
error = TRUE
)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G5.8b} Data of unsupported types
#' @srrstats {G2.1} Truth and estimate are numeric:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted),
error = TRUE
)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G5.8b} Data of unsupported types
#' @srrstats {G2.1} Truth and estimate are numeric:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(
worldclim_predicted$response,
worldclim_predicted$predicted,
worldclim_weights
),
error = TRUE
)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G5.8b} Data of unsupported types
#' @srrstats {G2.1} Truth and estimate are numeric:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(
worldclim_predicted$predicted,
worldclim_predicted$response,
worldclim_weights
),
error = TRUE
)
worldclim_predicted$predicted <- lapply(
as.numeric(worldclim_predicted$predicted),
function(x) (x)
)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G5.8b} Data of unsupported types
#' @srrstats {G2.12} List column inputs fail:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted),
error = TRUE
)
#' @srrstats {G5.2} Testing errors
#' @srrstats {G5.2b} Testing errors
#' @srrstats {G5.8b} Data of unsupported types
#' @srrstats {G2.12} List column inputs fail:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response),
error = TRUE
)
worldclim_predicted$predicted <- unlist(worldclim_predicted$predicted)
#' @srrstats {G2.13} Missing data is properly handled
#' @srrstats {G2.15} Missingness is checked
#' @srrstats {G2.14} Users can specify behavior with NA results
#' @srrstats {G2.16} NaN is properly handled
#' Users can error:
worldclim_predicted$response[4] <- NA_real_
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response)$.estimate,
error = TRUE
)
#' Users can error:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted)$.estimate,
error = TRUE
)
#' Users can error:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$predicted, worldclim_predicted$response, worldclim_weights),
error = TRUE
)
#' Users can error:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$response, worldclim_predicted$predicted, worldclim_weights),
error = TRUE
)
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8a} Zero-length data:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(numeric(), numeric(), structure(list(), class = "listw")),
error = TRUE
)
empty_df <- tibble::tibble(x = numeric(), y = numeric())
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8a} Zero-length data:
expect_snapshot(
ww_local_getis_ord_g_pvalue(head(worldclim_predicted, 0), response, predicted, structure(list(), class = "listw")),
error = TRUE
)
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8a} Zero-length data:
expect_snapshot(
ww_local_getis_ord_g_pvalue(head(worldclim_predicted, 0), predicted, response, structure(list(), class = "listw")),
error = TRUE
)
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8c} All-NA:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(NA_real_, NA_real_, structure(list(neighbours = 1), class = "listw")),
error = TRUE
)
worldclim_predicted$response <- NA_real_
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8c} All-NA:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted)$.estimate,
error = TRUE
)
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8c} All-NA:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response)$.estimate,
error = TRUE
)
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8c} All-identical:
expect_snapshot(
ww_local_getis_ord_g_pvalue_vec(worldclim_simulation$response, worldclim_simulation$response, worldclim_weights)
)
#' @srrstats {G5.8} Edge condition tests
#' @srrstats {G5.8c} All-identical:
expect_snapshot(
ww_local_getis_ord_g_pvalue(worldclim_simulation, response, response)
)
})
test_that("other generic srr standards", {
skip_if_not_installed("withr")
worldclim_predicted <- worldclim_simulation
worldclim_predicted$predicted <- predict(
lm(response ~ bio2 * bio10 * bio13 * bio19, data = worldclim_simulation),
worldclim_simulation
)
noised_worldclim <- worldclim_predicted + rnorm(
nrow(worldclim_predicted) * ncol(worldclim_predicted),
.Machine$double.eps,
.Machine$double.eps
)
noised_worldclim <- sf::st_as_sf(
noised_worldclim,
crs = sf::st_crs(worldclim_predicted)
)
worldclim_weights <- ww_build_weights(worldclim_simulation)
noised_weights <- ww_build_weights(noised_worldclim)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9a} Trivial noise doesn't change results:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted)
),
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(noised_worldclim, response, predicted)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9a} Trivial noise doesn't change results:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response)
),
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(noised_worldclim, predicted, response)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9a} Trivial noise doesn't change results:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$predicted, worldclim_predicted$response, worldclim_weights)
),
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(noised_worldclim$predicted, noised_worldclim$response, noised_weights)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9a} Trivial noise doesn't change results:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$response, worldclim_predicted$predicted, worldclim_weights)
),
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(noised_worldclim$response, noised_worldclim$predicted, noised_weights)
)
)
skip_on_cran()
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9b} Different seeds are equivalent:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response, nsim = 10000)
),
withr::with_seed(
1107,
ww_local_getis_ord_g_pvalue(worldclim_predicted, predicted, response, nsim = 10000)
), tolerance = 0.03
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9b} Different seeds are equivalent:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted, nsim = 10000)
),
withr::with_seed(
1107,
ww_local_getis_ord_g_pvalue(worldclim_predicted, response, predicted, nsim = 10000)
), tolerance = 0.03
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9b} Different seeds are equivalent:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$response, worldclim_predicted$predicted, worldclim_weights, nsim = 10000)
),
withr::with_seed(
1107,
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$response, worldclim_predicted$predicted, worldclim_weights, nsim = 10000)
), tolerance = 0.03
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {G5.9} Noise susceptibility tests
#' @srrstats {G5.9b} Different seeds are equivalent:
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$predicted, worldclim_predicted$response, worldclim_weights, nsim = 10000)
),
withr::with_seed(
1107,
ww_local_getis_ord_g_pvalue_vec(worldclim_predicted$predicted, worldclim_predicted$response, worldclim_weights, nsim = 10000)
), tolerance = 0.03
)
guerry_modeled <- guerry
guerry_modeled$predictions <- predict(
lm(Crm_prs ~ Litercy, guerry),
guerry
)
guerry_modeled_geo <- sf::st_transform(guerry_modeled, 4326)
guerry_weights <- ww_build_weights(guerry)
guerry_weights_geo <- ww_build_weights(guerry_modeled_geo)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.1} Testing with both projected and geographic CRS
#' @srrstats {SP6.1b} Testing with both projected and geographic CRS
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
ww_local_getis_ord_g_pvalue(guerry_modeled, predictions, Crm_prs, nsim = 10000)$.estimate,
ww_local_getis_ord_g_pvalue(guerry_modeled_geo, predictions, Crm_prs, nsim = 10000)$.estimate, tolerance = 0.03
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.1} Testing with both projected and geographic CRS
#' @srrstats {SP6.1b} Testing with both projected and geographic CRS
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
ww_local_getis_ord_g_pvalue(guerry_modeled, Crm_prs, predictions, nsim = 10000)$.estimate,
ww_local_getis_ord_g_pvalue(guerry_modeled_geo, Crm_prs, predictions, nsim = 10000)$.estimate, tolerance = 0.03
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.1} Testing with both projected and geographic CRS
#' @srrstats {SP6.1b} Testing with both projected and geographic CRS
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
ww_local_getis_ord_g_pvalue_vec(guerry_modeled$Crm_prs, guerry_modeled$predictions, guerry_weights, nsim = 10000),
ww_local_getis_ord_g_pvalue_vec(guerry_modeled_geo$Crm_prs, guerry_modeled_geo$predictions, guerry_weights_geo, nsim = 10000), tolerance = 0.03
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.1} Testing with both projected and geographic CRS
#' @srrstats {SP6.1b} Testing with both projected and geographic CRS
#' @srrstats {SP6.2} Testing with ~global data
expect_equal(
ww_local_getis_ord_g_pvalue_vec(guerry_modeled$predictions, guerry_modeled$Crm_prs, guerry_weights, nsim = 10000),
ww_local_getis_ord_g_pvalue_vec(guerry_modeled_geo$predictions, guerry_modeled_geo$Crm_prs, guerry_weights_geo, nsim = 10000), tolerance = 0.03
)
#' @srrstats {SP2.3} Testing with loaded sf objects:
worldclim_loaded <- sf::read_sf(
system.file("worldclim_simulation.gpkg", package = "waywiser")
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP2.3} Testing with loaded sf objects:
#' @srrstats {SP6.2} Testing with ~global data
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_loaded, bio13, bio19)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP2.3} Testing with loaded sf objects:
#' @srrstats {SP6.2} Testing with ~global data
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_loaded, bio13, bio19)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP2.3} Testing with loaded sf objects:
#' @srrstats {SP6.2} Testing with ~global data
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_loaded$bio13, worldclim_loaded$bio19, worldclim_weights)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP2.3} Testing with loaded sf objects:
#' @srrstats {SP6.2} Testing with ~global data
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_loaded$bio13, worldclim_loaded$bio19, worldclim_weights)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP2.3} Testing with loaded sf objects:
#' @srrstats {SP6.2} Testing with ~global data
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_loaded, bio13, bio19)
)
)
other_weights <- ww_build_weights(ww_make_point_neighbors(worldclim_loaded, k = 5))
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.3} Testing alternative weights:
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue(worldclim_loaded, bio13, bio19, function(data) ww_build_weights(ww_make_point_neighbors(data, k = 5)))
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.3} Testing alternative weights:
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_loaded$bio13, worldclim_loaded$bio19, other_weights)
)
)
#' @srrstats {G3.0} Testing with appropriate tolerances.
#' @srrstats {SP6.3} Testing alternative weights:
expect_snapshot(
withr::with_seed(
123,
ww_local_getis_ord_g_pvalue_vec(worldclim_loaded$bio13, worldclim_loaded$bio19, other_weights)
)
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.