Merge pull request #15 from EvolEcolGroup/dev

handle X and Y in recipe better

R/recipe_sf.R

@@ -28,11 +28,19 @@
 
 recipe.sf <- function (x, ...) {
   # we should check that all coordinates are points
-  if (any (c("X","Y") %in% names(x))){
-    x <- x %>% dplyr::rename(!!"X_orig" := !!"X", !!"Y_orig" := !!"Y")
-  } # or do we just throw an error and say that X and Y are restricted???
-
-  x<-x %>% dplyr::bind_cols(sf::st_coordinates(x)) %>% sf::st_drop_geometry()
+#  browser()
+  if (all(c("X", "Y") %in% names(x))) {
+   if (all(sf::st_drop_geometry(x[, c("X", "Y")]) == sf::st_coordinates(x))) {
+     x<-x %>% sf::st_drop_geometry()
+    } else {
+      stop("sf object `x` contains `X` and `Y` coordinates that do not match the sf point geometry")
+    }
+  } else {
+    x<-x %>% dplyr::bind_cols(sf::st_coordinates(x)) %>% sf::st_drop_geometry()
+  }
+
+
+
   rec <- recipe(x, ...)  %>% 
     update_role(dplyr::any_of(c("X","Y")),new_role="coords")
   class(rec) <- c("spatial_recipe", class(rec))

tests/testthat/test_recipe_sf.R

@@ -1,5 +1,5 @@
 library(sf)
-test_that("sdm_spec_gam", {
+test_that("sdm_recipe_sf", {
   lacerta_thin <- readRDS(system.file("extdata/lacerta_climate_sf.RDS",
                                     package="tidysdm"))
   lacerta_rec <- recipe(lacerta_thin, formula=class~.)
@@ -10,10 +10,15 @@ test_that("sdm_spec_gam", {
                               formula=class~.),
                "x should be an `sf` object")
   lacerta_xy <- lacerta_thin %>% dplyr::mutate(X=1,Y=2)
-  # recoding old X and Y variable
-  lacerta_rec_xy <- recipe(lacerta_xy, formula=class~.)
-  expect_true (all(c("X_orig","Y_orig") %in% lacerta_rec_xy$term_info$variable))
-  expect_false (all(c("X_orig","Y_orig") %in% lacerta_rec$term_info$variable))
+  # deal with X and Y coordinates
+  expect_error(recipe(lacerta_xy, formula=class~.),
+               "sf object")
+  lacerta_xy <- lacerta_thin %>% dplyr::bind_cols(sf::st_coordinates(lacerta_thin)) 
+  lacerta_xy_rec <- recipe(lacerta_xy, formula=class~.)
+  expect_true(identical(lacerta_xy_rec,lacerta_rec))
+  lacerta_xy$X[3]<-190
+  expect_error(recipe(lacerta_xy, formula=class~.),
+               "sf object")
   #check prep methods
   lacerta_rec_prep <- prep(lacerta_rec)
   expect_true (recipes::fully_trained(lacerta_rec_prep))