Added a test for thin_by_cell

Checking to make sure it handles sf objects with X,Y columns correctly. Also fixed thin_by_cell so it correctly handles NAs in the X, Y columns
EvolEcolGroup · Oct 6, 2023 · 9be1b10 · 9be1b10
1 parent 6a3d7d3
commit 9be1b10
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 5 deletions.
diff --git a/R/thin_by_cell.R b/R/thin_by_cell.R
@@ -36,9 +36,13 @@ thin_by_cell <- function(data, raster, coords=NULL, drop_na = TRUE, agg_fact=NUL
   return_sf <- FALSE # flag whether we need to return an sf object
   if (inherits(data,"sf")){
     if (all(c("X", "Y") %in% names(data))) {
-      if (!all(data[, c("X", "Y")] %>% sf::st_drop_geometry() %>% as.matrix() == sf::st_coordinates(data))) {
-        data <- data %>% dplyr::select(-X, -Y) %>% dplyr::bind_cols(sf::st_coordinates(data))
-        warning("sf contained 'X' and 'Y' coordinates that did not match point geometry and have been replaced")
+      if (!all(data[, c("X", "Y")] %>% sf::st_drop_geometry() %>% as.matrix() == sf::st_coordinates(data)) |
+          any(is.na(data[, c("X", "Y")]))) {
+        data <- data %>% dplyr::rename(X_original = X, Y_original = Y) %>% 
+          dplyr::bind_cols(sf::st_coordinates(data))
+        warning("sf object contained 'X' and 'Y' coordinates that did not match the sf point geometry.
+                These have been moved to columns 'X_original' and 'Y_original' and new X and Y columns
+                have been added that match the sf point geometry.")
       }
     } else {
       data <- data %>% dplyr::bind_cols(sf::st_coordinates(data))

diff --git a/tests/testthat/test_thin_by_cell_time.R b/tests/testthat/test_thin_by_cell_time.R
@@ -5,15 +5,15 @@ grid_raster <- terra::rast(matrix(1:16, ncol=4,byrow=TRUE),
                    extent=terra::ext(c(-2,2,-2,2)),
                    crs="epsg:4326")
 
-terra::add(grid_raster)<- grid_raster
+terra::add(grid_raster) <- grid_raster
 
 # locations (first is off to the side, then two pairs to each other
 locations <- data.frame(lon=c(-1.5, -0.3, -0.6, 1.9, 1.4),
                         lat=c(-1.8, 0.2, 0.8, -1.8, -1.5),
                         time_bp=c(0,0,0,-10,-10),
                         id = 1:5)
 
-test_that("thin_by_dist_time removes the correct points", {
+test_that("thin_by_cell_time removes the correct points", {
   # with a data.frame that does not really involve time
   expect_error(thin_by_cell_time(locations,
                                   raster = grid_raster,
@@ -52,6 +52,17 @@ test_that("thin_by_dist_time removes the correct points", {
   expect_true(inherits(thin_100k_t_sf,"data.frame")) # it is also a df!
   expect_true(all(thin_100k_t$id ==thin_100k_t_sf$id))
 
+  # check that the function can handle a sf object with X, Y columns
+  locations_xy <- locations_sf %>% dplyr::bind_cols(sf::st_coordinates(.))
+  expect_no_error(thin_by_cell_time(locations_xy,
+                                    raster = grid_raster,
+                                    time_col="time_bp",
+                                    lubridate_fun = ybp2date))
+  locations_xy$X <- rep(NA)
+  expect_warning(thin_by_cell(locations_xy,
+                                   raster = grid_raster),
+                 "sf object contained 'X' and 'Y' coordinates that did not match the sf point geometry")
+
   # now use a SpatRasterDataset
   raster_list <- list(bio01 = grid_raster, bio10 = grid_raster)
   grid_sds <- terra::sds(raster_list)