tests/testthat/test-samplingDensity.R

In rLakeHabitat: Interpolate Bathymetry and Quantify Physical Aquatic Habitat

outline <- terra::vect(system.file("extdata", "example_outline.shp", package = "rLakeHabitat"))

# input validation

test_that("samplingDensity errors on missing/invalid max_depth", {
  expect_error(samplingDensity(outline), "max_depth")
  expect_error(samplingDensity(outline, max_depth = -10), "max_depth must be specified as a positive numeric value")
  expect_error(samplingDensity(outline, max_depth = "forty"), "max_depth must be specified as a positive numeric value")
})

test_that("samplingDensity errors on invalid method", {
  expect_error(
    samplingDensity(outline, max_depth = 40, method = "krige", n_sim = 1, seed = 1),
    "method misspecified"
  )
})

test_that("samplingDensity errors on invalid tolerance", {
  expect_error(
    samplingDensity(outline, max_depth = 40, tolerance = -0.1, n_sim = 1, seed = 1),
    "tolerance must be a non-negative numeric value"
  )
})

test_that("samplingDensity errors on invalid spacings", {
  expect_error(
    samplingDensity(outline, max_depth = 40, spacings = c(-10, 20), n_sim = 1, seed = 1),
    "spacings must be positive numeric values"
  )
})

test_that("samplingDensity errors when outline CRS cannot be defined", {
  no_crs_outline <- terra::vect(rbind(c(0, 0), c(0, 1), c(1, 1), c(1, 0), c(0, 0)), type = "polygons")
  expect_error(
    samplingDensity(no_crs_outline, max_depth = 40, n_sim = 1, seed = 1),
    "CRS of 'outline' is unable to be defined"
  )
})

test_that("samplingDensity errors on invalid seed", {
  expect_error(
    samplingDensity(outline, max_depth = 40, n_sim = 1, seed = "abc"),
    "seed must be numeric"
  )
})

# output structure

test_that("samplingDensity returns expected structure on a small run", {
  result <- samplingDensity(outline, max_depth = 40, spacings = c(50, 100),
                            n_sim = 2, res = 25, n_truth_examples = 1,
                            plot = FALSE, seed = 123)

  expect_type(result, "list")
  expect_named(result, c("results", "recommended_spacing", "transects",
                         "total_transect_length", "truth_examples"))

  expect_s3_class(result$results, "data.frame")
  expect_named(result$results, c("spacing", "mean_rmse", "sd_rmse"))
  expect_equal(nrow(result$results), 2)
  expect_true(all(result$results$mean_rmse >= 0, na.rm = TRUE))

  expect_true(result$recommended_spacing %in% c(50, 100))

  expect_s4_class(result$transects, "SpatVector")
  expect_true(terra::geomtype(result$transects) == "lines")

  expect_true(is.numeric(result$total_transect_length))
  expect_true(result$total_transect_length >= 0)

  expect_s4_class(result$truth_examples, "SpatRaster")
  expect_equal(terra::nlyr(result$truth_examples), 1)
})

test_that("samplingDensity respects n_truth_examples capped at n_sim", {
  result <- samplingDensity(outline, max_depth = 40, spacings = c(50, 100),
                            n_sim = 2, res = 25, n_truth_examples = 10,
                            plot = FALSE, seed = 123)
  expect_equal(terra::nlyr(result$truth_examples), 2)
})

test_that("samplingDensity is reproducible with a fixed seed", {
  r1 <- samplingDensity(outline, max_depth = 40, spacings = c(50, 100),
                        n_sim = 2, res = 25, n_truth_examples = 1,
                        plot = FALSE, seed = 42)
  r2 <- samplingDensity(outline, max_depth = 40, spacings = c(50, 100),
                        n_sim = 2, res = 25, n_truth_examples = 1,
                        plot = FALSE, seed = 42)
  expect_equal(r1$results$mean_rmse, r2$results$mean_rmse)
  expect_equal(r1$recommended_spacing, r2$recommended_spacing)
})