Forest loss drivers: fix the Curtis table, add GFW/Sims et al. (2025) as default source

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '15979746'
+ValidationKey: '16165500'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

CITATION.cff

@@ -2,8 +2,8 @@ cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
 title: 'mrland: MadRaT land data package'
-version: 0.77.1
-date-released: '2026-09-30'
+version: 0.78.0
+date-released: '2026-09-29'
 abstract: The package provides land related data via the madrat framework.
 authors:
 - family-names: Dietrich
@@ -23,6 +23,8 @@ authors:
   given-names: Ulrich
 - family-names: Klein
   given-names: David
+- family-names: Crawford
+  given-names: Michael
 - family-names: Steinmetz
   given-names: Nele
 - family-names: Chen

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mrland
 Title: MadRaT land data package
-Version: 0.77.1
-Date: 2026-09-30
+Version: 0.78.0
+Date: 2026-09-29
 Authors@R: c(
     person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = c("aut", "cre")),
     person("Abhijeet", "Mishra", role = "aut"),
@@ -12,6 +12,7 @@ Authors@R: c(
     person("Lavinia", "Baumstark", role = "aut"),
     person("Ulrich", "Kreidenweis", role = "aut"),
     person("David", "Klein", role = "aut"),
+    person("Michael", "Crawford", role = "aut"),
     person("Nele", "Steinmetz", role = "aut"),
     person("David", "Chen", role = "aut"),
     person("Florian", "Humpenoeder", role = "aut"),

NAMESPACE

@@ -157,8 +157,10 @@ importFrom(terra,
   tmpFiles
 )
 importFrom(utils,
+  URLencode,
   bibentry,
   download.file,
+  head,
   person,
   read.csv,
   read.csv2,

R/calcForestLossByDriver.R

@@ -0,0 +1,63 @@
+#' @title calcForestLossByDriver
+#'
+#' @description Forest area lost per year by driver, in Mha, from the Global Forest Watch driver
+#' product of Sims et al. (2025) (\code{src = "GFW"}, default) or from Table 1 of Curtis et al.
+#' (2018) (\code{src = "Curtis"}). Only the driver classes passed on to MAgPIE are returned.
+#'
+#' @details Curtis et al. (2018) report loss for seven world regions. It is distributed to
+#' countries by FRA 2020 naturally regenerating forest area in 2010.
+#'
+#' @param src \code{"GFW"} (default) or \code{"Curtis"}
+#' @param period Years averaged into the annual rate, GFW only; Curtis carries a single 2001-2015
+#' mean
+#' @return MAgPIE object with forest area lost per year by driver, Mha
+#' @author Abhijeet Mishra, Michael Crawford
+#' @seealso \code{\link{readGFWLossByDriver}}, \code{\link{readForestLossDrivers}}
+#' @examples
+#' \dontrun{
+#' calcOutput("ForestLossByDriver", aggregate = FALSE)
+#' calcOutput("ForestLossByDriver", src = "Curtis", aggregate = FALSE)
+#' }
+
+calcForestLossByDriver <- function(src = "GFW", period = 2015:2024) {
+
+  # Driver classes passed on to MAgPIE, each needing an element in MAgPIE's driver_source set.
+  # GFW options: permanent_agriculture, hard_commodities, shifting_cultivation, logging, wildfire,
+  # settlements_infrastructure, other_natural_disturbances, unknown. Curtis shares only
+  # shifting_cultivation and wildfire with these names.
+  # Only shifting cultivation is passed on: it leaves the land as forest and MAgPIE does not model
+  # it itself. Clearing for agriculture, commodities and settlements removes the forest, logging
+  # is MAgPIE's own harvest, wildfire and other natural disturbances are natural processes.
+  modelDrivers <- c("shifting_cultivation")
+
+  out <- switch(
+    src,
+    "Curtis" = {
+      x <- readSource("ForestLossDrivers", convert = FALSE)
+      getItems(x, dim = 3)[getItems(x, dim = 3) == "shifting_agriculture"] <- "shifting_cultivation"
+      mapping <- toolGetMapping("regionmappingCurtis2018.csv", type = "regional", where = "mrland")
+      # the area and year calcForestLossShare divides by, so every country in a region carries the
+      # region's rate
+      weight <- readSource("FRA2020", "forest_area", convert = TRUE)[, "y2010", "naturallyRegeneratingForest"]
+      toolAggregate(x[, , modelDrivers], rel = mapping, weight = setYears(collapseNames(weight), NULL),
+                    from = "RegionCode", to = "CountryCode")
+    },
+    "GFW" = {
+      x <- readSource("GFWLossByDriver", convert = TRUE)
+      wanted <- paste0("y", period)
+      absent <- setdiff(wanted, getYears(x))
+      if (length(absent) > 0) {
+        stop("calcForestLossByDriver: the GFW record does not cover ", toString(absent),
+             ". It runs ", min(getYears(x, TRUE)), "-", max(getYears(x, TRUE)), ".")
+      }
+      dimSums(x[, wanted, modelDrivers], dim = 2) / length(wanted)
+    },
+    stop("calcForestLossByDriver: unknown src '", src, "'. Use \"GFW\" or \"Curtis\".")
+  )
+
+  return(list(x = out,
+              weight = NULL,
+              unit = "Mha",
+              description = paste0("Forest area lost per year by driver (", src, ")"),
+              isocountries = FALSE))
+}

R/calcForestLossShare.R

@@ -1,36 +1,43 @@
 #' @title calcForestLossShare
 #'
-#' @description Calculates which share of forest land is lost due to different drivers
+#' @description Calculates which share of forest area is lost per year to each driver of
+#' forest loss.
 #'
-#' @return MAgPIE object with share of area lost in forests due to different drivers
-#' @author Abhijeet Mishra
-#' @seealso
-#' \code{\link{readForestLossDrivers}}
-#' 
+#' @param src Driver data to use, \code{"GFW"} (default) or \code{"Curtis"}, see
+#' \code{\link{calcForestLossByDriver}}
+#' @param period Years averaged into the annual rate, GFW only
+#'
+#' @details The denominator is FRA 2020 naturally regenerating forest area, the natural forest
+#' MAgPIE applies the share to: 2020 for \code{src = "GFW"}, 2010 for \code{src = "Curtis"}
+#' (loss 2001-2015). Shares above 1 are clamped to 1.
+#'
+#' @return MAgPIE object with the share of forest area lost per year by driver
+#' @author Abhijeet Mishra, Michael Crawford
+#' @seealso \code{\link{calcForestLossByDriver}}
 #' @examples
-#' 
-#' \dontrun{ 
-#' calcOutput("ForestLossShare",aggregate=FALSE)
+#' \dontrun{
+#' calcOutput("ForestLossShare", aggregate = FALSE)
+#' calcOutput("ForestLossShare", src = "Curtis", aggregate = FALSE)
 #' }
-#' 
-#' 
 
-calcForestLossShare <- function(){
-
-  lost_area   <- calcOutput("ForestFireLoss",aggregate=FALSE) # Convert=T returns Mha area lost to fire
-  forest_area <- setYears(setNames(readSource("FRA2020",subtype = "forest_area",convert = TRUE)[,"y2010","naturallyRegeneratingForest"],NULL),NULL) # Convert=T returns Mha area of forests
+calcForestLossShare <- function(src = "GFW", period = 2015:2024) {
+
+  lostArea <- calcOutput("ForestLossByDriver", src = src, period = period, aggregate = FALSE)
+
+  # FRA year in the loss period: Curtis covers 2001-2015, GFW 2015-2024 by default
+  year <- if (src == "Curtis") "y2010" else "y2020"
+  forestArea <- readSource("FRA2020", subtype = "forest_area",
+                           convert = TRUE)[, year, "naturallyRegeneratingForest"]
+  forestArea <- setYears(setNames(forestArea, NULL), NULL)
+
+  lostShare <- lostArea / forestArea
+  lostShare[is.infinite(lostShare)] <- 0
+  lostShare[is.na(lostShare)] <- 0
+  lostShare[lostShare > 1] <- 1
 
-  lost_share <- lost_area/forest_area
-  lost_share[is.infinite(lost_share)] <- 0
-  lost_share[is.na(lost_share)] <- 0
-  lost_share[lost_share>1] <- 1
-
-  out <- lost_share
-  weight <- forest_area
-
-  return(list(x=out,
-              weight=weight,
-              unit="1",
-              description="Area lost in forests by drivers",
-              isocountries=FALSE))
+  return(list(x = lostShare,
+              weight = forestArea,
+              unit = "1",
+              description = paste0("Share of forest area lost per year by driver (", src, ")"),
+              isocountries = FALSE))
 }

R/convertGFWLossByDriver.R

@@ -0,0 +1,53 @@
+#' @title convertGFWLossByDriver
+#'
+#' @description Moves the GFW data from the GADM country set to madrat's ISO country set: Kosovo,
+#' Northern Cyprus and the Akrotiri and Dhekelia base areas are added to Serbia and Cyprus, GADM's
+#' placeholder codes for disputed territories are dropped and countries GFW does not list are
+#' filled with zero.
+#'
+#' @param x magpie object as returned by \code{\link{readGFWLossByDriver}}
+#' @return magpie object on madrat's ISO country set, Mha
+#' @author Michael Crawford
+#' @seealso \code{\link{readGFWLossByDriver}}
+#' @examples
+#' \dontrun{
+#' a <- readSource("GFWLossByDriver", convert = TRUE)
+#' }
+
+convertGFWLossByDriver <- function(x) {
+
+  # GADM codes inside a madrat country; their loss is added to the host rather than dropped
+  gfwIsoHosts <- c(XKO = "SRB",  # Kosovo
+                   ZNC = "CYP",  # Northern Cyprus
+                   XAD = "CYP")  # Akrotiri and Dhekelia
+  # GADM placeholders for disputed territories, together about 0.03 per cent of global loss
+  gfwIsoDropped <- sprintf("Z%02d", 1:9)
+
+  before <- sum(x)
+
+  for (code in names(gfwIsoHosts)) {
+    host <- gfwIsoHosts[[code]]
+    if (code %in% getItems(x, 1)) {
+      if (host %in% getItems(x, 1)) {
+        x[host, , ] <- x[host, , ] + x[code, , ]
+      } else {
+        getItems(x, 1)[getItems(x, 1) == code] <- host
+        next
+      }
+      x <- x[setdiff(getItems(x, 1), code), , ]
+    }
+  }
+
+  out <- toolCountryFill(x, fill = 0, no_remove_warning = gfwIsoDropped)
+
+  # a new GADM code carrying real loss must fail here rather than vanish
+  lost <- (before - sum(out)) / before
+  if (lost > 0.005) {
+    stop("GFWLossByDriver: reconciling GADM with madrat's ISO set dropped ",
+         round(100 * lost, 3), " per cent of global loss, above the 0.5 per cent tolerance. ",
+         "Codes not in madrat: ",
+         toString(setdiff(getItems(x, 1), madrat::getISOlist())), ".")
+  }
+
+  return(out)
+}