tests/testthat/test_createCovariates.R

In camtrapR: Camera Trap Data Management and Analysis Framework

context("createCovariates")

library(testthat)
library(sf)
library(terra)
library(withr)

# --- Test Setup ---

# 1. Create a mock sf object from the 'camtraps' dataset
data(camtraps)
camtraps_sf <- st_as_sf(camtraps,
                        coords = c("utm_x", "utm_y"),
                        crs = 32650) # UTM Zone 50N

# 2. Create mock SpatRaster objects for reproducible testing
# Raster 1: Same CRS as camtraps_sf, predictable values
r1 <- rast(crs = "EPSG:32650", extent = ext(c(522500 , 526300 , 603700 , 607300)), resolution = 100)
values(r1) <- 1:ncell(r1)
names(r1) <- "cov_utm"

# Raster 2: Different CRS (WGS84), tests reprojection
r2 <- rast(crs = "EPSG:4326", extent = ext(c(117.2, 117.24, 5.46, 5.5)), resolution = 0.01)
values(r2) <- (1:ncell(r2)) * 10
names(r2) <- "cov_wgs"


# --- Test Suite ---

testthat::describe("Input Validation and Error Handling", {
  
  test_that("it stops for invalid CTtable inputs", {
    expect_error(createCovariates(camtraps), "CTtable is not an sf object.")
    
    
    expect_error({
      camtraps_sf_no_crs <- st_as_sf(camtraps, coords = c("utm_x", "utm_y"))
      createCovariates(camtraps_sf_no_crs)
    }, "Coordinate reference system of CTtable is not defined.")
    
    expect_error(createCovariates(camtraps_sf[0,]), "The 'CTtable' is empty.")
  })
  
  test_that("it stops when no data source is provided", {
    expect_error(createCovariates(camtraps_sf), 
                 "Please provide one of 'directory', 'filenames', 'rasters', or set 'download_elevation = TRUE'.")
  })
  
  test_that("it stops when multiple data sources are provided", {
    expect_error(createCovariates(camtraps_sf, directory = "a", rasters = r1),
                 "Provide only one of 'directory', 'filenames', or 'rasters'.")
  })
  
  test_that("it stops for invalid buffer or resolution values", {
    expect_error(createCovariates(camtraps_sf, rasters = r1, buffer_ct = -10),
                 "Buffer size for 'buffer_ct' must be numeric and positive.")
    expect_error(createCovariates(camtraps_sf, rasters = r1, resolution = -50),
                 "Invalid spatial resolution. Please provide a positive value.")
  })
})


testthat::describe("Core Functionality from SpatRaster Objects", {
  # Core Functionality from SpatRaster Objects
  
  test_that("it extracts values correctly from a list of SpatRasters", {
    raster_list <- list(my_utm_ras = r1, my_wgs_ras = r2)
    result <- createCovariates(camtraps_sf, rasters = raster_list, resolution = 200)
    
    # Check output structure
    expect_s3_class(result$CTtable, "sf")
    expect_s4_class(result$predictionRaster, "SpatRaster")
    expect_named(result, c("CTtable", "predictionRaster", "originalRaster"))
    
    # Check that new columns were added
    expect_true(all(c("my_utm_ras", "my_wgs_ras") %in% names(result$CTtable)))
    expect_equal(ncol(result$CTtable), ncol(camtraps_sf) + 2)
    
    # Check that prediction raster has the right layers and CRS
    expect_equal(names(result$predictionRaster), c("my_utm_ras", "my_wgs_ras"))
    expect_equal(crs(result$predictionRaster, proj = TRUE), crs(camtraps_sf, proj = TRUE))
  })
  
  test_that("buffering and interpolation options work", {
    # Test with a 200m buffer
    result_buffer <- createCovariates(camtraps_sf, rasters = r1, buffer_ct = 200, resolution = 200)
    # Test without buffer (simple extraction)
    result_simple <- createCovariates(camtraps_sf, rasters = r1, buffer_ct = 0, bilinear = FALSE, resolution = 200)
    
    # Values should be different due to averaging in the buffer
    expect_false(all(result_buffer$CTtable$cov_utm == result_simple$CTtable$cov_utm))
  })
  
  test_that("append = FALSE works correctly", {
    result <- createCovariates(camtraps_sf, rasters = r1, append = FALSE, resolution = 200)
    
    # Output should be a data.frame, not an sf object
    expect_s3_class(result$CTtable, "data.frame")
    expect_false(inherits(result$CTtable, "sf"))
    expect_equal(ncol(result$CTtable), 1) # Only the one covariate column
    expect_named(result$CTtable, "cov_utm")
  })
})


testthat::describe("Core Functionality from Files", {
  
  # Use a temporary directory for file-based tests
  with_tempdir({
    
    # Save our mock rasters to the temp directory
    writeRaster(r1, "cov_utm.tif")
    writeRaster(r2, "cov_wgs.tif")
    dir.create("subdir")
    writeRaster(r1 * 2, "subdir/cov_sub.tif", names = "cov_sub")
    
    test_that("it extracts values from a directory", {
      result <- createCovariates(camtraps_sf, directory = ".", resolution = 200)
      
      expect_true(all(c("cov_utm", "cov_wgs") %in% names(result$CTtable)))
      expect_equal(nlyr(result$predictionRaster), 2)
    })
    
    test_that("it extracts values recursively from a directory", {
      result <- createCovariates(camtraps_sf, directory = ".", recursive = TRUE, resolution = 200)
      
      # Should find all 3 rasters
      expect_true(all(c("cov_utm", "cov_wgs", "cov_sub") %in% names(result$CTtable)))
      expect_equal(nlyr(result$predictionRaster), 3)
    })
    
    test_that("it extracts values from a named character vector of filenames", {
      file_paths <- c(ras1 = "cov_utm.tif", ras2 = "cov_wgs.tif")
      result <- createCovariates(camtraps_sf, filenames = file_paths, resolution = 200)
      
      # Check that the provided names ("ras1", "ras2") are used
      expect_true(all(c("ras1", "ras2") %in% names(result$CTtable)))
      expect_equal(names(result$predictionRaster), c("ras1", "ras2"))
    })
  })
})


testthat::describe("Elevation Download and Terrain Measures", {
  
  # skip_if_not_installed("mockery")
  skip_if_not_installed("elevatr")
  
  test_that("it downloads elevation and calculates terrain measures", {
    # Create a mock elevation raster to be returned by the mocked function
    mock_elev_rast <- rast(crs = "EPSG:4326", extent = ext(c(117.2, 117.24, 5.46, 5.5)), resolution = 0.01)
    values(mock_elev_rast) <- 1000 + (1:ncell(mock_elev_rast)) / 10
    names(mock_elev_rast) <- "mock_elevation"
    
    # Mock the elevatr::get_elev_raster function to avoid actual download.
    # It will now return our predictable mock raster instead.
    m <- mockery::mock(mock_elev_rast)
    mockery::stub(where = createCovariates, what = "elevatr::get_elev_raster", how = m)
    
    # Run the function
    result <- expect_warning(
      createCovariates(camtraps_sf,
                       download_elevation = TRUE,
                       terrain_measures = c("slope", "TRI"),
                       resolution = 200),
      regexp = "NAs found in extracted covariates"
    )
    
    # Check that the mock function was called exactly once
    mockery::expect_called(m, 1)
    
    # Check for correct columns and layers
    expected_names <- c("elevation", "slope", "TRI")
    expect_true(all(expected_names %in% names(result$CTtable)))
    expect_true(all(expected_names %in% names(result$predictionRaster)))
  })
})


testthat::describe("Scaling and Output Structure", {
  
  test_that("scale_covariates = TRUE produces correct output structure and values", {
    # Use a list of rasters for this test
    raster_list <- list(elevation = r1, other_metric = r2)
    
    result <- createCovariates(camtraps_sf, 
                               rasters = raster_list, 
                               resolution = 200,
                               scale_covariates = TRUE)
    
    # 1. Check the output list structure
    expected_names <- c("CTtable", "CTtable_scaled", "predictionRaster", 
                        "predictionRaster_scaled", "originalRaster", "scaling_params")
    expect_named(result, expected_names)
    
    # 2. Check the scaled table
    ct_scaled <- result$CTtable_scaled
    expect_s3_class(ct_scaled, "sf")
    
    # Scaled numeric columns should have mean ~ 0 and sd ~ 1
    expect_equal(mean(ct_scaled$elevation), 0, tolerance = 1e-9)
    expect_equal(sd(ct_scaled$elevation), 1, tolerance = 1e-9)
    expect_equal(mean(ct_scaled$other_metric), 0, tolerance = 1e-9)
    expect_equal(sd(ct_scaled$other_metric), 1, tolerance = 1e-9)
    
    # 3. Check the scaled raster
    ras_scaled <- result$predictionRaster_scaled
    expect_s4_class(ras_scaled, "SpatRaster")
    
    # The global mean of the scaled raster layer should be close to 0
    global_mean <- global(ras_scaled, "mean", na.rm = TRUE)$mean
    names(global_mean) <- names(ras_scaled)
    expect_lt(abs(global_mean["elevation"]), 0.2)
    
    # 4. Check scaling parameters
    params <- result$scaling_params
    expect_named(params, c("center", "scale"))
    expect_named(params$center, c("elevation", "other_metric"))
    expect_true(is.numeric(params$scale["elevation"]))
  })
})