Add kba

DESCRIPTION

@@ -34,7 +34,7 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-GB
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate: 
     'register.R'
     'calc_biome.R'
@@ -55,6 +55,7 @@ Collate:
     'get_resources.R'
     'calc_indicators.R'
     'calc_ipbes_biomes.R'
+    'calc_key_biodiversity_areas.R'
     'calc_landcover.R'
     'calc_mangroves_area.R'
     'calc_population_count.R'
@@ -83,6 +84,7 @@ Collate:
     'get_gsw.R'
     'get_hfp.R'
     'get_ipbes_biomes.R'
+    'get_key_biodiversity_areas.R'
     'get_mcd64A1.R'
     'get_nasa_grace.R'
     'get_nasa_srtm.R'

NAMESPACE

@@ -19,6 +19,7 @@ export(calc_humanfootprint)
 export(calc_indicators)
 export(calc_ipbes_biomes)
 export(calc_irr_carbon)
+export(calc_key_biodiversity_area)
 export(calc_landcover)
 export(calc_man_carbon)
 export(calc_mangroves_area)
@@ -55,6 +56,7 @@ export(get_gmw)
 export(get_humanfootprint)
 export(get_ipbes_biomes)
 export(get_irr_carbon)
+export(get_key_biodiversity_areas)
 export(get_man_carbon)
 export(get_mcd64a1)
 export(get_nasa_grace)

NEWS.md

@@ -21,12 +21,14 @@
   - `get_chelsa()`
   - `get_ipbes_biomes()`
   - `get_humanfootprint()`
+  - `get_key_biodiversity_areas()`
   - `get_vul_carbon()`, `get_man_carbon()`, and `get_irr_carbon()`
 - new indicators:
-  - `calc_precipitation_chelsa()`
   - `calc_exposed_population()`
   - `calc_humanfootprint()`
   - `calc_ipbes_biomes()`
+  - `calc_key_biodiversity_area()`
+  - `calc_precipitation_chelsa()`
   - `calc_vul_carbon()`, `calc_man_carbon()`, and `calc_irr_carbon()`
 
 ## Bug fixes

R/calc_key_biodiversity_areas.R

@@ -0,0 +1,77 @@
+#' Calculate Key Biodiversity Areas
+#'
+#' This function calculates the total area of key biodiversity areas for a given
+#' input polygon.
+#'
+#' The required resources for this indicator are:
+#'  - [key_biodiversity_areas]
+#'
+#' @name key_biodiversity_areas
+#' @docType data
+#' @keywords indicator
+#' @format A function returning an indicator tibble with `key_biodiversity_area`
+#'   as variable and the total overlap area (in ha) as value.
+#' @include register.R
+#' @export
+#' @examples
+#' \dontshow{
+#' mapme.biodiversity:::.copy_resource_dir(file.path(tempdir(), "mapme-data"))
+#' }
+#' \dontrun{
+#' library(sf)
+#' library(mapme.biodiversity)
+#'
+#' outdir <- file.path(tempdir(), "mapme-data")
+#' dir.create(outdir, showWarnings = FALSE)
+#'
+#' mapme_options(
+#'   outdir = outdir,
+#'   verbose = FALSE
+#' )
+#'
+#' kbas <- system.file("resources", "key_biodiversity_areas", "kbas.gpkg",
+#'   package = "mapme.biodiversity")
+#'
+#' aoi <- system.file("extdata", "shell_beach_protected_area_41057_B.gpkg",
+#'   package = "mapme.biodiversity"
+#' ) %>%
+#'   read_sf() %>%
+#'   get_resources(get_key_biodiversity_area(kbas)) %>%
+#'   calc_indicators(calc_key_biodiversity_area()) %>%
+#'   portfolio_long()
+#'
+#' aoi
+#' }
+calc_key_biodiversity_area <- function() {
+  function(x = NULL,
+           key_biodiversity_areas,
+           name = "key_biodiversity_areas",
+           mode = "asset",
+           aggregation = "mean",
+           verbose = mapme_options()[["verbose"]]) {
+
+    key_biodiversity_areas <- key_biodiversity_areas[[1]]
+    if (is.null(key_biodiversity_areas) | nrow(key_biodiversity_areas) == 0) {
+      return(NULL)
+    }
+
+    int_area <- suppressWarnings(st_intersection(x, key_biodiversity_areas))
+    if (nrow(int_area) == 0) return(NULL)
+    int_area_ha <- as.numeric(sum(st_area(int_area), na.rm = TRUE) / 10000)
+
+    results <- tibble::tibble(
+      datetime = as.POSIXct("2024-01-01T00:00:00Z"),
+      variable = "key_biodiversity_area",
+      unit = "ha",
+      value = int_area_ha
+    )
+
+    return(results)
+  }
+}
+
+register_indicator(
+  name = "key_biodiversity_areas",
+  description = "Area estimation of intersection with key biodiversity areas.",
+  resources = "key_biodiversity_areas"
+)

R/get_key_biodiversity_areas.R

@@ -0,0 +1,52 @@
+#' Key Biodiversity Areas
+#'
+#' This resource contains outlines of key biodiversity areas, which are areas
+#' representing sites with specific importance for nature conservation.
+#'
+#' To use this data in mapme workflows, you will have to manually download the
+#' global data set and point towards its file path on your local machine.
+#' Please find the available data under the source link given below.
+#'
+#' @name key_biodiversity_areas
+#' @keywords resource
+#' @param path A character vector to the key biodiversity areas GPKG file.
+#'   Note, that the file has to be downloaded manually.
+#' @returns A function that returns an `sf` footprints object.
+#' @references BirdLife International (2024). The World Database of
+#'   Key Biodiversity Areas. Developed by the KBA Partnership: BirdLife
+#'   International, International Union for the Conservation of Nature,
+#'   Amphibian Survival Alliance, Conservation International, Critical Ecosystem
+#'   Partnership Fund, Global Environment Facility, Re:wild, NatureServe,
+#'   Rainforest Trust, Royal Society for the Protection of Birds, Wildlife
+#'   Conservation Society and World Wildlife Fund. Available at
+#'   www.keybiodiversityareas.org.
+#' @source \url{https://www.keybiodiversityareas.org/kba-data}
+#' @include register.R
+#' @export
+get_key_biodiversity_areas <- function(path = NULL) {
+
+  if(is.null(path) || !file.exists(path)) {
+    stop("Expecting path to point towards an existing file.")
+  }
+
+  function(
+    x,
+    name = "key_biodiversity_areas",
+    type = "vector",
+    outdir = mapme_options()[["outdir"]],
+    verbose = mapme_options()[["verbose"]]) {
+
+    bbox <- c(xmin = -180.0, ymin = -90.0, xmax = 180.0, ymax = 90.0)
+    tile <- st_as_sf(st_as_sfc(st_bbox(bbox, crs = "EPSG:4326")))
+    tile[["source"]] <- path
+    make_footprints(tile, what = "vector")
+  }
+}
+
+register_resource(
+  name = "key_biodiversity_areas",
+  description = "Key Biodiversity Areas",
+  licence = "https://www.keybiodiversityareas.org/termsofservice",
+  source = "https://www.keybiodiversityareas.org/kba-data",
+  type = "vector"
+)