tests/testthat/test-saveContours.R

In rLakeHabitat: Interpolate Bathymetry and Quantify Physical Aquatic Habitat

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

dem <- interpBathy(outline, dat, "x", "y", "z", zeros = FALSE, separation = 10, res = 10, method = "IDW", nmax = 4)

# input validation

test_that("saveContours errors on non-SpatRaster dem", {
  expect_error(
    saveContours(as.matrix(1), by = 2),
    "dem must be a SpatRaster"
  )
})

test_that("saveContours errors on invalid file_type", {
  expect_error(
    saveContours(dem, by = 2, file_type = "geojson"),
    "file_type must be one of 'gpx', 'kml', 'shp', or 'gpkg'"
  )
})

test_that("saveContours errors on invalid file_name", {
  expect_error(
    saveContours(dem, by = 2, file_name = 123),
    "file_name must be a single character string"
  )
})

test_that("saveContours errors when neither by nor levels is specified", {
  expect_error(
    saveContours(dem),
    "either 'by' or 'levels' must be specified"
  )
})

test_that("saveContours errors when both by and levels are specified", {
  expect_error(
    saveContours(dem, by = 2, levels = c(1, 2, 3)),
    "only one of 'by' or 'levels' should be specified"
  )
})

test_that("saveContours errors on invalid by", {
  expect_error(
    saveContours(dem, by = -1),
    "by must be a single positive numeric value"
  )
  expect_error(
    saveContours(dem, by = "two"),
    "by must be a single positive numeric value"
  )
})

test_that("saveContours errors on invalid levels", {
  expect_error(
    saveContours(dem, levels = "a"),
    "levels must be a numeric vector"
  )
  expect_error(
    saveContours(dem, levels = numeric(0)),
    "levels must be a numeric vector"
  )
})

test_that("saveContours errors when by exceeds dem's depth range", {
  expect_error(
    saveContours(dem, by = 10000, file_name = tempfile("contours")),
    "no contour levels fall within dem's depth range"
  )
})

# output structure

test_that("saveContours returns an sf object with a depth column, using 'by'", {
  out_path <- tempfile("contours")
  result <- saveContours(dem, by = 2, file_type = "gpx", file_name = out_path)

  expect_s3_class(result, "sf")
  expect_true("depth" %in% names(result) || "name" %in% names(result))
  expect_true(file.exists(paste0(out_path, ".gpx")))

  unlink(paste0(out_path, ".gpx"))
})

test_that("saveContours returns an sf object using explicit 'levels'", {
  out_path <- tempfile("contours")
  result <- saveContours(dem, levels = c(1, 2, 3), file_type = "gpx", file_name = out_path)

  expect_s3_class(result, "sf")
  expect_true(nrow(result) > 0)
  expect_true(file.exists(paste0(out_path, ".gpx")))

  unlink(paste0(out_path, ".gpx"))
})

# format-specific behavior

test_that("saveContours writes a valid KML file with a Name field", {
  out_path <- tempfile("contours")
  result <- saveContours(dem, by = 2, file_type = "kml", file_name = out_path)

  expect_true(file.exists(paste0(out_path, ".kml")))

  kml_check <- sf::st_read(paste0(out_path, ".kml"), quiet = TRUE)
  expect_true(nrow(kml_check) > 0)

  unlink(paste0(out_path, ".kml"))
})

test_that("saveContours writes a valid GeoPackage file", {
  out_path <- tempfile("contours")
  result <- saveContours(dem, by = 2, file_type = "gpkg", file_name = out_path)

  expect_true(file.exists(paste0(out_path, ".gpkg")))

  gpkg_check <- sf::st_read(paste0(out_path, ".gpkg"), quiet = TRUE)
  expect_true("depth" %in% names(gpkg_check))

  unlink(paste0(out_path, ".gpkg"))
})

test_that("saveContours reprojects to WGS84 for gpx/kml but keeps original CRS for gpkg", {
  out_path_gpx <- tempfile("contours")
  saveContours(dem, by = 2, file_type = "gpx", file_name = out_path_gpx)
  gpx_check <- sf::st_read(paste0(out_path_gpx, ".gpx"), layer = "routes", quiet = TRUE)
  expect_equal(sf::st_crs(gpx_check)$epsg, 4326)
  unlink(paste0(out_path_gpx, ".gpx"))

  out_path_gpkg <- tempfile("contours")
  saveContours(dem, by = 2, file_type = "gpkg", file_name = out_path_gpkg)
  gpkg_check <- sf::st_read(paste0(out_path_gpkg, ".gpkg"), quiet = TRUE)
  expect_true(sf::st_crs(gpkg_check) == sf::st_crs(terra::crs(dem)))
  unlink(paste0(out_path_gpkg, ".gpkg"))
})

# multi-layer dem handling

test_that("saveContours uses the 'depth' layer when dem has multiple layers", {
  expect_warning(
  dem_ok <- interpBathy(outline, dat, "x", "y", "z", zeros = FALSE, separation = 20,
                        res = 10, method = "OK", nmax = 4, model = "Gau", psill = 11.84, range = 986.2, zero_threshold = .5),
  "No convergence after 200 iterations: try different initial values?")
  expect_equal(terra::nlyr(dem_ok), 2)

  out_path <- tempfile("contours")
  result <- saveContours(dem_ok, by = 2, file_type = "gpx", file_name = out_path)

  expect_s3_class(result, "sf")
  unlink(paste0(out_path, ".gpx"))
})

test_that("saveContours warns and falls back to the first layer for an unnamed multi-layer dem", {
  dem_unnamed <- c(dem, dem)
  names(dem_unnamed) <- c("layer1", "layer2")

  out_path <- tempfile("contours")
  expect_warning(
    saveContours(dem_unnamed, by = 2, file_type = "gpx", file_name = out_path),
    "using the first layer"
  )
  unlink(paste0(out_path, ".gpx"))
})