Nothing
# Data used for testing Kriging Ordinary
# Date of test creation: 2025-09-01
# Test update date: 2025-09-01
#
# Data input
data("BD_Obs", package = "InterpolateR")
data("BD_Coord", package = "InterpolateR")
# load area
shapefile <- terra::vect(system.file(
"extdata/study_area.shp",
package = "InterpolateR"
))
# Rain threshold for categorical metrics
Rain_threshold <- list(
no_rain = c(0, 1),
light_rain = c(1, 5),
moderate_rain = c(5, 20),
heavy_rain = c(20, 40),
extremely_rain = c(40, Inf)
)
# Skip cran
testthat::skip_on_cran()
# 1. Testing without validation ---------------------------------------------------
testthat::test_that("Kriging_Ordinary returns SpatRaster without validation.", {
testthat::skip_on_cran()
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), length(unique(BD_Obs$Date)))
})
# 2. Testing with validation (random validation) --------------------------------
testthat::test_that("Kriging_Ordinary returns SpatRaster with random validation.", {
testthat::skip_on_cran()
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "spherical",
max_dist = 50000,
n_lags = 10,
min_stations = 2,
n_round = 2,
training = 0.8,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
)
testthat::expect_true(inherits(out$Ensamble, "SpatRaster"))
testthat::expect_equal(
terra::nlyr(out$Ensamble),
length(unique(BD_Obs$Date))
)
testthat::expect_true(inherits(out$Validation, "data.table"))
})
# 3. Testing with validation (manual validation) --------------------------------
testthat::test_that("Kriging_Ordinary returns SpatRaster with manual validation.", {
testthat::skip_on_cran()
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "gaussian",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = "M001",
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
)
testthat::expect_true(inherits(out$Ensamble, "SpatRaster"))
testthat::expect_equal(
terra::nlyr(out$Ensamble),
length(unique(BD_Obs$Date))
)
testthat::expect_true(inherits(out$Validation, "data.table"))
})
# 4. Testing with categorical validation -----------------------------------------
testthat::test_that("Kriging_Ordinary returns validation with Rain_threshold parameter.", {
testthat::skip_on_cran()
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "linear",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = NULL,
training = 0.7,
stat_validation = NULL,
Rain_threshold = Rain_threshold,
save_model = FALSE,
name_save = NULL
)
# Check that output is a list with proper structure
testthat::expect_true(is.list(out))
testthat::expect_true("Ensamble" %in% names(out))
testthat::expect_true("Validation" %in% names(out))
testthat::expect_true(inherits(out$Ensamble, "SpatRaster"))
# Check validation output structure
testthat::expect_true(!is.null(out$Validation))
# Find validation data (could be nested in list structure)
validation_data <- NULL
if (inherits(out$Validation, c("data.table", "data.frame"))) {
validation_data <- out$Validation
} else if (is.list(out$Validation)) {
# Find first data.table/data.frame in the list
for (item in out$Validation) {
if (inherits(item, c("data.table", "data.frame"))) {
validation_data <- item
break
}
}
}
# Check that we found validation data
testthat::expect_true(
!is.null(validation_data),
info = "Should contain validation data structure"
)
# Check for standard validation metrics (these should always be present)
if (!is.null(validation_data)) {
validation_names <- names(validation_data)
# Check for standard continuous metrics
standard_metrics <- any(grepl("RMSE|MAE|NSE|R2|KGE", validation_names, ignore.case = TRUE))
testthat::expect_true(
standard_metrics,
info = paste("Available columns:", paste(validation_names, collapse = ", "))
)
# Note: Categorical metrics (CSI, POD, FAR) may not be implemented yet
# with Rain_threshold parameter without errors
}
})
# 5. Testing different variogram models ------------------------------------------
testthat::test_that("Kriging_Ordinary works with all variogram models.", {
testthat::skip_on_cran()
models <- c("exponential", "spherical", "gaussian", "linear")
for (model in models) {
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = model,
max_dist = NULL,
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
)
testthat::expect_true(
inherits(out, "SpatRaster"),
info = paste("Failed for model:", model)
)
}
})
##############################################################################
# Check that the algorithm stops when the input data is not correct. #
##############################################################################
# 6. shapefile must be a 'SpatVector' object. ----------------------------------
testthat::test_that("Error if `shapefile` is not SpatVector.", {
testthat::skip_on_cran()
bad_shape <- data.frame(x = 1:10, y = rnorm(10))
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
BD_Coord,
bad_shape,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "shapefile must be a 'SpatVector' with a defined CRS\\.$"
)
})
# 7. BD_Obs must be a 'data.table' or a 'data.frame'." -------------------------
testthat::test_that("Error if `BD_Obs` is not a data.table or data.frame.", {
testthat::skip_on_cran()
bad_obs <- list(x = 1:10, y = rnorm(10))
testthat::expect_error(
Kriging_Ordinary(
bad_obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "BD_Obs must be a 'data.frame' or 'data.table'\\.$"
)
})
# 8. BD_Coord must be a 'data.table' or a 'data.frame'." -----------------------
testthat::test_that("Error if `BD_Coord` is not a data.table or data.frame.", {
testthat::skip_on_cran()
bad_coord <- list(x = 1:10, y = rnorm(10))
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
bad_coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "BD_Coord must be a 'data.frame' or 'data.table'\\.$"
)
})
# 9. variogram_model must be valid ----------------------------------------------
testthat::test_that("Error if `variogram_model` is invalid.", {
testthat::skip_on_cran()
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "invalid_model",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "variogram_model must be one of 'exponential', 'spherical', 'gaussian', or 'linear'\\.$"
)
})
# 10. grid_resolution must be numeric -------------------------------------------
testthat::test_that("Error if `grid_resolution` is not numeric.", {
testthat::skip_on_cran()
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = "invalid",
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "'grid_resolution' must be a single numeric value \\(km\\)\\.$"
)
})
# 11. n_lags must be positive integer -------------------------------------------
testthat::test_that("Error if `n_lags` is not a positive integer.", {
testthat::skip_on_cran()
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = -5,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "'n_lags' must be a single positive integer\\.$"
)
})
# 12. min_stations must be positive integer -------------------------------------
testthat::test_that("Error if `min_stations` is not a positive integer.", {
testthat::skip_on_cran()
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 0,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "'min_stations' must be a single positive integer\\.$"
)
})
# 13. n_round validation --------------------------------------------------------
testthat::test_that("Error if `n_round` is invalid.", {
testthat::skip_on_cran()
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = -1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "'n_round' must be NULL or a single non-negative integer\\.$"
)
})
# 14. Coordinate names mismatch -------------------------------------------------
testthat::test_that("Error if coordinates names do not appear in observed data.", {
testthat::skip_on_cran()
# Create copy of BD_Coord with invalid code
bad_coord <- BD_Coord
bad_coord[3, "Cod"] <- "INVALID_STATION"
testthat::expect_error(
Kriging_Ordinary(
BD_Obs,
bad_coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = FALSE,
name_save = NULL
),
regexp = "Coordinate names don't match observed data columns\\.$"
)
})
# 15. Test model saving ---------------------------------------------------------
testthat::test_that("Kriging_Ordinary saves model when save_model = TRUE", {
testthat::skip_on_cran()
temp_dir <- tempdir()
withr::local_dir(temp_dir)
testthat::expect_message(
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = TRUE,
name_save = "Test_Kriging"
),
"Model saved successfully as Test_Kriging.nc"
)
expected_file <- file.path(temp_dir, "Test_Kriging.nc")
testthat::expect_true(file.exists(expected_file), info = expected_file)
})
# 16. Test with default name saving ---------------------------------------------
testthat::test_that("Kriging_Ordinary saves model with default name", {
testthat::skip_on_cran()
temp_dir <- tempdir()
withr::local_dir(temp_dir)
testthat::expect_message(
out <- Kriging_Ordinary(
BD_Obs,
BD_Coord,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = NULL,
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1,
stat_validation = NULL,
Rain_threshold = NULL,
save_model = TRUE,
name_save = NULL
),
"Model saved successfully as Model_Kriging.nc"
)
expected_file <- file.path(temp_dir, "Model_Kriging.nc")
testthat::expect_true(file.exists(expected_file), info = expected_file)
})
##############################################################################
# TESTS FOR EDGE CASES - 100% COVERAGE #
##############################################################################
# 17. Edge case: Less than 2 valid stations (activates first red fragment) ----
testthat::test_that("Kriging_Ordinary handles < 2 valid stations correctly", {
testthat::skip_on_cran()
# Create data with only one valid station
BD_Obs_single <- data.table::copy(BD_Obs)[1:3] # Take first 3 rows
BD_Obs_single[, `:=`(
M001 = c(5.0, NA_real_, NA_real_), # Only first date has valid data
M002 = c(NA_real_, NA_real_, NA_real_), # All NA
M003 = c(NA_real_, NA_real_, NA_real_) # All NA
)]
BD_Coord_single <- BD_Coord[Cod %in% c("M001", "M002", "M003")]
# This should activate: sum(valid_idx) < 2 case
out <- Kriging_Ordinary(
BD_Obs_single,
BD_Coord_single,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_single))
})
# 18. Edge case: All values identical (activates constant values fragment) ----
testthat::test_that("Kriging_Ordinary handles identical values correctly", {
testthat::skip_on_cran()
# Create data where all stations have identical values
BD_Obs_constant <- data.table::copy(BD_Obs)[1:2] # Take first 2 rows
BD_Coord_constant <- BD_Coord[1:4] # Take first 4 stations
# Set all values to be identical
for (col in names(BD_Obs_constant)[-1]) {
BD_Obs_constant[, (col) := 10.5] # All stations = 10.5
}
# This should activate: length(unique(values[valid_idx])) == 1 case
out <- Kriging_Ordinary(
BD_Obs_constant,
BD_Coord_constant,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_constant))
})
# 19. Edge case: All stations NA (activates "else 0" fragment) ---------------
testthat::test_that("Kriging_Ordinary handles all NA stations correctly", {
testthat::skip_on_cran()
# Create data where all stations are NA for some dates
BD_Obs_all_na <- data.table::copy(BD_Obs)[1:3]
BD_Coord_all_na <- BD_Coord[1:3]
# Set all values to NA for all dates
for (col in names(BD_Obs_all_na)[-1]) {
BD_Obs_all_na[, (col) := NA_real_]
}
# This should activate: length(available_values) > 0) mean(available_values) else 0
out <- Kriging_Ordinary(
BD_Obs_all_na,
BD_Coord_all_na,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_all_na))
})
# 20. Edge case: Only one station with valid data (activates single station fragment) ----
testthat::test_that("Kriging_Ordinary handles single valid station correctly", {
testthat::skip_on_cran()
# Create data with only one station having valid data
BD_Obs_one <- data.table::copy(BD_Obs)[1:2]
BD_Coord_one <- BD_Coord[1:4]
# Set only first station to have data, others NA
for (i in 2:ncol(BD_Obs_one)) {
if (i == 2) {
BD_Obs_one[[i]] <- c(15.5, 20.3) # Only first station has data
} else {
BD_Obs_one[[i]] <- NA_real_ # All others NA
}
}
# This should activate: length(available_stations) < 2 case
out <- Kriging_Ordinary(
BD_Obs_one,
BD_Coord_one,
shapefile,
grid_resolution = 5,
variogram_model = "spherical",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_one))
})
# 21. Edge case: All values zero (activates zero values fragment) ------------
testthat::test_that("Kriging_Ordinary handles all zero values correctly", {
testthat::skip_on_cran()
# Create data where all values are zero
BD_Obs_zero <- data.table::copy(BD_Obs)[1:2]
BD_Coord_zero <- BD_Coord[1:4]
# Set all values to zero
for (col in names(BD_Obs_zero)[-1]) {
BD_Obs_zero[, (col) := 0.0]
}
# This should activate: all(data_obs$var == 0) case in process_day
out <- Kriging_Ordinary(
BD_Obs_zero,
BD_Coord_zero,
shapefile,
grid_resolution = 5,
variogram_model = "gaussian",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_zero))
})
# AÑADIR ESTOS TESTS AL FINAL DE TU ARCHIVO EXISTENTE
# (después del test #16 y antes de "# End of tests for Kriging_Ordinary")
##############################################################################
# TESTS FOR EDGE CASES - 100% COVERAGE #
##############################################################################
# 17. Edge case: Less than 2 valid stations (activates first red fragment) ----
testthat::test_that("Kriging_Ordinary handles < 2 valid stations correctly", {
testthat::skip_on_cran()
# Create data with only one valid station
BD_Obs_single <- data.table::copy(BD_Obs)[1:3] # Take first 3 rows
BD_Obs_single[, `:=`(
M001 = c(5.0, NA_real_, NA_real_), # Only first date has valid data
M002 = c(NA_real_, NA_real_, NA_real_), # All NA
M003 = c(NA_real_, NA_real_, NA_real_) # All NA
)]
BD_Coord_single <- BD_Coord[Cod %in% c("M001", "M002", "M003")]
# This should activate: sum(valid_idx) < 2 case
out <- Kriging_Ordinary(
BD_Obs_single,
BD_Coord_single,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 15,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_single))
})
# 18. Edge case: All values identical (activates constant values fragment) ----
testthat::test_that("Kriging_Ordinary handles identical values correctly", {
testthat::skip_on_cran()
# Create data where all stations have identical values
BD_Obs_constant <- data.table::copy(BD_Obs)[1:2] # Take first 2 rows
BD_Coord_constant <- BD_Coord[1:4] # Take first 4 stations
# Set all values to be identical
for (col in names(BD_Obs_constant)[-1]) {
BD_Obs_constant[, (col) := 10.5] # All stations = 10.5
}
# This should activate: length(unique(values[valid_idx])) == 1 case
out <- Kriging_Ordinary(
BD_Obs_constant,
BD_Coord_constant,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_constant))
})
# 19. Edge case: All stations NA (activates "else 0" fragment) ---------------
testthat::test_that("Kriging_Ordinary handles all NA stations correctly", {
testthat::skip_on_cran()
# Create data where all stations are NA for some dates
BD_Obs_all_na <- data.table::copy(BD_Obs)[1:3]
BD_Coord_all_na <- BD_Coord[1:3]
# Set all values to NA for all dates
for (col in names(BD_Obs_all_na)[-1]) {
BD_Obs_all_na[, (col) := NA_real_]
}
# This should activate: length(available_values) > 0) mean(available_values) else 0
out <- Kriging_Ordinary(
BD_Obs_all_na,
BD_Coord_all_na,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_all_na))
})
# 20. Edge case: Only one station with valid data (activates single station fragment) ----
testthat::test_that("Kriging_Ordinary handles single valid station correctly", {
testthat::skip_on_cran()
# Create data with only one station having valid data
BD_Obs_one <- data.table::copy(BD_Obs)[1:2]
BD_Coord_one <- BD_Coord[1:4]
# Set only first station to have data, others NA
for (i in 2:ncol(BD_Obs_one)) {
if (i == 2) {
BD_Obs_one[[i]] <- c(15.5, 20.3) # Only first station has data
} else {
BD_Obs_one[[i]] <- NA_real_ # All others NA
}
}
# This should activate: length(available_stations) < 2 case
out <- Kriging_Ordinary(
BD_Obs_one,
BD_Coord_one,
shapefile,
grid_resolution = 5,
variogram_model = "spherical",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_one))
})
# 21. Edge case: All values zero (activates zero values fragment) ------------
testthat::test_that("Kriging_Ordinary handles all zero values correctly", {
testthat::skip_on_cran()
# Create data where all values are zero
BD_Obs_zero <- data.table::copy(BD_Obs)[1:2]
BD_Coord_zero <- BD_Coord[1:4]
# Set all values to zero
for (col in names(BD_Obs_zero)[-1]) {
BD_Obs_zero[, (col) := 0.0]
}
# This should activate: all(data_obs$var == 0) case in process_day
out <- Kriging_Ordinary(
BD_Obs_zero,
BD_Coord_zero,
shapefile,
grid_resolution = 5,
variogram_model = "gaussian",
n_lags = 10,
min_stations = 2,
n_round = 1,
training = 1
)
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_zero))
})
# 22. Edge case: Very small max_dist (activates sum(valid_pairs) == 0 fragment) ----
testthat::test_that("Kriging_Ordinary handles very small max_dist correctly", {
testthat::skip_on_cran()
# Create data with stations that are far apart
BD_Obs_small <- data.table(
Date = as.Date(c("2015-01-01", "2015-01-02")),
ST_A = c(5.0, 10.0),
ST_B = c(8.0, 12.0),
ST_C = c(6.5, 11.5)
)
# Create coordinates with large distances between stations
BD_Coord_small <- data.table(
Cod = c("ST_A", "ST_B", "ST_C"),
X = c(0, 50000, 100000), # Stations 50km apart
Y = c(0, 50000, 100000)
)
# Use very small max_dist relative to station separation
# This should activate: sum(valid_pairs) == 0 case
testthat::expect_no_error({
out <- Kriging_Ordinary(
BD_Obs_small,
BD_Coord_small,
shapefile,
grid_resolution = 5,
variogram_model = "linear",
max_dist = 100, # Much smaller than station distances
n_lags = 5,
min_stations = 2,
n_round = 1,
training = 1
)
})
testthat::expect_true(inherits(out, "SpatRaster"))
testthat::expect_equal(terra::nlyr(out), nrow(BD_Obs_small))
})
# 23. Edge case: Numerical extremes (activates error fallback fragment) -----
testthat::test_that("Kriging_Ordinary handles numerical extremes correctly", {
testthat::skip_on_cran()
# Create data with extreme values that might cause numerical issues
BD_Obs_extreme <- data.table(
Date = as.Date(c("2015-01-01", "2015-01-02")),
ST_A = c(5.0, 10.0),
ST_B = c(8.0, 12.0),
ST_C = c(6.5, 11.5)
)
BD_Coord_extreme <- data.table(
Cod = c("ST_A", "ST_B", "ST_C"),
X = c(0, 50000, 100000), # Stations 50km apart
Y = c(0, 50000, 100000)
)
# Set extreme observation values
for (i in 2:ncol(BD_Obs_extreme)) {
BD_Obs_extreme[[i]] <- c(1e8 * (i-1), -1e8 * (i-1)) # Very large values
}
# This might activate the tryCatch error handler and fallback
testthat::expect_no_error({
out <- Kriging_Ordinary(
BD_Obs_extreme,
BD_Coord_extreme,
shapefile,
grid_resolution = 5,
variogram_model = "exponential",
max_dist = 1000, # Small distance to potentially cause issues
n_lags = 5,
min_stations = 2,
n_round = 1,
training = 1
)
})
})
# 24. Edge case: Test with validation to ensure coverage in validation paths --
# Test corregido para casos extremos con validación habilitada
testthat::test_that("Edge cases work correctly with validation enabled", {
testthat::skip_on_cran()
# Test edge case with validation to ensure validation paths are also covered
BD_Obs_edge_val <- data.table::copy(BD_Obs)[1:5] # More rows for validation
BD_Coord_edge_val <- BD_Coord[1:6] # More stations for validation
# Obtener los nombres de las columnas de estaciones (excluyendo Date)
station_cols <- names(BD_Obs_edge_val)[-1]
# Verificar que tenemos exactamente 6 estaciones como esperamos
if (length(station_cols) != 6) {
# Si no tenemos exactamente 6, ajustar los datos
# Tomar solo las primeras 6 estaciones
station_cols <- station_cols[1:6]
BD_Obs_edge_val <- BD_Obs_edge_val[, c("Date", station_cols), with = FALSE]
BD_Coord_edge_val <- BD_Coord_edge_val[1:6]
}
# Create mixed scenario: some NA, some constant, some varying
# Usando una forma más segura de asignar valores
BD_Obs_edge_val[1, (station_cols) := list(5.0, 5.0, 5.0, NA_real_, NA_real_, 7.0)]
BD_Obs_edge_val[2, (station_cols) := list(NA_real_, 5.0, 5.0, 8.0, NA_real_, 9.0)]
BD_Obs_edge_val[3, (station_cols) := list(6.0, NA_real_, 5.0, 8.5, 10.0, NA_real_)]
BD_Obs_edge_val[4, (station_cols) := list(7.0, 6.0, NA_real_, NA_real_, 11.0, 12.0)]
BD_Obs_edge_val[5, (station_cols) := list(NA_real_, NA_real_, NA_real_, 9.0, 12.5, 13.0)]
# Test with validation to ensure edge cases work in validation context too
out <- Kriging_Ordinary(
BD_Obs_edge_val,
BD_Coord_edge_val,
shapefile,
grid_resolution = 5,
variogram_model = "spherical",
n_lags = 8,
min_stations = 2,
n_round = 1,
training = 0.7, # Enable validation
stat_validation = NULL,
Rain_threshold = NULL
)
testthat::expect_true(is.list(out))
testthat::expect_true("Ensamble" %in% names(out))
testthat::expect_true("Validation" %in% names(out))
testthat::expect_true(inherits(out$Ensamble, "SpatRaster"))
})
##############################################################################
# END OF COVERAGE TESTS #
##############################################################################
# Tests adicionales
# Test 25: Caso con datos insuficientes (< 2 estaciones válidas)
test_that("Kriging handles insufficient data cases correctly", {
# Crear datos con solo 1 estación válida
BD_Obs_insufficient <- data.table::data.table(
Date = as.Date(c("2015-01-01", "2015-01-02")),
ST001 = c(5.0, 3.0),
ST002 = c(NA, NA), # Todas las demás estaciones son NA
ST003 = c(NA, NA)
)
BD_Coord_insufficient <- data.table::data.table(
Cod = c("ST001", "ST002", "ST003"),
X = c(500000, 501000, 502000),
Y = c(9500000, 9501000, 9502000)
)
# Ejecutar Kriging con datos insuficientes
result <- Kriging_Ordinary(
BD_Obs = BD_Obs_insufficient,
BD_Coord = BD_Coord_insufficient,
shapefile = shapefile,
grid_resolution = 10,
variogram_model = "exponential"
)
# Verificar que devuelve un resultado válido
expect_s4_class(result, "SpatRaster")
expect_true(terra::nlyr(result) == 2)
})
# Test 26: Caso con valores constantes (todas las estaciones tienen el mismo valor)
test_that("Kriging handles constant values correctly", {
# Crear datos donde todas las estaciones tienen el mismo valor
BD_Obs_constant <- data.table::data.table(
Date = as.Date(c("2015-01-01", "2015-01-02")),
ST001 = c(10.0, 15.0),
ST002 = c(10.0, 15.0), # Mismo valor que ST001
ST003 = c(10.0, 15.0) # Mismo valor que ST001
)
BD_Coord_constant <- data.table::data.table(
Cod = c("ST001", "ST002", "ST003"),
X = c(500000, 501000, 502000),
Y = c(9500000, 9501000, 9502000)
)
# Ejecutar Kriging con valores constantes
result <- Kriging_Ordinary(
BD_Obs = BD_Obs_constant,
BD_Coord = BD_Coord_constant,
shapefile = shapefile,
grid_resolution = 10,
variogram_model = "exponential"
)
# Verificar que devuelve un resultado válido
expect_s4_class(result, "SpatRaster")
expect_true(terra::nlyr(result) == 2)
# Los valores del raster deberían ser constantes (iguales al valor de entrada)
values_layer1 <- terra::values(result[[1]], na.rm = TRUE)
expect_true(all(abs(values_layer1 - 10.0) < 0.01, na.rm = TRUE))
})
# Test 27: Caso que fuerza el cálculo del variograma empírico con datos límite
test_that("Kriging handles edge cases in empirical variogram calculation", {
# Crear datos con muy poca variabilidad espacial
BD_Obs_edge <- data.table::data.table(
Date = as.Date("2015-01-01"),
ST001 = 0.001, # Valores muy pequeños para forzar variograma plano
ST002 = 0.002,
ST003 = 0.001
)
BD_Coord_edge <- data.table::data.table(
Cod = c("ST001", "ST002", "ST003"),
X = c(500000, 500100, 500200), # Estaciones muy cercanas
Y = c(9500000, 9500100, 9500200)
)
# Ejecutar con n_lags específico para cubrir la secuencia en el código
result <- Kriging_Ordinary(
BD_Obs = BD_Obs_edge,
BD_Coord = BD_Coord_edge,
shapefile = shapefile,
grid_resolution = 5,
variogram_model = "exponential",
n_lags = 10 # Específicamente para cubrir la línea del lag_distances
)
expect_s4_class(result, "SpatRaster")
})
# Test 28: Caso con una sola estación disponible (available_values de longitud 1)
test_that("Kriging handles single available station", {
# Crear datos donde solo una estación tiene datos válidos por fecha
BD_Obs_single <- data.table::data.table(
Date = as.Date(c("2015-01-01", "2015-01-02")),
ST001 = c(5.0, NA), # Solo válida el primer día
ST002 = c(NA, 8.0), # Solo válida el segundo día
ST003 = c(NA, NA) # Nunca válida
)
BD_Coord_single <- data.table::data.table(
Cod = c("ST001", "ST002", "ST003"),
X = c(500000, 501000, 502000),
Y = c(9500000, 9501000, 9502000)
)
result <- Kriging_Ordinary(
BD_Obs = BD_Obs_single,
BD_Coord = BD_Coord_single,
shapefile = shapefile,
grid_resolution = 8,
variogram_model = "spherical"
)
expect_s4_class(result, "SpatRaster")
expect_true(terra::nlyr(result) == 2)
})
# Test 29: Caso específico para cubrir la condición when available_values is empty
test_that("Kriging handles completely empty available values", {
# Crear datos donde todas las estaciones son NA para una fecha
BD_Obs_empty <- data.table::data.table(
Date = as.Date(c("2015-01-01", "2015-01-02")),
ST001 = c(NA, 5.0),
ST002 = c(NA, 3.0),
ST003 = c(NA, 4.0)
)
BD_Coord_empty <- data.table::data.table(
Cod = c("ST001", "ST002", "ST003"),
X = c(500000, 501000, 502000),
Y = c(9500000, 9501000, 9502000)
)
result <- Kriging_Ordinary(
BD_Obs = BD_Obs_empty,
BD_Coord = BD_Coord_empty,
shapefile = shapefile,
grid_resolution = 10,
variogram_model = "gaussian"
)
expect_s4_class(result, "SpatRaster")
# El primer layer debería tener valor 0 (caso else en el código)
values_layer1 <- terra::values(result[[1]], na.rm = TRUE)
expect_true(all(values_layer1 == 0, na.rm = TRUE))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.