Merge branch 'master' of https://github.com/pik-piam/mrmagpie

.Rbuildignore

@@ -9,3 +9,4 @@
 ^.lintr$
 ^tests/.lintr$
 ^Makefile$
+^.*CITATION.cff$

.buildlibrary

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

.pre-commit-config.yaml

@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9007
+    rev: v0.3.2.9013
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

CITATION.cff

@@ -0,0 +1,39 @@
+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.35.7
+date-released: '2023-07-06'
+abstract: Provides functions for MAgPIE country and cellular input data generation.
+authors:
+- family-names: Karstens
+  given-names: Kristine
+  email: [email protected]
+- family-names: Dietrich
+  given-names: Jan Philipp
+  email: [email protected]
+- family-names: Chen
+  given-names: David
+- family-names: Windisch
+  given-names: Michael
+- family-names: Alves
+  given-names: Marcos
+- family-names: Beier
+  given-names: Felicitas
+  email: [email protected]
+- family-names: v. Jeetze
+  given-names: Patrick
+  email: [email protected]
+- family-names: Mishra
+  given-names: Abhijeet
+  email: [email protected]
+- family-names: Humpenoeder
+  given-names: Florian
+  email: [email protected]
+- family-names: Führlich
+  given-names: Pascal
+  email: [email protected]
+license: LGPL-3.0
+repository-code: https://github.com/pik-piam/mrmagpie
+doi: 10.5281/zenodo.4319612
+

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mrmagpie
 Title: madrat based MAgPIE Input Data Library
-Version: 1.35.1
-Date: 2023-03-15
+Version: 1.35.7
+Date: 2023-07-06
 Authors@R: c(
     person("Kristine", "Karstens", , "[email protected]", role = c("aut", "cre")),
     person("Jan Philipp", "Dietrich", , "[email protected]", role = "aut"),
@@ -45,7 +45,7 @@ Imports:
     readxl,
     stats,
     stringr,
-    terra,
+    terra (>= 1.7.18),
     tidyr,
     withr
 Suggests:

Makefile

@@ -11,8 +11,9 @@ HELP_PARSING = 'm <- readLines("Makefile");\
 help:           ## Show this help.
 	@Rscript -e $(HELP_PARSING)
 
-build:          ## Build the package using lucode2::buildLibrary().
-	Rscript -e 'lucode2::buildLibrary()'
+build:          ## Build the package using lucode2::buildLibrary(). You can pass the
+                ## updateType with 'make build u=3'
+	Rscript -e 'lucode2::buildLibrary(updateType = "$(u)")'
 
 check:          ## Build documentation and vignettes, run testthat tests,
                 ## and check if code etiquette is followed using lucode2::check().

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(calcAreaEquippedForIrrigation)
 export(calcCellCountryFraction)
 export(calcClusterHierarchical)
 export(calcClusterKMeans)
@@ -110,6 +111,8 @@ importFrom(stringr,str_split)
 importFrom(terra,aggregate)
 importFrom(terra,classify)
 importFrom(terra,crds)
+importFrom(terra,crs)
+importFrom(terra,ext)
 importFrom(terra,focal)
 importFrom(terra,project)
 importFrom(terra,rast)
@@ -124,3 +127,4 @@ importFrom(utils,read.table)
 importFrom(utils,tail)
 importFrom(utils,unzip)
 importFrom(withr,local_options)
+importFrom(withr,with_options)

R/calcAgeClassDistribution.R

@@ -17,7 +17,7 @@ calcAgeClassDistribution <- function() {
   poulterDataset <- readSource("GFAD", convert = "onlycorrect")  ## Poulter data is fraction of each cell
 
   # Area of cells
-  mapping   <- toolGetMapping(type = "cell", name = "CountryToCellMapping.csv")
+  mapping   <- toolGetMapping(type = "cell", name = "CountryToCellMapping.csv", where = "mappingfolder")
 
   ## magpie_coord is loaded automatically with package -- not when running line by line
   cb <- as.data.frame(magpie_coord)

R/calcAreaActuallyIrrigated.R

@@ -7,36 +7,34 @@
 #' @return magpie object with results on cellular or iso country level
 #' @author Felicitas Beier
 #' @examples
-#'
 #' \dontrun{
 #' calcOutput("AreaActuallyIrrigated")
 #' }
 #'
-#'
 #' @importFrom magclass dimSums
 
-calcAreaActuallyIrrigated<-function(aggregationlevel="iso",selectyears="y1995"){
+calcAreaActuallyIrrigated <- function(aggregationlevel = "iso", selectyears = "y1995") {
   # Read in data: crop- and water supply type specific crop area (in Mha):
-  x <- calcOutput("Croparea", physical=TRUE, cellular=TRUE, irrigation=TRUE, round=6, aggregate=FALSE, years=selectyears)
+  x <- calcOutput("Croparea", physical = TRUE, cellular = TRUE, irrigation = TRUE, round = 6, aggregate = FALSE, years = selectyears)
 
   # extract irrigated area:
-  x <- dimSums(x[,,"irrigated"], dim=3.1)
+  x <- dimSums(x[, , "irrigated"], dim = 3.1)
   # total irrigated area per cell (sum over different crop types)
-  x <- dimSums(x, dim=3)
+  x <- dimSums(x, dim = 3)
 
-  if (aggregationlevel=="iso") {
+  if (aggregationlevel == "iso") {
     # country to cell mapping
-    CountryToCell <- toolGetMapping(type = "cell", name = "CountryToCellMapping.csv")
+    CountryToCell <- toolGetMapping(type = "cell", name = "CountryToCellMapping.csv", where = "mappingfolder")
     # aggregate data
-    toolAggregate(x, dim=1, rel=CountryToCell)
+    toolAggregate(x, dim = 1, rel = CountryToCell)
 
   } else {
     out <- x
   }
 
   return(list(
-    x=out,
-    weight=NULL,
-    unit="Million ha",
-    description="Irrigated cropland area"))
+    x = out,
+    weight = NULL,
+    unit = "Million ha",
+    description = "Irrigated cropland area"))
 }

R/calcAreaEquippedForIrrigation.R

@@ -0,0 +1,112 @@
+#' @title calcAreaEquippedForIrrigation
+#' @description Calculates the area equipped for irrigation based on LU2v2 or
+#'              Mehta data sets.
+#'              For LUH2v2, it assumes, that all cropland irrigated in the last
+#'              20 years at least once is equipped for irrigation.
+#'              Mehta et al. (2022) directly report Global Area Equipped for
+#'              Irrigation for the years 1900-2015
+#'
+#' @param cellular    if TRUE: 0.5 degree resolution returned
+#' @param cells       number of cells to be returned: magpiecell (59199), lpjcell (67420)
+#' @param selectyears default on "past"
+#'
+#' @return List of magpie objects with results on country/cellular level,
+#'         weight on country level, unit and description.
+#'
+#' @author Benjamin Leon Bodirsky, Kristine Karstens, Felicitas Beier
+#'
+#' @seealso
+#' [calcLanduseInitialisation()]
+#' @examples
+#' \dontrun{
+#' calcOutput("AreaEquippedForIrrigation", source = "LUH2v2", cellular = TRUE, aggregate = FALSE)
+#' }
+#' @importFrom magpiesets findset
+#'
+#' @export
+
+calcAreaEquippedForIrrigation <- function(cellular = FALSE,
+                                          cells = "magpiecell",
+                                          selectyears = "past") {
+
+  selectyears <- sort(findset(selectyears, noset = "original"))
+
+  ##########################################
+  ### Read in LUH2v2 irrigated area data ###
+  ##########################################
+  yearsNeeded <- as.integer(substring(selectyears, 2))
+  yearsNeeded <- (yearsNeeded[1] - 20):tail(yearsNeeded, 1)
+
+  x <- collapseNames(calcOutput("LUH2v2",
+                                landuse_types = "magpie",
+                                irrigation = TRUE,
+                                cellular = TRUE, cells = "lpjcell",
+                                selectyears = yearsNeeded,
+                                aggregate = FALSE)[, , "irrigated"])
+  x     <- dimSums(x, dim = 3)
+  years <- as.numeric(substring(selectyears, 2))
+  luh   <- NULL
+
+  # Cropland that it is irrigated at least once in the last 20 years
+  # is defined as "equipped for irrigation"
+  for (year in years) {
+    span <- (year - 20):year
+    tmp <- setYears(as.magpie(apply(X = x[, span, ], FUN = max, MARGIN = 1),
+                              spatial = 1),
+                    paste0("y", year))
+    luh <- mbind(luh, tmp)
+  }
+
+  # Naming of first dimension:
+  # Temporarily (until 67k preprocessing merged)
+  mapping <- toolGetMappingCoord2Country(pretty = TRUE)
+  getItems(luh, dim = 1, raw = TRUE) <- paste(mapping$coords, mapping$iso, sep = ".")
+  # Temporarily (until 67k preprocessing merged)
+
+  # rename sets
+  getSets(luh) <- c("x", "y", "iso", "year", "data")
+
+  # rename data dimension
+  getItems(luh, dim = 3) <- "LUH2v2"
+
+  ########################################
+  ### Read in Mehta et al. (2022) data ###
+  ########################################
+  mehta <- readSource("Mehta2022", convert = "onlycorrect")
+  years <- intersect(getItems(mehta, dim = 2), selectyears)
+  mehta <- mehta[, years, ]
+  getItems(mehta, dim = 3) <- "Mehta2022"
+
+  #########################
+  ### Combine data sets ###
+  #########################
+  years <- intersect(getItems(luh, dim = 2), getItems(mehta, dim = 2))
+  out   <- mbind(luh[, years, ], mehta[, years, ])
+
+  ##############
+  ### Output ###
+  ##############
+  # reduce to 59k cells
+  if (cells == "magpiecell") {
+    out <- toolCoord2Isocell(out)
+  }
+
+  # aggregate to iso level
+  if (!cellular) {
+    if (length(getItems(out, dim = 1)) == 67420) {
+      out <- dimSums(out, dim = c("x", "y"))
+    } else {
+      mapping <- toolGetMapping(name = "CountryToCellMapping.rds",
+                                where = "mrcommons")
+      out <- toolAggregate(out, rel = mapping,
+                           from = "celliso", to = "iso", dim = 1)
+    }
+    out <- toolCountryFill(out, fill = 0)
+  }
+
+  return(list(x            = out,
+              weight       = NULL,
+              unit         = "Million ha",
+              description  = "Area equipped for irrigation",
+              isocountries = !cellular))
+}

R/calcAvlWater.R

@@ -63,7 +63,7 @@ calcAvlWater <- function(lpjml = c(natveg = "LPJmL4_for_MAgPIE_44ac93de", crop =
 
     ## River basin water allocation algorithm:
     # River basin information
-    basinCode <- toolGetMapping("rivermapping.csv", type = "cell")
+    basinCode <- toolGetMapping("rivermapping.csv", type = "cell", where = "mappingfolder")
     basinCode <- basinCode$basincode
 
     # Sum the runoff in all basins and allocate it to the basin cells with discharge as weight

R/calcBphEffect.R

@@ -3,7 +3,7 @@
 #' of Bright et al. 2017 and Duveiller et al. 2018
 #'
 #' @return magpie object in cellular resolution
-#' @author Michael Windisch
+#' @author Michael Windisch, Felicitas Beier
 #'
 #' @examples
 #' \dontrun{
@@ -15,12 +15,24 @@
 
 calcBphEffect <- function() {
 
-  x <- readSource("BphEffect", convert = "onlycorrect")
-  k <- readSource("Koeppen", subtype = "cellular", convert = "onlycorrect")[, 1995, ]
+  # load BphEffect data
+  bph   <- readSource("Windisch2021", subtype = "refordefor_BPHonly_05_new",
+                    convert = "onlycorrect")
+
+  # prepare filled (0) plain for the nobgp case
+  x <- new.magpie(cells_and_regions = getItems(bph, dim = 1),
+                  years = NULL,
+                  names = c("nobgp", "ann_bph"),
+                  fill = 0)
+  x[, , "ann_bph"] <- bph[, , 1]
+
+  # read in Koeppen data and cell area weight
+  k      <- readSource("Koeppen", subtype = "cellular",
+                       convert = "onlycorrect")[, 1995, ]
   weight <- calcOutput("CellArea", aggregate = FALSE)
 
   # mapping to connect cell names with latitudes
-  map <- toolGetMapping(type = "cell", name = "CountryToCellMapping.csv")
+  map <- toolGetMapping(type = "cell", name = "CountryToCellMapping.csv", where = "mappingfolder")
 
   # assuming 0 was NA before.
   x[, , "ann_bph"][x[, , "ann_bph"] == 0] <- NA

R/calcBphMask.R

@@ -1,21 +1,22 @@
 #' @title calcBphMask
-#' @description Mask of Datapoints of biogeophysical temperature change of afforestation (degree C) to be
-#' used as weight. File is based on observation datasets of Bright et al. 2017 and Duveiller et al. 2018
-#' # @param
+#' @description Mask of Datapoints of biogeophysical temperature change of afforestation (degree C)
+#'              to be used as weight.
+#'              File is based on observation datasets of Bright et al. 2017 and Duveiller et al. 2018
 #' @return magpie object in cellular resolution
-#' @author Michael Windisch
+#' @author Michael Windisch, Felicitas Beier
 #'
 #' @examples
 #' \dontrun{
 #' calcOutput("BphMask", aggregate = FALSE)
 #' }
 #'
-#' @importFrom magpiesets findset
 #' @importFrom madrat readSource
 
 calcBphMask <- function() {
 
-  x <- readSource("BphMask", convert = "onlycorrect")
+  # load BphMask data
+  x <- readSource("Windisch2021", subtype = "refordefor_dT_ANN_nonzeromask_05",
+                  convert = "onlycorrect")
 
   weight <- calcOutput("CellArea", aggregate = FALSE)