Removing pasture suitability calibration from calcPastureSuit.R from the preprocessing

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '29200821'
+ValidationKey: '29385400'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'

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: 'mrmagpie: madrat based MAgPIE Input Data Library'
-version: 1.47.1
-date-released: '2024-05-08'
+version: 1.48.0
+date-released: '2024-05-12'
 abstract: Provides functions for MAgPIE country and cellular input data generation.
 authors:
 - family-names: Karstens

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mrmagpie
 Title: madrat based MAgPIE Input Data Library
-Version: 1.47.1
-Date: 2024-05-08
+Version: 1.48.0
+Date: 2024-05-12
 Authors@R: c(
     person("Kristine", "Karstens", , "[email protected]", role = c("aut", "cre")),
     person("Jan Philipp", "Dietrich", , "[email protected]", role = "aut"),

R/calcPastureSuit.R

@@ -15,10 +15,10 @@
 #' }
 #' @importFrom raster area rasterFromXYZ
 
-calcPastureSuit <- function(climatetype = "MRI-ESM2-0:ssp126",
-                            lpjml       =  "LPJmL4_for_MAgPIE_44ac93de",
-                            cells       = "lpjcell") {
 
+calcPastureSuit <- function(climatetype = "MRI-ESM2-0:ssp126",
+                            lpjml = "LPJmL4_for_MAgPIE_44ac93de",
+                            cells = "lpjcell") {
   x <- toolSplitSubtype(climatetype, list(climatemodel = NULL, scenario = NULL))
 
   # Extract stage argument information
@@ -29,88 +29,80 @@ calcPastureSuit <- function(climatetype = "MRI-ESM2-0:ssp126",
   }
 
   # Drivers of managed pastures
-  population <- calcOutput("GridPop", subtype = "all", cellular = TRUE, FiveYear = TRUE, harmonize_until = 2015,
-                           aggregate = FALSE)[, , toupper(substring(x$scenario, first = 0, last = 4))]
-
-  cellPrep   <- calcOutput("LPJmLClimateInput", climatetype  = climatetype,
-                           variable     = "precipitation:monthlySum",
-                           stage        = stage,
-                           lpjmlVersion = lpjml,
-                           aggregate    = FALSE)
-
-
-  cellPet    <- calcOutput(type = "LPJmL_new", climatetype = climatetype,
-                           subtype   = "mpet",
-                           stage     = stage,
-                           version   = lpjml,
-                           aggregate = FALSE)
-
-  yearsCellPet      <- intersect(getYears(cellPet), findset("time"))
-  yearsCellPrep     <- intersect(findset("time"), getYears(cellPrep))
-  years             <- intersect(yearsCellPet, yearsCellPrep)
-  cellPrep          <- dimSums(cellPrep[, years, ], dim = 3)
-  cellPet           <- dimSums(cellPet[, years, ], dim = 3)
+  population <- calcOutput("GridPop",
+    subtype = "all", cellular = TRUE, FiveYear = TRUE, harmonize_until = 2015,
+    aggregate = FALSE
+  )[, , toupper(substring(x$scenario, first = 0, last = 4))]
+
+  cellPrep <- calcOutput("LPJmLClimateInput",
+    climatetype = climatetype,
+    variable = "precipitation:monthlySum",
+    stage = stage,
+    lpjmlVersion = lpjml,
+    aggregate = FALSE
+  )
+
+
+  cellPet <- calcOutput(
+    type = "LPJmL_new", climatetype = climatetype,
+    subtype = "mpet",
+    stage = stage,
+    version = lpjml,
+    aggregate = FALSE
+  )
+
+  yearsCellPet <- intersect(getYears(cellPet), findset("time"))
+  yearsCellPrep <- intersect(findset("time"), getYears(cellPrep))
+  years <- intersect(yearsCellPet, yearsCellPrep)
+  cellPrep <- dimSums(cellPrep[, years, ], dim = 3)
+  cellPet <- dimSums(cellPet[, years, ], dim = 3)
 
   # Cell area calculation
-  landArea <- calcOutput("LandArea", aggregate = FALSE) / 100 # transformed to km^2
+  land <- calcOutput("LanduseInitialisation", input_magpie = TRUE,
+                     aggregate = FALSE, cellular = TRUE, cells = cells,
+                     years = "y1995", round = 6)
+  landArea <- setYears(dimSums(land, dim = 3), NULL)
 
-  # population density
-  popDensity <- (population * 1e6) / landArea # population density in number of people per km2
+  # Calculate population density in people per km2: (Million people / Mha) = (1e6 / 10000)
+  popDensity <- population / landArea * 1e6 / 10000
   popDensity[is.infinite(popDensity)] <- 0
   popDensity[is.nan(popDensity)] <- 0
 
   years <- intersect(getYears(popDensity), getYears(cellPrep))
 
+  # Following the methodology presented in HYDE3.2
+  # (https://essd.copernicus.org/articles/9/927/2017/essd-9-927-2017.pdf),
+  # to distinguish between these types of grasslands in a simple and transparent
+  # way, also historically, a population density and an aridity index are applied,
+  # based on expert judgement. Low animal densities can be related to either low
+  # population density or to low productivity of the natural vegetation, which is
+  # approximated via the aridity index. When the aridity index (defined as annual
+  # precipitation divided by annual evapotranspiration) of a grid cell is greater than 0.5,
+  # and population density is greater than 5 inhabitants km^2, then it is defined
+  # as suitable for managed pastures, otherwise rangelands.
+
   aridity <- cellPrep[, years, ] / cellPet[, years, ]
   aridity[is.infinite(aridity) | is.nan(aridity)] <- 0
-  # 0.5 aridity threshold for managed pastures. Same from HYDE 3.2.
+
   aridity[aridity < 0.5] <- 0
   aridity[aridity >= 0.5] <- 1
 
-  # pasture suitability check
   pastureSuit <- aridity
   popDensity <- popDensity[, getYears(pastureSuit), ]
-  pastureSuit[popDensity < 5] <- 0 # 5 hab km2 population threshold for managed pastures. Same from HYDE 3.2.
 
-  pastureSuitArea <- (pastureSuit * landArea * 100) / 1e6 # (from km2 (x100) to mha (/1e6))
-  pastureSuitArea <- collapseDim(pastureSuitArea)
-  pastureSuitArea <- toolHoldConstantBeyondEnd(pastureSuitArea)
+  popDensity <- popDensity > 5
+  pastureSuit <- pastureSuit * popDensity
 
-  # calibration to historical values
-  histPastr <- setNames(calcOutput("LanduseInitialisation", cellular = TRUE,
-                                   nclasses = "nine", aggregate = FALSE)[, , c("past")], "pastr")
-  pastAll <- intersect(getYears(histPastr), getYears(pastureSuitArea))
-
-  pastLy <- findset("past")
-  pastLy <- pastLy[length(pastLy)] # past last year
-  future <- setdiff(getYears(pastureSuitArea), pastAll)
-
-  pastureSuitAreaReg <- dimSums(pastureSuitArea, dim = c("x", "y"))
-  histPastrReg       <- dimSums(histPastr, dim = c("x", "y"))
-  calibReg <- histPastrReg[, pastLy, ] / pastureSuitAreaReg[, pastLy, ]
-  calibReg[is.infinite(calibReg)] <- 1
-  calibReg[is.nan(calibReg)]      <- 0
-  pastureSuitArea[, future, ] <- calibReg * pastureSuitArea[, future, ]
-
-  pastureSuitArea[is.infinite(pastureSuitArea) | is.nan(pastureSuitArea) | is.na(pastureSuitArea)] <- 0
-  pastureSuitArea[pastureSuitArea < 0] <- 0
-  pastureSuitArea[, pastAll, ] <- histPastr[, pastAll, ]
-
-  y <- intersect(pastAll, getYears(pastureSuitArea))
-  pastureSuitArea[, y, ] <- histPastr[, intersect(pastAll, getYears(pastureSuitArea)), ]
-  pastureSuitArea <- toolHoldConstant(pastureSuitArea, findset("time"))
-  pastureSuitArea <- collapseNames(pastureSuitArea)
-  pastureSuitArea[, pastAll, ] <- histPastr[, pastAll, ]
-  #maybe change to: pastureSuitArea[, pastAll, ] <- max(histPastr[, pastAll, ], pastureSuitArea[, pastAll, ]) #nolint
-
-  # Reduce number of grid cells to 59199
-  if (cells == "magpiecell") {
-    pastureSuitArea <- toolCoord2Isocell(pastureSuitArea, cells = cells)
-  }
+  pastureSuitArea <- (pastureSuit * landArea * 100) / 1e6 # (from km2 (x100) to mha (/1e6))
 
-  return(list(x            = pastureSuitArea,
-              weight       = NULL,
-              unit         = "Mha",
-              description  = "Area suitable for pasture management in mha",
-              isocountries = FALSE))
+  pastureSuitArea <- toolHoldConstantBeyondEnd(pastureSuitArea)
+  getItems(pastureSuitArea, dim = 3)  <- NULL
+
+  return(list(
+    x = pastureSuitArea,
+    weight = NULL,
+    unit = "Mha",
+    description = "Area suitable for pasture management in mha",
+    isocountries = FALSE
+  ))
 }

README.md

@@ -1,6 +1,6 @@
 # madrat based MAgPIE Input Data Library
 
-R package **mrmagpie**, version **1.47.1**
+R package **mrmagpie**, version **1.48.0**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/mrmagpie)](https://cran.r-project.org/package=mrmagpie) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.4319612.svg)](https://doi.org/10.5281/zenodo.4319612) [![R build status](https://github.com/pik-piam/mrmagpie/workflows/check/badge.svg)](https://github.com/pik-piam/mrmagpie/actions) [![codecov](https://codecov.io/gh/pik-piam/mrmagpie/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrmagpie) [![r-universe](https://pik-piam.r-universe.dev/badges/mrmagpie)](https://pik-piam.r-universe.dev/builds)
 
@@ -39,7 +39,7 @@ In case of questions / problems please contact Kristine Karstens <karstens@pik-p
 
 To cite package **mrmagpie** in publications use:
 
-Karstens K, Dietrich J, Chen D, Windisch M, Alves M, Beier F, Köberle A, v. Jeetze P, Mishra A, Humpenoeder F, Sauer P (2024). _mrmagpie: madrat based MAgPIE Input Data Library_. doi:10.5281/zenodo.4319612 <https://doi.org/10.5281/zenodo.4319612>, R package version 1.47.1, <https://github.com/pik-piam/mrmagpie>.
+Karstens K, Dietrich J, Chen D, Windisch M, Alves M, Beier F, Köberle A, v. Jeetze P, Mishra A, Humpenoeder F, Sauer P (2024). _mrmagpie: madrat based MAgPIE Input Data Library_. doi: 10.5281/zenodo.4319612 (URL: https://doi.org/10.5281/zenodo.4319612), R package version 1.48.0, <URL: https://github.com/pik-piam/mrmagpie>.
 
 A BibTeX entry for LaTeX users is
 
@@ -48,8 +48,8 @@ A BibTeX entry for LaTeX users is
   title = {mrmagpie: madrat based MAgPIE Input Data Library},
   author = {Kristine Karstens and Jan Philipp Dietrich and David Chen and Michael Windisch and Marcos Alves and Felicitas Beier and Alexandre Köberle and Patrick {v. Jeetze} and Abhijeet Mishra and Florian Humpenoeder and Pascal Sauer},
   year = {2024},
-  note = {R package version 1.47.1},
-  url = {https://github.com/pik-piam/mrmagpie},
+  note = {R package version 1.48.0},
   doi = {10.5281/zenodo.4319612},
+  url = {https://github.com/pik-piam/mrmagpie},
 }
 ```