tests/testthat/test-Kriging_Ordinary.R

# 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))
})

Try the InterpolateR package in your browser

Any scripts or data that you put into this service are public.

InterpolateR documentation built on Sept. 9, 2025, 5:59 p.m.