Merge pull request #15 from FelicitasBeier/Clustering

magpie 67k

.buildlibrary

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

.github/workflows/check.yaml

@@ -23,6 +23,7 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: |
+            gamstransfer=?ignore
             any::lucode2
             any::covr
             any::madrat

.pre-commit-config.yaml

@@ -3,7 +3,7 @@
 exclude: '^tests/testthat/_snaps/.*$'
 repos:
 -   repo: https://github.com/pre-commit/pre-commit-hooks
-    rev: v4.4.0
+    rev: v4.5.0
     hooks:
     -   id: check-case-conflict
     -   id: check-json
@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9021
+    rev: v0.3.2.9025
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

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: 'mrvalidation: madrat data preparation for validation purposes'
-version: 2.51.7
-date-released: '2023-10-23'
+version: 2.52.0
+date-released: '2023-11-08'
 abstract: Package contains routines to prepare data for validation exercises.
 authors:
 - family-names: Bodirsky

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mrvalidation
 Title: madrat data preparation for validation purposes
-Version: 2.51.7
-Date: 2023-10-23
+Version: 2.52.0
+Date: 2023-11-08
 Authors@R: c(
     person("Benjamin Leon", "Bodirsky", , "[email protected]", role = c("aut", "cre")),
     person("Stephen", "Wirth", role = "aut"),
@@ -35,9 +35,9 @@ Depends:
     R (>= 2.10.0),
     madrat (>= 2.11.3),
     magclass (>= 3.17),
-    mrcommons (>= 1.0.0),
+    mrcommons (>= 1.37.0),
     mrdrivers (>= 0.2.2),
-    mrmagpie,
+    mrmagpie (>= 1.39.0),
     mrfactors
 Imports:
     GDPuc,

NAMESPACE

@@ -92,6 +92,7 @@ importFrom(raster,"extent<-")
 importFrom(raster,aggregate)
 importFrom(raster,area)
 importFrom(raster,as.matrix)
+importFrom(raster,brick)
 importFrom(raster,extract)
 importFrom(raster,projectRaster)
 importFrom(raster,raster)

R/calcValidAAI.R

@@ -1,43 +1,42 @@
 #' @title calcValidAAI
-#' 
+#'
 #' @description Returns historical area actually irrigated.
-#' 
-#' @param datasource Currently available: \code{"LUH2v2"} and \code{"GMIA"} 
+#'
+#' @param datasource Currently available: \code{"LUH2v2"} and \code{"GMIA"}
 #' @return list of magpie object with data and weight
 #' @author Stephen Wirth, Anne Biewald
 #' @importFrom magpiesets reportingnames
 #' @importFrom madrat readSource calcOutput
 #' @importFrom magclass dimSums add_dimension
 
-calcValidAAI <- function(datasource="LUH2v2"){
-
-  if(datasource=="LUH2v2"){
-
-    #out <- readSource("LUH2v2","irrigation")[,,c("irrig_c3ann", "irrig_c4ann")]
-
-    out <- calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = TRUE, cellular = FALSE, selectyears = "past", aggregate = FALSE)
-    out <- collapseNames(out[,,c("c3ann","c4ann")][,,"irrigated"])
+calcValidAAI <- function(datasource = "LUH2v2") {
 
-    out <- dimSums(out, dim=3)
-
-    out <- add_dimension(out, dim=3.1, add="scenario", nm="historical")
-    out <- add_dimension(out, dim=3.2, add="model", nm=datasource)
-  }
-  else if(datasource=="GMIA"){
-    out <- calcOutput("GMIA", aggregate = FALSE)[,,"AAI_ha_"]/10^6
-
-    out <- add_dimension(out, dim=3.1, add="scenario", nm="historical")
-    out <- add_dimension(out, dim=3.2, add="model", nm=datasource)
+  if (datasource == "LUH2v2") {
+
+    out <- calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = TRUE,
+                      cellular = FALSE, selectyears = "past", aggregate = FALSE)
+    out <- collapseNames(out[, , c("c3ann", "c4ann")][, , "irrigated"])
+
+    out <- dimSums(out, dim = 3)
+
+    out <- add_dimension(out, dim = 3.1, add = "scenario", nm = "historical")
+    out <- add_dimension(out, dim = 3.2, add = "model", nm = datasource)
+  } else if (datasource == "GMIA") {
+    out <- calcOutput("GMIA", aggregate = FALSE)[, , "AAI_ha_"] / 10^6
+
+    out <- add_dimension(out, dim = 3.1, add = "scenario", nm = "historical")
+    out <- add_dimension(out, dim = 3.2, add = "model", nm = datasource)
   } else {
     stop("Given datasource currently not supported!")
   }
-  getNames(out, dim=3) <- paste("Resources|Land Cover|Cropland|Area actually irrigated","(million ha)",sep=" ")
+  getNames(out, dim = 3)  <- paste("Resources|Land Cover|Cropland|Area actually irrigated",
+                                   "(million ha)", sep = " ")
   names(dimnames(out))[3] <- "scenario.model.variable"
-  
-  return(list(x=out,
-              weight=NULL,
-              unit="million ha",
-              min=0,
-              description="Area actually irrigated in Mha")
+
+  return(list(x = out,
+              weight = NULL,
+              unit = "million ha",
+              min = 0,
+              description = "Area actually irrigated in Mha")
   )
 }

R/calcValidCarbon.R

@@ -15,34 +15,44 @@ calcValidCarbon <- function(datasource = "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:
 
   if (datasource == "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:historical") {
 
-    soilc <- calcOutput("LPJmL_new", version = "LPJmL4_for_MAgPIE_44ac93de", climatetype = "GSWP3-W5E5:historical", stage = "raw", subtype = "soilc", aggregate = FALSE)
-    litc  <- calcOutput("LPJmL_new", version = "LPJmL4_for_MAgPIE_44ac93de", climatetype = "GSWP3-W5E5:historical", stage = "raw", subtype = "litc",  aggregate = FALSE)
-    vegc  <- calcOutput("LPJmL_new", version = "LPJmL4_for_MAgPIE_44ac93de", climatetype = "GSWP3-W5E5:historical", stage = "raw", subtype = "vegc",  aggregate = FALSE)
+    soilc <- calcOutput("LPJmL_new", version = "LPJmL4_for_MAgPIE_44ac93de",
+                        climatetype = "GSWP3-W5E5:historical", stage = "raw", subtype = "soilc", aggregate = FALSE)
+    litc  <- calcOutput("LPJmL_new", version = "LPJmL4_for_MAgPIE_44ac93de",
+                        climatetype = "GSWP3-W5E5:historical", stage = "raw", subtype = "litc",  aggregate = FALSE)
+    vegc  <- calcOutput("LPJmL_new", version = "LPJmL4_for_MAgPIE_44ac93de",
+                        climatetype = "GSWP3-W5E5:historical", stage = "raw", subtype = "vegc",  aggregate = FALSE)
 
     nm <- "historical"
 
-  } else if (grepl("LPJmL4", datasource) & !grepl("GSWP3-W5E5", datasource)) {
+  } else if (grepl("LPJmL4", datasource) && !grepl("GSWP3-W5E5", datasource)) {
 
     version     <- gsub("^(.[^:]*):(.*)", "\\1", datasource)
     climatetype <- gsub("^(.[^:]*):(.*)", "\\2", datasource)
 
-    soilc <- calcOutput("LPJmL_new", version = version, climatetype = climatetype, subtype = "soilc", stage = "raw", aggregate = FALSE)
-    litc  <- calcOutput("LPJmL_new", version = version, climatetype = climatetype, subtype = "litc",  stage = "raw", aggregate = FALSE)
-    vegc  <- calcOutput("LPJmL_new", version = version, climatetype = climatetype, subtype = "vegc",  stage = "raw", aggregate = FALSE)
+    soilc <- calcOutput("LPJmL_new", version = version, climatetype = climatetype,
+                        subtype = "soilc", stage = "raw", aggregate = FALSE)
+    litc  <- calcOutput("LPJmL_new", version = version, climatetype = climatetype,
+                        subtype = "litc",  stage = "raw", aggregate = FALSE)
+    vegc  <- calcOutput("LPJmL_new", version = version, climatetype = climatetype,
+                        subtype = "vegc",  stage = "raw", aggregate = FALSE)
 
     nm <- "projection"
 
-  } else stop("No data exist for the given datasource!")
+  } else {
+    stop("No data exist for the given datasource!")
+  }
 
   stock <- mbind(setNames(soilc, "soilc"), setNames(litc, "litc"), setNames(vegc, "vegc"))
   rm(soilc, litc, vegc)
 
-  area  <- dimSums(calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = FALSE, cellular = TRUE, years = "y1995", aggregate = FALSE), dim = 3)
-  stock <- toolCoord2Isocell(stock) * setYears(area, NULL)
+  area  <- dimSums(calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = FALSE,
+                              cellular = TRUE, cells = "lpjcell", years = "y1995",
+                              aggregate = FALSE),
+                   dim = 3)
+  stock <- stock * setYears(area, NULL)
 
-  mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")
-  stock   <- toolAggregate(stock, rel = mapping, from = "celliso", to = "iso", dim = 1)
-  stock   <- toolCountryFill(stock, fill = 0)
+  stock <- dimSums(stock, dim = c("x", "y"))
+  stock <- toolCountryFill(stock, fill = 0)
 
   stock <- mbind(
     setNames(dimSums(stock, dim = 3), "Resources|Carbon (Mt C)"),

R/calcValidCostsTransport.R

@@ -95,28 +95,36 @@ calcValidCostsTransport <- function(datasource = "GTAPtransport") {
 
   } else if (datasource == "MAgPIEcalc") {
 
-    distance <- calcOutput("TransportTime", aggregate = FALSE)
-    productionKcr <- calcOutput("Production", cellular = TRUE, products = "kcr", attributes = "dm", aggregate = FALSE)
-    productionKli <- calcOutput("Production", cellular = TRUE, products = "kli", attributes = "dm", aggregate = FALSE)
-    productionPasture <- calcOutput("Production", cellular = TRUE,
+    distance <- calcOutput("TransportTime", cells = "lpjcell", aggregate = FALSE)
+    productionKcr <- calcOutput("Production", cellular = TRUE, cells = "lpjcell",
+                                products = "kcr", attributes = "dm", aggregate = FALSE)
+    productionKli <- calcOutput("Production", cellular = TRUE, cells = "lpjcell",
+                                products = "kli", attributes = "dm", aggregate = FALSE)
+    productionPasture <- calcOutput("Production", cellular = TRUE, cells = "lpjcell",
                                     products = "pasture", attributes = "dm", aggregate = FALSE)
     productionPasture <- add_dimension(productionPasture, add = "pasture",
                                        nm = "pasture", dim = 3.1)
     production <- mbind(productionKcr, productionKli, productionPasture)
 
     productionDistance <- collapseNames(distance * production, collapsedim = 2)
 
-
     # costs per unit per distance
     costs <- readSource("TransportCostsGTAP", convert = FALSE)
 
     products <- intersect(getNames(productionDistance), getNames(costs))
 
+    # total costs
     out <- costs[, , products] * productionDistance[, , products]
 
-    mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")
-    out   <- toolAggregate(out, rel = mapping, from = "celliso", to = "iso", dim = 1)
-    out   <- toolCountryFill(out, fill = 0)
+    # aggregate to country-level
+    out <- dimSums(out, dim = c(1.1, 1.2))
+    out <- toolCountryFill(out, fill = 0)
+
+    # add missing product groups, so that report and summation helper work properly.
+    # Note that forest, secondary, fish, bioenergy and  residues set to 0 currently
+    missingProducts <- setdiff(findset("kall"), products)
+    out <- add_columns(out, addnm = missingProducts, dim = 3.1)
+    out[, , missingProducts] <- 0
 
     out <- reporthelper(out, dim = 3.1, level_zero_name = "Costs|Transport", partly = TRUE,
                         detail = FALSE)
@@ -129,6 +137,7 @@ calcValidCostsTransport <- function(datasource = "GTAPtransport") {
     out <- add_dimension(out, dim = 3.2, add = "model", nm = datasource)
     description <- "Transport Costs"
 
+
   } else {
     stop("Only own calculation and GTAP transport costs avilable currently!")
   }