From 87b99ba8de68c05be1f5b525b5501e51515793ae Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Darius=20G=C3=B6rgen?= <info@dariusgoergen.com>
Date: Fri, 10 Nov 2023 12:10:42 +0100
Subject: [PATCH] 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                              |  8 ++++++++
 R/calc_biome.R                       | 15 +++++++++++----
 R/calc_ecoregion.R                   | 15 +++++++++++----
 R/calc_indicators.R                  |  6 ++++++
 tests/testthat/test-calc_biome.R     |  6 ++++++
 tests/testthat/test-calc_ecoregion.R |  7 +++++++
 6 files changed, 49 insertions(+), 8 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 090112ae..6580bb2a 100644
--- a/NEWS.md
+++ b/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
diff --git a/R/calc_biome.R b/R/calc_biome.R
index 6ba6b337..4450383e 100644
--- a/R/calc_biome.R
+++ b/R/calc_biome.R
@@ -63,6 +63,7 @@ NULL
   biomes <- NULL
   new_area <- NULL
   area <- NULL
+
   if (nrow(teow[[1]]) == 0) {
     return(NA)
   }
@@ -70,17 +71,23 @@ NULL
   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
 }
 
diff --git a/R/calc_ecoregion.R b/R/calc_ecoregion.R
index 445298f0..141b0b68 100644
--- a/R/calc_ecoregion.R
+++ b/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)))
diff --git a/R/calc_indicators.R b/R/calc_indicators.R
index 1f72eef0..d0d816cf 100644
--- a/R/calc_indicators.R
+++ b/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)) {
diff --git a/tests/testthat/test-calc_biome.R b/tests/testthat/test-calc_biome.R
index 6f305f28..3e1ff82e 100644
--- a/tests/testthat/test-calc_biome.R
+++ b/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)
 })
diff --git a/tests/testthat/test-calc_ecoregion.R b/tests/testthat/test-calc_ecoregion.R
index cd4e1f57..f01388d6 100644
--- a/tests/testthat/test-calc_ecoregion.R
+++ b/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)
 })