diff --git a/tests/testthat/test-corridor.R b/tests/testthat/test-corridor.R index 1b5e00d..c6b308d 100644 --- a/tests/testthat/test-corridor.R +++ b/tests/testthat/test-corridor.R @@ -1,11 +1,26 @@ -test_that("river_buffer parameters can be configured via initial_corridor", { +test_that("proper parameters must be provided depending on selected method", { river <- bucharest_osm$river_centerline - actual <- initial_corridor(river, buffer = 1) - expected <- river_buffer(river, buffer = 1) - expect_setequal(actual, expected) + + # for "buffer" method, we need the "buffer" parameter + expect_error(initial_corridor(river, method = "buffer"), + "Buffer should be provided if `method` is `'buffer'`") + with_mocked_bindings(river_buffer = function(...) NULL, { + expect_no_error(initial_corridor(river, method = "buffer", buffer = 42)) + }) + + # for "valley" method, we need the "dem" parameter + expect_error(initial_corridor(river, method = "valley"), + "DEM should be provided if `method` is `'valley'`") + with_mocked_bindings(river_valley = function(...) NULL, { + expect_no_error(initial_corridor(river, method = "valley", dem = 42)) + }) + + # inexistent method raise an error + expect_error(initial_corridor(river, method = "crisp"), + "Unknown method to initialize river corridor: crisp") }) -test_that("River buffer properly implements a buffer function", { +test_that("River buffer implements a buffer function", { river <- bucharest_osm$river_centerline actual <- river_buffer(river, buffer = 0.5) expected <- sf::st_buffer(river, 0.5) diff --git a/tests/testthat/test-network.R b/tests/testthat/test-network.R index 0160138..c8c6c64 100644 --- a/tests/testthat/test-network.R +++ b/tests/testthat/test-network.R @@ -277,6 +277,18 @@ test_that("Filter network properly splits network across adjacent regions", { expect_length(nodes_area_2, 2) }) +test_that("Filter network drops smallest disconnected components", { + # p4 is within the area, but it is left out since it remains disconnected + # from the main network component + area <- sf::st_as_sfc(sf::st_bbox(c(xmin = -1, xmax = 4, + ymin = 0, ymax = 2))) + network_filtered <- filter_network(network, area) + edges_area <- sf::st_geometry(sf::st_as_sf(network_filtered, "edges")) + nodes_area <- sf::st_geometry(sf::st_as_sf(network_filtered, "nodes")) + expect_length(edges_area, 2) + expect_length(nodes_area, 3) +}) + test_that("Network setup with real data", { edges <- bucharest_osm$streets network <- as_network(edges, clean = FALSE, flatten = FALSE) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index ef75c12..8ac1229 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -89,3 +89,84 @@ test_that("a bbox object does not change class", { expect_true(all(as.vector(bbox) == c(0, 1, 2, 3))) expect_equal(sf::st_crs(bbox), sf::st_crs(crs)) }) + +test_that("buffering a bbox properly enlarge the area of interest", { + # bbox in UTM zone 2N + x <- c(xmin = 263554, xmax = 736446, ymin = 4987330, ymax = 5654109) + bbox_utm2n <- sf::st_bbox(x, crs = "EPSG:32602") + + bbox_buffer_actual <- buffer_bbox(bbox_utm2n, 1000) + + y <- c(x[c("xmin", "ymin")] - 1000, x[c("xmax", "ymax")] + 1000) + bbox_buffer_expected <- sf::st_bbox(y, crs = "EPSG:32602") + + expect_equal(bbox_buffer_actual, bbox_buffer_expected) +}) + +test_that("buffering a bbox does not change its CRS", { + # bbox in WGS 84 + x <- c(xmin = -174, xmax = -168, ymin = 45, ymax = 51) + bbox_wgs84 <- sf::st_bbox(x, crs = "EPSG:4326") + + bbox_buffer <- buffer_bbox(bbox_wgs84, 1000) + + crs_expected <- sf::st_crs(bbox_wgs84) + crs_actual <- sf::st_crs(bbox_buffer) + expect_equal(crs_actual, crs_expected) +}) + +test_that("reproject works with raster data", { + # raster in UTM zone 2 (lon between -174 and -168 deg), northern emisphere + x <- terra::rast(xmin = -174, xmax = -168, ymin = 45, ymax = 51, res = 1, + vals = 1, crs = "EPSG:4326") + + # reproject with integer (EPSG code) + x_repr_int <- reproject(x, 32602) + + # reproject with string + x_repr_str <- reproject(x, "EPSG:32602") + + crs_expected <- terra::crs("EPSG:32602") + crs_actual_int <- terra::crs(x_repr_int) + expect_equal(crs_actual_int, crs_expected) + crs_actual_str <- terra::crs(x_repr_str) + expect_equal(crs_actual_str, crs_expected) +}) + +test_that("reproject works with vector data", { + # polygon in UTM zone 2 (lon between -174 and -168 deg), northern emisphere + x <- sf::st_linestring(cbind(c(-174, -174, -168, -168, -174), + c(45, 51, 51, 45, 45))) + x <- sf::st_polygon(list(x)) + x <- sf::st_sfc(x, crs = "EPSG:4326") + + # reproject with integer (EPSG code) + x_repr_int <- reproject(x, 32602) + + # reproject with string + x_repr_str <- reproject(x, "EPSG:32602") + + crs_expected <- sf::st_crs("EPSG:32602") + crs_actual_int <- sf::st_crs(x_repr_int) + expect_equal(crs_actual_int, crs_expected) + crs_actual_str <- sf::st_crs(x_repr_str) + expect_equal(crs_actual_str, crs_expected) +}) + +test_that("reproject works with bbox", { + # bbox in UTM zone 2 (lon between -174 and -168 deg), northern emisphere + x <- c(xmin = -174, xmax = -168, ymin = 45, ymax = 51) + x <- sf::st_bbox(x, crs = "EPSG:4326") + + # reproject with integer (EPSG code) + x_repr_int <- reproject(x, 32602) + + # reproject with string + x_repr_str <- reproject(x, "EPSG:32602") + + crs_expected <- sf::st_crs("EPSG:32602") + crs_actual_int <- sf::st_crs(x_repr_int) + expect_equal(crs_actual_int, crs_expected) + crs_actual_str <- sf::st_crs(x_repr_str) + expect_equal(crs_actual_str, crs_expected) +}) diff --git a/tests/testthat/test-valley.R b/tests/testthat/test-valley.R index 054edff..ecf4a83 100644 --- a/tests/testthat/test-valley.R +++ b/tests/testthat/test-valley.R @@ -19,7 +19,31 @@ test_that("STAC asset urls are correctly retrieved", { expect_equal(expected_asset_urls, asset_urls_retrieved) }) -test_that("raster data are correctly retrieved and merged", { +test_that("load_raster correctly retrieve and merge local data", { + + write_local_raster <- function(fname, xmin, xmax, ymin, ymax) { + rast <- terra::rast(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, + res = 1, vals = 1, crs = "EPSG:4326") + terra::writeRaster(rast, fname) + } + + bbox <- sf::st_bbox(c(xmin = 1, xmax = 4, ymin = 1, ymax = 7), + crs = "EPSG:4326") + # create local rasters with adjacent bboxes + withr::with_file(list("r1.tif" = write_local_raster("r1.tif", 1, 4, 1, 4), + "r2.tif" = write_local_raster("r2.tif", 1, 4, 4, 7)), { + rast <- load_raster(bbox, c("r1.tif", "r2.tif")) + # all values should be 1 + expect_true(all(terra::values(rast) == 1)) + # 2 rasters with 3x3 pixels -> 18 pixels in total + expect_length(terra::values(rast), 18) + # expect_equal on the two terra::ext objects somehow fails + expect_true(terra::ext(rast) == terra::ext(bbox)) + } + ) +}) + +test_that("load_raster correctly retrieve and merge remote data", { skip_on_ci() dem <- load_raster(bb, asset_urls)