Improve handling of ... in ww_multi_scale (#58)

* Improve handling of ... in ww_multi_scale * Don't use ...names() for backwards compatibility
ropensci · Oct 17, 2023 · 1f09a5a · 1f09a5a
1 parent 3bfdaa2
commit 1f09a5a
Show file tree

Hide file tree

Showing 3 changed files with 91 additions and 18 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # waywiser (development version)
 
+* `ww_multi_scale()` now warns if you provide `crs` as an argument to `sf::st_make_grid()` via `...`. Grids created by this function will always take their CRS from `data`.
+
+* `ww_multi_scale()` now throws an error if you pass arguments via `...` while also providing a list of grids (because those arguments would be ignored).
+
 * `ww_multi_scale()` is now faster when `data` is an sf object, particularly when grids are created by passing arguments to `sf::st_make_grid()` (rather than passing grids via `grids`).
 
 # waywiser 0.5.0

diff --git a/R/multi_scale.R b/R/multi_scale.R
@@ -191,6 +191,24 @@ ww_multi_scale.SpatRaster <- function(
   raster_method_summary(grid_list, .notes, metrics, na_rm)
 }
 
+prep_multi_scale_raster <- function(data, truth, estimate) {
+  data <- tryCatch(
+    terra::subset(data, c(truth, estimate)),
+    error = function(e) {
+      rlang::abort("Couldn't select either `truth` or `estimate`. Are your indices correct?")
+    }
+  )
+
+  if (terra::nlyr(data) != 2) {
+    rlang::abort(c(
+      "`terra::subset(data, c(truth, estimate))` didn't return 2 layers as expected.",
+      i = "Make sure `truth` and `estimate` both select exactly one layer."
+    ))
+  }
+  names(data) <- c("truth", "estimate")
+  data
+}
+
 spatraster_extract <- function(grid, data, aggregation_function, progress) {
   grid <- sf::st_as_sf(grid)
   sf::st_geometry(grid) <- "geometry"
@@ -214,24 +232,6 @@ spatraster_extract <- function(grid, data, aggregation_function, progress) {
   cbind(grid, grid_df)[c(exactextract_names, "geometry")]
 }
 
-prep_multi_scale_raster <- function(data, truth, estimate) {
-  data <- tryCatch(
-    terra::subset(data, c(truth, estimate)),
-    error = function(e) {
-      rlang::abort("Couldn't select either `truth` or `estimate`. Are your indices correct?")
-    }
-  )
-
-  if (terra::nlyr(data) != 2) {
-    rlang::abort(c(
-      "`terra::subset(data, c(truth, estimate))` didn't return 2 layers as expected.",
-      i = "Make sure `truth` and `estimate` both select exactly one layer."
-    ))
-  }
-  names(data) <- c("truth", "estimate")
-  data
-}
-
 ww_multi_scale_raster_args <- function(
     data = NULL,
     truth,
@@ -447,6 +447,16 @@ handle_metrics <- function(metrics) {
 handle_grids <- function(data, grids, autoexpand_grid, data_crs, ...) {
   if (is.null(grids)) {
     grid_args <- rlang::list2(...)
+    if ("crs" %in% names(grid_args)) {
+      rlang::warn(
+        c(
+          "The `crs` argument (passed via `...`) will be ignored.",
+          i = "Grids will be created using the same crs as `data`."
+        ),
+        call = rlang::caller_env()
+      )
+      grid_args["crs"] <- NULL
+    }
     grid_arg_idx <- max(vapply(grid_args, length, integer(1)))
     grid_args <- stats::setNames(
       lapply(
@@ -485,6 +495,7 @@ handle_grids <- function(data, grids, autoexpand_grid, data_crs, ...) {
       }
     )
   } else {
+    rlang::check_dots_empty(call = rlang::caller_env())
     grid_args <- tibble::tibble()
     grid_arg_idx <- 0
     if (!is.na(data_crs)) {

diff --git a/tests/testthat/test-multi_scale.R b/tests/testthat/test-multi_scale.R
@@ -719,3 +719,61 @@ test_that("Data with an NA CRS works", {
     )
   )
 })
+
+test_that("Passing crs via `...` warns", {
+  pts <- sf::st_sample(
+    sf::st_as_sfc(
+      sf::st_bbox(
+        c(xmin = 1327326, ymin = 2175524, xmax = 1971106, ymax = 2651347)
+      )
+    ),
+    500
+  )
+
+  pts <- sf::st_as_sf(pts)
+  pts$truth <- rnorm(500, 123, 35)
+  pts$estimate <- rnorm(500, 123, 39)
+
+  expect_warning(
+    waywiser::ww_multi_scale(
+      pts,
+      truth,
+      estimate,
+      cellsize = 20000,
+      square = FALSE,
+      metrics = yardstick::rmse,
+      crs = sf::st_crs(4326)
+    ),
+    "`crs` argument"
+  )
+})
+
+test_that("Passing arguments via `...` errors when using grids", {
+  pts <- sf::st_sample(
+    sf::st_as_sfc(
+      sf::st_bbox(
+        c(xmin = 1327326, ymin = 2175524, xmax = 1971106, ymax = 2651347)
+      )
+    ),
+    500
+  )
+
+  pts <- sf::st_as_sf(pts)
+  pts$truth <- rnorm(500, 123, 35)
+  pts$estimate <- rnorm(500, 123, 39)
+
+  grid <- sf::st_make_grid(pts, n = 4)
+
+  expect_error(
+    waywiser::ww_multi_scale(
+      pts,
+      truth,
+      estimate,
+      grids = list(grid),
+      square = FALSE,
+      metrics = yardstick::rmse,
+      crs = sf::st_crs(4326)
+    ),
+    class = "rlib_error_dots_nonempty"
+  )
+})