tests/testthat/test-RFmerge.R

In InterpolateR: A Comprehensive Toolkit for Fast and Efficient Spatial Interpolation

# Data used for testing RFmerge
# Date of test creation: 2025-04-29
# Test update date: 2025-04-29

# Data input
data("BD_Obs", package = "InterpolateR")
data("BD_Coord", package = "InterpolateR")

# Load the covariates
cov <- list(
  MSWEP = terra::rast(system.file("extdata/MSWEP.nc", package = "InterpolateR")),
  CHIRPS = terra::rast(system.file("extdata/CHIRPS.nc", package = "InterpolateR")),
  DEM = terra::rast(system.file("extdata/DEM.nc", package = "InterpolateR"))
)

# load mask
shapefile <- terra::vect(system.file("extdata/study_area.shp", package = "InterpolateR"))

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

# 1. Testing with validation ---------------------------------------------------
testthat::test_that("RFmerge returns SpatRaster without validation.", {
  testthat::skip_on_cran()
  out <- RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile, n_round = 1, ntree = 2000,
    seed = 123,  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("RFmerge returns SpatRaster with random validation.", {
  testthat::skip_on_cran()
  out <- RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile, n_round = 1, ntree = 2000,
    seed = 123,  training = 0.8, stat_validation = NULL, Rain_threshold = Rain_threshold,
    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$gof, "data.table"))
  testthat::expect_true(inherits(out$Validation$categorical_metrics, "data.table"))
})

# 3. Testing with validation (manual validation) --------------------------------
testthat::test_that("RFmerge returns SpatRaster with manual validation.", {
  testthat::skip_on_cran()
  out <- RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile, n_round = 1, ntree = 2000,
    seed = 123,  training = 1, stat_validation = "M004", Rain_threshold = Rain_threshold,
    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$gof, "data.table"))
  testthat::expect_true(inherits(out$Validation$categorical_metrics, "data.table"))
})

# 4. Testing  RFmerge returns SpatRaster with random validation without ---------
testthat::test_that("RFmerge returns SpatRaster with manual validation.", {
  testthat::skip_on_cran()
  out <- RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile, n_round = 1, ntree = 2000,
    seed = 123,  training = 1, stat_validation = "M004", 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"))
})

##############################################################################
#     Check that the algorithm stops when the input data is not correct.     #
##############################################################################
# 5. Testing error with The cov must be a list.
testthat::test_that("The cov must be a list.", {
  testthat::skip_on_cran()
  bad_cov <- data.frame(x = 1:10, y = rnorm(10))
  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, bad_cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "cov must be a list\\.$"
    )
  })

# 6. The cov must be of type SpatRaster.
testthat::test_that("The cov must be of type SpatRaster.", {
  testthat::skip_on_cran()
  bad_cov <- cov
  bad_cov$Test <- data.frame(x = 1:10, y = rnorm(10))
  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, bad_cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "The cov must be of type SpatRaster\\.$"
    )
})

# 7. The extension of the cov are different (all extensions should be similar)
testthat::test_that("The extension of the cov are different.", {
  testthat::skip_on_cran()
  bad_cov <- cov
  terra::ext(bad_cov$MSWEP) = terra::ext(bad_cov$MSWEP) * 2
  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, bad_cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "^The extension of the cov are different \\(all extensions should be similar\\)\\.$"
    )
})

# 8. "The crs of the cov are different (all crs should be similar).
testthat::test_that("The crs of the cov are different.", {
  testthat::skip_on_cran()
  bad_cov <- cov
  terra::crs(bad_cov$MSWEP) = "EPSG:4326"
  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, bad_cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "^The crs of the cov are different \\(all crs should be similar\\)\\.$"
    )
})

# 9. "BD_Obs must be a 'data.table' or a 'data.frame'."
testthat::test_that("BD_Obs must be a 'data.table' or a 'data.frame'.", {
  testthat::skip_on_cran()
  bad_BDObs = as.matrix(BD_Obs)
  testthat::expect_error(
    RFmerge(bad_BDObs, BD_Coord, cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "BD_Obs must be a 'data.table' or a 'data.frame'.$"
    )
})

# 10. BD_Coord must be a 'data.table' or a 'data.frame'."
testthat::test_that("BD_Coord must be a 'data.table' or a 'data.frame'.", {
  testthat::skip_on_cran()
  bad_BD_Coord = as.matrix(BD_Coord)
  testthat::expect_error(
    RFmerge(BD_Obs, bad_BD_Coord, cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "BD_Coord must be a 'data.table' or a 'data.frame'.$"
    )
})

# 11. "The names of the coordinates do not appear in the observed data."
testthat::test_that("names of the coordinates do not appear in the observed data.", {
  testthat::skip_on_cran()
  bad_Cords = BD_Coord
  bad_Cords[3,1] = "yy"
  testthat::expect_error(
    RFmerge(BD_Obs, bad_Cords, cov, mask = shapefile, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "The names of the coordinates do not appear in the observed data.$"
    )
})

# 12. mask must be a 'SpatVector' object.
testthat::test_that("mask must be a 'SpatVector'.", {
  testthat::skip_on_cran()
  bad_shp = BD_Obs
  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, cov, mask = bad_shp, n_round = 1, ntree = 2000,
      seed = 123,  training = 1, stat_validation = NULL, Rain_threshold = NULL,
      save_model = FALSE, name_save = NULL),
    regexp = "mask must be a 'SpatVector' object.$"
    )
})

# 13. Verify that all dates have at least one entry recorded
testthat::test_that("Error when BD_Obs has rows with all NA values (except Date)", {
  testthat::skip_on_cran()
  # Simular BD_Obs con una fila completamente NA (menos la fecha)
  BD_Obs <- data.table::data.table(
    Date = as.Date(c("2020-01-01", "2020-01-02")),
    Station1 = c(1.2, NA),
    Station2 = c(3.4, NA)
  )

  BD_Coord <- data.table::data.table(ID = c("Station1", "Station2"), x = c(1, 2), y = c(3, 4))

  # Crear una covariables falsas
  cov <- list(dummy = terra::rast(nrows = 2, ncols = 2, vals = runif(4)))
  shapefile <- terra::vect(matrix(c(1,1, 2,2, 2,1), ncol = 2, byrow = TRUE), type = "polygons")

  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile,
            n_round = 1, ntree = 10, seed = 123, training = 1,
            stat_validation = NULL, Rain_threshold = NULL,
            save_model = FALSE, name_save = NULL),
    regexp = "No data was found for the dates: 2020-01-02"
  )
})

# 14. "Save the model must be a logical value."
testthat::test_that("RFmerge saves model when save_model = TRUE", {
  testthat::skip_on_cran()
  temp_dir <- tempdir()
  withr::local_dir(temp_dir)
  custom_name <- "test_model_RFmerge"
  expect_message(
    out <- RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile,
      n_round = 1, ntree = 10, seed = 123, training = 1,
      stat_validation = NULL, Rain_threshold = NULL,
      save_model = T, name_save = custom_name
  ),
  "Model saved successfully"
)
  expected_file <- file.path(temp_dir, paste0(custom_name, ".nc"))
  testthat::expect_true(file.exists(expected_file), info = expected_file)

})

# 15. "Save the model must be a logical value." (default name) " ------------------
testthat::test_that("RFmerge saves model when save_model = TRUE (default name)", {
  testthat::skip_on_cran()
  temp_dir <- tempdir()
  withr::local_dir(temp_dir)
  expect_message(
    out <- RFmerge(BD_Obs, BD_Coord, cov, mask = shapefile,
      n_round = 1, ntree = 10, seed = 123, training = 1,
      stat_validation = NULL, Rain_threshold = NULL,
      save_model = T, name_save = NULL
  ),
    "Model saved successfully"
  )
  expected_file <- file.path(temp_dir, "Model_RFmerge.nc")
  testthat::expect_true(file.exists(expected_file), info = expected_file)
})

# 15. A single layer covariate was not found. Possibly the DEM was not entered..
testthat::test_that("Single layer covariate was not found.", {
  testthat::skip_on_cran()
  bad_Covs = cov
  bad_Covs$DEM = c(bad_Covs$DEM, bad_Covs$DEM)
  testthat::expect_error(
    RFmerge(BD_Obs, BD_Coord, bad_Covs, mask = shapefile,
      n_round = 1, ntree = 10, seed = 123, training = 1,
      stat_validation = NULL, Rain_threshold = NULL,
      save_model = T, name_save = NULL),
    regexp = "A single layer covariate was not found. Possibly the DEM was not entered.$"
    )
})