Handle classification metrics with raster inputs (fixes #60) (#61)

* Handle classification metrics with raster inputs

* Update snaps

* Condition tests on terra

* Add codecov token

.github/workflows/test-coverage.yaml

@@ -13,6 +13,7 @@ jobs:
  runs-on: ubuntu-latest
  env:
  GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
 
  steps:
  - uses: actions/checkout@v2

DESCRIPTION

@@ -87,4 +87,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NEWS.md

@@ -1,5 +1,10 @@
 # waywiser (development version)
 
+* `ww_multi_scale()`, when called with raster arguments (either to `data` or to `truth`
+ and `estimate`) and a classification metric set, will now convert `truth` and 
+ `estimate`to factors before passing them to the metric set. Thanks to @nowosad
+ for the report in #60 (#61).
+
 # waywiser 0.5.1
 
 * `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`.

R/multi_scale.R

@@ -50,7 +50,7 @@
 #' arguments; or `NULL` if `truth` and `estimate` are `SpatRaster` objects.
 #' @param truth,estimate If `data` is an `sf` object, the names (optionally
 #' unquoted) for the columns in `data` containing the true and predicted values,
-#' respectively. If `data` is a `SpatRaster` object, either layer names or
+#' respectively. If `data` is a `SpatRaster` object, either (quoted) layer names or
 #' indices which will select the true and predicted layers, respectively, via
 #' [terra::subset()] If `data` is `NULL`, `SpatRaster` objects with a single
 #' layer containing the true and predicted values, respectively.
@@ -326,9 +326,34 @@ raster_method_notes <- function(grid_list) {
 }
 
 raster_method_summary <- function(grid_list, .notes, metrics, na_rm) {
+ if (inherits(metrics, "class_prob_metric_set")) {
+ lvls <- unique(
+ unlist(
+ lapply(
+ grid_list$grids,
+ function(grid) {
+ c(
+ levels(factor(grid$.truth)),
+ levels(factor(grid$.estimate))
+ )
+ }
+ )
+ )
+ )
+
+ grid_list$grids <- lapply(
+ grid_list$grids,
+ function(grid) {
+ grid$.truth <- factor(grid$.truth, levels = lvls)
+ grid$.estimate <- factor(grid$.estimate, levels = lvls)
+ grid
+ }
+ )
+ }
+
  out <- mapply(
  function(grid, grid_arg, .notes) {
- out <- metrics(grid, .truth, .estimate, na_rm = na_rm)
+ out <- metrics(grid, truth = .truth, estimate = .estimate, na_rm = na_rm)
  out[attr(out, "sf_column")] <- NULL
  out$.grid_args <- list(grid_list$grid_args[grid_arg, ])
  out$.grid <- list(grid)
@@ -404,7 +429,7 @@ ww_multi_scale.sf <- function(
  aggregation_function
  )
 
- out <- metrics(matched_data, .truth, .estimate, na_rm = na_rm)
+ out <- metrics(matched_data, truth = .truth, estimate = .estimate, na_rm = na_rm)
  out["grid_cell_idx"] <- NULL
  out[attr(out, "sf_column")] <- NULL
  out$.grid_args <- list(grid_args)

tests/testthat/_snaps/misc.md

@@ -8,6 +8,7 @@
   Number of nonzero links: 85 
   Percentage nonzero weights: 1.176471 
   Average number of links: 1 
+  25 disjoint connected subgraphs
   Non-symmetric neighbours list
 
 ---
@@ -65,6 +66,7 @@
   Number of nonzero links: 85 
   Percentage nonzero weights: 1.176471 
   Average number of links: 1 
+  25 disjoint connected subgraphs
   Non-symmetric neighbours list
 
 ---
@@ -113,6 +115,7 @@
   Number of nonzero links: 85 
   Percentage nonzero weights: 1.176471 
   Average number of links: 1 
+  25 disjoint connected subgraphs
   Non-symmetric neighbours list
   
   Weights style: W 

tests/testthat/test-multi_scale.R

@@ -777,3 +777,41 @@ test_that("Passing arguments via `...` errors when using grids", {
  class = "rlib_error_dots_nonempty"
  )
 })
+
+test_that("ww_multi_scale with raster args can handle classification metrics (#60)", {
+ skip_if_not_installed("terra")
+ l1 <- terra::rast(matrix(sample(1:10, 100, TRUE), nrow = 10))
+ l2 <- l1
+
+ expect_equal(
+ ww_multi_scale(
+ truth = l1, 
+ estimate = l2,
+ metrics = list(yardstick::precision),
+ grid = list(sf::st_make_grid(l1))
+ )$.estimate,
+ 1
+ )
+
+})
+
+test_that("ww_multi_scale with raster data can handle classification metrics (#60)", {
+ skip_if_not_installed("terra")
+ l1 <- terra::rast(matrix(sample(1:10, 100, TRUE), nrow = 10))
+ l2 <- l1
+
+ r <- c(l1, l2)
+ names(r) <- c("l1", "l2")
+
+ expect_equal(
+ ww_multi_scale(
+ r,
+ truth = "l1", 
+ estimate = "l2",
+ metrics = list(yardstick::precision),
+ grid = list(sf::st_make_grid(l1))
+ )$.estimate,
+ 1
+ )
+
+})