Fix return of 0-length tibbles for TEOW (#199)

* added 0-row check in .bind_assets

* return NA for non-intersection result with TEOW

* update NEWS

NEWS.md

@@ -4,13 +4,21 @@
 
 - Quickstart vignette now uses the ESA Landcover resource
   as an example for how to use the package (#201).
+
+## Bug Fixes
 
+- `biome` and `ecoregions` now properly handle 0-length tibbles (#196)
 
 ## New features
 
 - GFW resources and indicators now include latest GFC-2022-v1.10 version (#204).
 
 
+## Internal
+
+- `calc_indicators()` now includes a check for 0-length tibbles (#199)
+
+
 # mapme.biodiversity 0.4.0
 
 ## New features

R/calc_biome.R

@@ -63,24 +63,31 @@ NULL
   biomes <- NULL
   new_area <- NULL
   area <- NULL
+
   if (nrow(teow[[1]]) == 0) {
     return(NA)
   }
 
   merged <- .comp_teow(
     x = x,
     teow = teow,
-    verbose = verbose
-  )
+    verbose = verbose)
+
+  if (nrow(merged) == 0) {
+    return(NA)
+  }
+
   out <- merged %>%
     dplyr::select(BIOME_NAME, new_area)
+
   out_tibble <- tibble(
     biomes = out[[1]],
-    area = out[[2]]
-  )
+    area = out[[2]])
+
   results_biome <- out_tibble %>%
     dplyr::group_by(biomes) %>%
     dplyr::summarise(area = sum(as.numeric(area)))
+
   results_biome
 }
 

R/calc_ecoregion.R

@@ -65,20 +65,27 @@ NULL
   new_area <- NULL
   ecoregions <- NULL
   area <- NULL
+
   if (nrow(teow[[1]]) == 0) {
     return(NA)
   }
+
   merged <- .comp_teow(
     x = x,
     teow = teow,
-    verbose = verbose
-  )
+    verbose = verbose)
+
+  if (nrow(merged) == 0) {
+    return(NA)
+  }
+
   out <- merged %>%
     dplyr::select(ECO_NAME, new_area)
+
   out_tibble <- tibble(
     ecoregions = out[[1]],
-    area = out[[2]]
-  )
+    area = out[[2]])
+
   out_tibble %>%
     dplyr::group_by(ecoregions) %>%
     dplyr::summarise(area = sum(as.numeric(area)))

R/calc_indicators.R

@@ -207,6 +207,12 @@ calc_indicators <- function(x, indicators, ...) {
 .bind_assets <- function(results) {
   # bind results to data.frame
   index_tbl <- purrr::map_lgl(results, function(x) inherits(x, c("tbl_df", "data.frame")))
+  # check for 0 length tibbles
+  n_rows <- sapply(results[index_tbl], nrow)
+  if (any(n_rows == 0)) {
+    stop(paste("0-length tibbles returned for some assets.\n",
+    "Make sure the indicator function returns NA if it cannot be calculated for an asset."))
+  }
 
   # case all assets returned tibbles
   if (all(index_tbl)) {

tests/testthat/test-calc_biome.R

@@ -27,4 +27,10 @@ test_that("biome computation works", {
     18352.24,
     tolerance = 1e-4
   )
+  # check NA is returned for 0-length tibbles
+  st_geometry(shp) <- st_geometry(shp) + 5
+  st_crs(shp) <- st_crs(4326)
+  expect_equal(
+    .calc_biome(shp, teow),
+    NA)
 })

tests/testthat/test-calc_ecoregion.R

@@ -23,4 +23,11 @@ test_that("ecoregion computation works", {
     18352.24,
     tolerance = 1e-4
   )
+
+  # check NA is returned for 0-length tibbles
+  st_geometry(shp) <- st_geometry(shp) + 5
+  st_crs(shp) <- st_crs(4326)
+  expect_equal(
+    .calc_biome(shp, teow),
+    NA)
 })