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!")
  }