Merge pull request #235 from mapme-initiative/gsw-indicators

Add gsw indicators

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mapme.biodiversity
 Title: Efficient Monitoring of Global Biodiversity Portfolios
-Version: 0.5.0.9000
+Version: 0.5.0.9001
 Authors@R: c(
     person("Darius A.", "Görgen", , "[email protected]", role = c("aut", "cre")),
     person("Om Prakash", "Bhandari", role = "aut")
@@ -46,6 +46,11 @@ Collate:
     'calc_ecoregion.R'
     'calc_elevation.R'
     'calc_fatalities.R'
+    'calc_gsw_change.R'
+    'calc_gsw_occurrence.R'
+    'calc_gsw_recurrence.R'
+    'calc_gsw_seasonality.R'
+    'calc_gsw_transitions.R'
     'calc_indicators.R'
     'calc_landcover.R'
     'calc_mangroves_area.R'
@@ -68,6 +73,7 @@ Collate:
     'get_gfw_lossyear.R'
     'get_gfw_treecover.R'
     'get_gmw.R'
+    'get_gsw.R'
     'get_nasa_firms.R'
     'get_nasa_grace.R'
     'get_nasa_srtm.R'

R/calc_gsw_change.R

@@ -0,0 +1,61 @@
+#' Calculate Global Surface Water (GSW) Change
+#'
+#' The change in water occurrence intensity between the two periods is derived
+#' from homologous pairs of months (i.e. same months containing valid
+#' observations in both periods). The difference in the occurrence of surface
+#' water was calculated for each homologous pair of months. The average of all
+#' of these differences constitutes the Surface Water Occurrence change
+#' intensity. The raster files have integer cell values between [0, 200] where 0
+#' represents surface water loss and 200 represents surface water gain.
+#'
+#' The pixel values are aggregated using method provided via the
+#' \code{stats_gsw} parameter.
+#'
+#' @param x A single polygon for which to calculate the GSW statistics.
+#' @param global_surface_water_change The GSW Change data source.
+#' @param engine The preferred processing functions from either one of "zonal",
+#' "extract" or "exactextract". Default: "extract".
+#' @param stats_gsw Aggregation function with which the data are combined.
+#' Default: "mean".
+#' @return A tibble containing the aggregated GSW change indicator. The column
+#' name is a concatenation of "global_surface_water_change_" + \code{stats_gsw}.
+#' @keywords internal
+#' @include register.R
+#' @noRd
+.calc_gsw_change <- function(x,
+                             global_surface_water_change,
+                             engine = "extract",
+                             stats_gsw = "mean") {
+  if (is.null(global_surface_water_change)) {
+    return(NA)
+  }
+
+  global_surface_water_change <- terra::clamp(
+    global_surface_water_change,
+    lower = 0,
+    upper = 200,
+    values = FALSE
+  )
+
+  results <- .select_engine(
+    x = x,
+    raster = global_surface_water_change,
+    stats = stats_gsw,
+    engine = engine,
+    name = "global_surface_water_change",
+    mode = "asset"
+  )
+
+  results
+}
+
+register_indicator(
+  name = "gsw_change",
+  resources = list(global_surface_water_change = "raster"),
+  fun = .calc_gsw_change,
+  arguments = list(
+    engine = "extract",
+    stats_gsw = "mean"
+  ),
+  processing_mode = "asset"
+)

R/calc_gsw_occurrence.R

@@ -0,0 +1,60 @@
+#' Calculate Global Surface Water (GSW) Occurrence
+#'
+#' GSW occurrence raw data comes in raster files with integer cell values
+#' between [0, 100]. This value gives the percentage of the time that a given
+#' pixel was classified as water during the entire observation period. So a 0
+#' denotes a pixel that was never classified as water, 100 denotes a pixel with
+#' permanent water.
+#'
+#' The pixel values are aggregated using method provided via the
+#' \code{stats_gsw} parameter.
+#'
+#' @param x A single polygon for which to calculate the GSW statistics.
+#' @param global_surface_water_occurrence The GSW Occurrence data source.
+#' @param engine The preferred processing functions from either one of "zonal",
+#' "extract" or "exactextract". Default: "extract".
+#' @param stats_gsw Aggregation function with which the data are combined.
+#' Default: "mean".
+#' @return A tibble containing the aggregated occurrence indicator. The column
+#' name is a concatenation of "global_surface_water_occurrence_" +
+#' \code{stats_gsw}.
+#' @keywords internal
+#' @include register.R
+#' @noRd
+.calc_gsw_occurrence <- function(x,
+                                 global_surface_water_occurrence,
+                                 engine = "extract",
+                                 stats_gsw = "mean") {
+  if (is.null(global_surface_water_occurrence)) {
+    return(NA)
+  }
+
+  global_surface_water_occurrence <- terra::clamp(
+    global_surface_water_occurrence,
+    lower = 0,
+    upper = 100,
+    values = FALSE
+  )
+
+  results <- .select_engine(
+    x = x,
+    raster = global_surface_water_occurrence,
+    stats = stats_gsw,
+    engine = engine,
+    name = "global_surface_water_occurrence",
+    mode = "asset"
+  )
+
+  results
+}
+
+register_indicator(
+  name = "gsw_occurrence",
+  resources = list(global_surface_water_occurrence = "raster"),
+  fun = .calc_gsw_occurrence,
+  arguments = list(
+    engine = "extract",
+    stats_gsw = "mean"
+  ),
+  processing_mode = "asset"
+)

R/calc_gsw_recurrence.R

@@ -0,0 +1,61 @@
+#' Calculate Global Surface Water (GSW) Recurrence
+#'
+#' Water Recurrence is a measurement of the degree of variability in the
+#' presence of water from year to year. It describes the frequency with which
+#' water returned to a particular location from one year to another, and is
+#' expressed as a percentage. The raster files have integer cell values between
+#' [0, 100], where 100 represents that water reoccurs predictably every year,
+#' whereas lower values indicate that water only occurs episodically.
+#'
+#' The pixel values are aggregated using method provided via the
+#' \code{stats_gsw} parameter.
+#'
+#' @param x A single polygon for which to calculate the GSW statistics.
+#' @param global_surface_water_recurrence The GSW Recurrence data source.
+#' @param engine The preferred processing functions from either one of "zonal",
+#' "extract" or "exactextract". Default: "extract".
+#' @param stats_gsw Aggregation function with which the data are combined.
+#' Default: "mean".
+#' @return A tibble containing the aggregated recurrence indicator. The column
+#' name is a concatenation of "global_surface_water_recurrence_" +
+#' \code{stats_gsw}.
+#' @keywords internal
+#' @include register.R
+#' @noRd
+.calc_gsw_recurrence <- function(x,
+                                 global_surface_water_recurrence,
+                                 engine = "extract",
+                                 stats_gsw = "mean") {
+  if (is.null(global_surface_water_recurrence)) {
+    return(NA)
+  }
+
+  global_surface_water_recurrence <- terra::clamp(
+    global_surface_water_recurrence,
+    lower = 0,
+    upper = 100,
+    values = FALSE
+  )
+
+  results <- .select_engine(
+    x = x,
+    raster = global_surface_water_recurrence,
+    stats = stats_gsw,
+    engine = engine,
+    name = "global_surface_water_recurrence",
+    mode = "asset"
+  )
+
+  results
+}
+
+register_indicator(
+  name = "gsw_recurrence",
+  resources = list(global_surface_water_recurrence = "raster"),
+  fun = .calc_gsw_recurrence,
+  arguments = list(
+    engine = "extract",
+    stats_gsw = "mean"
+  ),
+  processing_mode = "asset"
+)

R/calc_gsw_seasonality.R

@@ -0,0 +1,58 @@
+#' Calculate Global Surface Water (GSW) Seasonality
+#'
+#' GSW seasonality describes the intra-annual distribution of surface water for
+#' each pixel. The raster files have integer cell values between [0, 12],
+#' indicating how many months per year the pixel was classified as water.
+#'
+#' The pixel values are aggregated using method provided via the
+#' \code{stats_gsw} parameter.
+#'
+#' @param x A single polygon for which to calculate the GSW statistics.
+#' @param global_surface_water_seasonality The GSW Seasonality data source.
+#' @param engine The preferred processing functions from either one of "zonal",
+#' "extract" or "exactextract". Default: "extract".
+#' @param stats_gsw Aggregation function with which the data are combined.
+#' Default: "mean".
+#' @return A tibble containing the aggregated seasonality indicator. The column
+#' name is a concatenation of "global_surface_water_seasonality_" +
+#' \code{stats_gsw}.
+#' @keywords internal
+#' @include register.R
+#' @noRd
+.calc_gsw_seasonality <- function(x,
+    global_surface_water_seasonality,
+    engine = "extract",
+    stats_gsw = "mean") {
+  if (is.null(global_surface_water_seasonality)) {
+    return(NA)
+  }
+
+  global_surface_water_seasonality <- terra::clamp(
+    global_surface_water_seasonality,
+    lower = 0,
+    upper = 12,
+    values = FALSE
+  )
+
+  results <- .select_engine(
+    x = x,
+    raster = global_surface_water_seasonality,
+    stats = stats_gsw,
+    engine = engine,
+    name = "global_surface_water_seasonality",
+    mode = "asset"
+  )
+
+  results
+}
+
+register_indicator(
+  name = "gsw_seasonality",
+  resources = list(global_surface_water_seasonality = "raster"),
+  fun = .calc_gsw_seasonality,
+  arguments = list(
+    engine = "extract",
+    stats_gsw = "mean"
+  ),
+  processing_mode = "asset"
+)

R/calc_gsw_transitions.R

@@ -0,0 +1,75 @@
+#' Calculate Global Surface Water (GSW) Transitions
+#'
+#' GSW transition data contains information about the type of surface water
+#' change for each pixel. The raster files have integer cell values between
+#' [0, 10] that code for different transition classes:
+#'
+#' | Value | Transition Class      |
+#' |-------|-----------------------|
+#' | 1     | Permanent             |
+#' | 2     | New Permanent         |
+#' | 3     | Lost Permanent        |
+#' | 4     | Seasonal              |
+#' | 5     | New Seasonal          |
+#' | 6     | Lost Seasonal         |
+#' | 7     | Seasonal to Permanent |
+#' | 8     | Permanent to Seasonal |
+#' | 9     | Ephemeral Permanent   |
+#' | 10    | Ephemeral Seasonal    |
+#'
+#' To aggregate, we sum up the area of each transition class for a given region.
+#'
+#' @param x A single polygon for which to calculate the GSW statistics.
+#' @param global_surface_water_transitions The GSW Transitions data source.
+#' @return A tibble with two columns
+#' \itemize{
+#'   \item class: Surface water transition class.
+#'   \item area: Area in ha.
+#' }
+#' @keywords internal
+#' @include register.R
+#' @noRd
+.calc_gsw_transitions <- function(x, global_surface_water_transitions) {
+  if (is.null(global_surface_water_transitions)) {
+    return(NA)
+  }
+
+  global_surface_water_transitions <- terra::clamp(
+    global_surface_water_transitions,
+    lower = 1,
+    upper = 10,
+    values = FALSE
+  )
+
+  x_v <- terra::vect(x)
+  transition_mask <- terra::mask(global_surface_water_transitions, x_v)
+  arearaster <- terra::cellSize(transition_mask, mask = TRUE, unit = "ha")
+
+  result <- purrr::map_dfr(seq_len(terra::nlyr(transition_mask)), function(i) {
+    terra::zonal(arearaster, transition_mask[[i]], sum) %>%
+      stats::setNames(c("code", "area")) %>%
+      dplyr::left_join(.gsw_transition_classes, by = "code") %>%
+      dplyr::select(class, area)
+  }) %>%
+  tibble::tibble()
+
+  return(result)
+}
+
+.gsw_transition_classes <- data.frame(
+  code = 1:10,
+  class = c("Permanent", "New Permanent", "Lost Permanent", "Seasonal",
+            "New Seasonal", "Lost Seasonal", "Seasonal to Permanent",
+            "Permanent to Seasonal", "Ephemeral Permanent", "Ephemeral Seasonal"
+  )
+)
+
+register_indicator(
+  name = "gsw_transitions",
+  resources = list(global_surface_water_transitions = "raster"),
+  fun = .calc_gsw_transitions,
+  arguments = list(
+    engine = "extract"
+  ),
+  processing_mode = "asset"
+)