Skip to content

Commit

Permalink
Adjusted the where value in toolGetMapping() (#14)
Browse files Browse the repository at this point in the history
* Adjusted the where value in toolGetMapping()

* fix where FAOitems_online.rda

* linter

* empty line

---------

Co-authored-by: Baseer Ahmad Baheer <[email protected]>
Co-authored-by: Pascal Führlich <[email protected]>
  • Loading branch information
3 people authored Oct 16, 2023
1 parent da44fcd commit 1f60b60
Show file tree
Hide file tree
Showing 28 changed files with 234 additions and 221 deletions.
2 changes: 1 addition & 1 deletion .buildlibrary
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
ValidationKey: '49392085'
ValidationKey: '49429336'
AutocreateReadme: yes
AcceptedWarnings:
- 'Warning: package ''.*'' was built under R version'
Expand Down
4 changes: 2 additions & 2 deletions CITATION.cff
Original file line number Diff line number Diff line change
Expand Up @@ -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.5
date-released: '2023-10-09'
version: 2.51.6
date-released: '2023-10-16'
abstract: Package contains routines to prepare data for validation exercises.
authors:
- family-names: Bodirsky
Expand Down
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Type: Package
Package: mrvalidation
Title: madrat data preparation for validation purposes
Version: 2.51.5
Date: 2023-10-09
Version: 2.51.6
Date: 2023-10-16
Authors@R: c(
person("Benjamin Leon", "Bodirsky", , "[email protected]", role = c("aut", "cre")),
person("Stephen", "Wirth", role = "aut"),
Expand Down
2 changes: 1 addition & 1 deletion R/calcValidCarbon.R
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ calcValidCarbon <- function(datasource = "LPJmL4_for_MAgPIE_44ac93de:GSWP3-W5E5:
area <- dimSums(calcOutput("LUH2v2", landuse_types = "LUH2v2", irrigation = FALSE, cellular = TRUE, years = "y1995", aggregate = FALSE), dim = 3)
stock <- toolCoord2Isocell(stock) * setYears(area, NULL)

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
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)

Expand Down
2 changes: 1 addition & 1 deletion R/calcValidGrassLSUha.R
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ calcValidGrassLSUha<-function(datasource = "MAgPIEown"){
grassl_shares[, , "range"] <- 1 - grassl_shares[, , "pastr"]
grassl_shares[is.nan(grassl_shares) | is.infinite(grassl_shares)] <- 0

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")

livestock <- setNames(toolCell2isoCell(readSource("GLW3")), "liv_numb")
livst_split <- livestock * grassl_shares
Expand Down
2 changes: 1 addition & 1 deletion R/calcValidGrassSoilCarbon.R
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ calcValidGrassSoilCarbon <- function(datasource = "ISIMIP3b:IPSL-CM6A-LR:ssp126:
soilc_range_past_tha <- calcOutput("RangeSoilCarbonHist", subtype = datasource, model = model, lpjml = lpjml, aggregate = F)
past <- getYears(soilc_range_past_tha)

map_reg <- toolGetMapping(type = "regional", name = "clustermapping.csv")
map_reg <- toolGetMapping(type = "regional", name = "clustermapping.csv", where = "mappingfolder")

soilc_range_past_mt <- setNames(land_ini_LUH2v2[, past, "range"] * soilc_range_past_tha, "range")
soilc_pastr_past_mt <- setNames(land_ini_LUH2v2[, past, "pastr"] * soilc_pastr_past_tha[, past, "pastr"], "pastr")
Expand Down
2 changes: 1 addition & 1 deletion R/calcValidLSUdensity.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ prod <- calcOutput("GrasslandBiomass", aggregate = F)[, past, "range"]
prod <- toolCountryFill(prod, fill = 0)

# regional mapping
cell2reg <- toolGetMapping("CountryToCellMapping.csv", type = "cell")
cell2reg <- toolGetMapping("CountryToCellMapping.csv", type = "cell", where = "mappingfolder")

# pasture areas
area <- calcOutput("LUH2v2",
Expand Down
2 changes: 1 addition & 1 deletion R/calcValidLand.R
Original file line number Diff line number Diff line change
Expand Up @@ -125,7 +125,7 @@ calcValidLand <- function(datasource = "MAgPIEown") {
# Renaming reporting categories from SSPResults to MAgPie validation names
# (not all SSP-categories have MAgPIE-equivalents)

mapping <- toolGetMapping(type = "sectoral", name = "mappingSSPResultsToMAgPIEValid.csv")
mapping <- toolGetMapping(type = "sectoral", name = "mappingSSPResultsToMAgPIEValid.csv", where = "mappingfolder")
mappingFrom <- as.vector(mapping[, "SSPResults"])
mappingTo <- as.vector(mapping[, "MAgPIEValid"])
names(mappingTo) <- mappingFrom
Expand Down
4 changes: 2 additions & 2 deletions R/calcValidManure.R
Original file line number Diff line number Diff line change
Expand Up @@ -77,13 +77,13 @@ calcValidManure<-function(datasource="Bodirsky"){
)

confinement<-collapseNames(confinement[,,selection][,,"Manure_treated_(N_content)_(kg)"])
mapping<-toolGetMapping(type = "sectoral",name = "IPCCitems_fao_online.csv")
mapping<-toolGetMapping(type = "sectoral",name = "IPCCitems_fao_online.csv", where = "mappingfolder")
confinement<-toolAggregate(confinement,rel=mapping,from="fao",to="magpie",dim = 3.1)

pasture<-collapseNames(pasture[,,getNames(pasture,dim=1)[getNames(pasture,dim=1)%in%selection]][,,"Manure_left_on_pasture_(N_content)_(kg)"])

#pasture<-collapseNames(pasture[,,selection][,,"Manure_(N_content)_(Manure_management)_(Kg)"])
mapping<-toolGetMapping(type = "sectoral",name = "IPCCitems_fao_online.csv")
mapping<-toolGetMapping(type = "sectoral",name = "IPCCitems_fao_online.csv", where = "mappingfolder")
pasture<-toolAggregate(pasture,rel=mapping,from="fao",to="magpie",dim = 3.1,partrel = T)

out<-pasture+confinement
Expand Down
2 changes: 1 addition & 1 deletion R/calcValidNitrogenBudgetCropland.R
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ calcValidNitrogenBudgetCropland <- function(datasource = "Bodirsky") {
"961|Cattle, non-dairy"
)
tmp2 <- collapseNames(manure[, , selection][, , "Manure_applied_to_soils_(N_content)_(kg)"])
mapping <- toolGetMapping(type = "sectoral", name = "IPCCitems_fao_online.csv")
mapping <- toolGetMapping(type = "sectoral", name = "IPCCitems_fao_online.csv", where = "mappingfolder")
tmp2 <- toolAggregate(tmp2, rel = mapping, from = "fao", to = "magpie", dim = 3.1)
tmp2 <- tmp2 / 1e12
manure <- setNames(dimSums(tmp2, dim = 3.1), "manure_conf")
Expand Down
8 changes: 5 additions & 3 deletions R/calcValidSDG12.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ calcValidSDG12 <- function(datasource = "FAO") {
indicatorname <- "SDG|SDG12|Food loss"
unit <- "Mt"
foodLoss <- readSource("FAO_online", subtype = "CBCrop")
aggregation <- toolGetMapping("FAOitems_online.rda", type = "sectoral")
aggregation <- toolGetMapping("FAOitems_online.rda", type = "sectoral", where = "mrvalidation")
# standarized items _ magpie object
aAgg <- toolAggregate(foodLoss, rel = aggregation, from = "FAOaggregatedItem_fromWebsite",
to = "k", dim = 3.1, partrel = TRUE)
Expand Down Expand Up @@ -49,7 +49,7 @@ calcValidSDG12 <- function(datasource = "FAO") {
indicatorname <- "SDG|SDG12|Food waste"
unit <- "kcal/cap/day"
# Reads food supply including household waste
avFood <- calcOutput(type = "FoodSupplyPast", aggregate = FALSE)[,,"kcal"]
avFood <- calcOutput(type = "FoodSupplyPast", aggregate = FALSE)[, , "kcal"]
avFood <- dimSums(avFood, dim = 3)
# Calculate expected intake. Source is Lutz2014. Average for male,female,ages.ssp1 (historical trend)
intake <- calcOutput("Intake", aggregate = FALSE)
Expand All @@ -67,7 +67,9 @@ calcValidSDG12 <- function(datasource = "FAO") {
unitsX <- c(unitsX, unit)
popul <- popul[, comYears, ]

} else stop("No data exist for the given datasource!")
} else {
stop("No data exist for the given datasource!")
}

return(list(x = x,
weight = popul,
Expand Down
6 changes: 3 additions & 3 deletions R/calcValidSOCDensity.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ calcValidSOCDensity <- function(datasource = "GSOC") {
cellular = TRUE, selectyears = "past_all", aggregate = FALSE)
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")
soilc <- toolAggregate(soilc, weight = area, rel = mapping, from = "celliso", to = "iso", dim = 1)
soilc <- toolCountryFill(soilc, fill = 0)
out <- setNames(soilc, "Resources|Soil Carbon|Actual|Density|SOC in top 30 cm (tC/ha)")
Expand All @@ -48,7 +48,7 @@ calcValidSOCDensity <- function(datasource = "GSOC") {
cellular = TRUE, selectyears = "past_all", aggregate = FALSE)
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")
soilc <- toolAggregate(soilc, weight = area, rel = mapping, from = "celliso", to = "iso", dim = 1)
soilc <- toolCountryFill(soilc, fill = 0)
out <- setNames(soilc, "Resources|Soil Carbon|Actual|Density|SOC in top 30 cm (tC/ha)")
Expand All @@ -70,7 +70,7 @@ calcValidSOCDensity <- function(datasource = "GSOC") {
cellular = TRUE, selectyears = "past_all", aggregate = FALSE)
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")
soilc <- toolAggregate(soilc, weight = area, rel = mapping, from = "celliso", to = "iso", dim = 1)
soilc <- toolCountryFill(soilc, fill = 0)
out <- setNames(soilc, "Resources|Soil Carbon|Actual|Density|SOC in top 30 cm (tC/ha)")
Expand Down
10 changes: 5 additions & 5 deletions R/calcValidSOCStocks.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ calcValidSOCStocks <- function(datasource = "LPJ_IPCC2006", baseyear = 1995) {

if (datasource == "LPJ_IPCC2006") {

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell", where = "mappingfolder")
somStock <- calcOutput("SOM", subtype = "stock", aggregate = FALSE)
somStock <- toolAggregate(somStock, rel = mapping,
from = ifelse(nregions(somStock) > 1, "celliso", "cell"), to = "iso", dim = 1)
Expand Down Expand Up @@ -75,7 +75,7 @@ calcValidSOCStocks <- function(datasource = "LPJ_IPCC2006", baseyear = 1995) {
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)
stock <- soilc * area

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
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)
out <- setNames(stock, "Resources|Soil Carbon|Actual|Stock|SOC in top 30 cm (Mt C)")
Expand All @@ -91,7 +91,7 @@ calcValidSOCStocks <- function(datasource = "LPJ_IPCC2006", baseyear = 1995) {
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)
stock <- soilc * area

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
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)
out <- setNames(stock, "Resources|Soil Carbon|Actual|Stock|SOC in top 30 cm (Mt C)")
Expand All @@ -108,7 +108,7 @@ calcValidSOCStocks <- function(datasource = "LPJ_IPCC2006", baseyear = 1995) {
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)
stock <- soilc * area

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
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)
out <- setNames(stock, "Resources|Soil Carbon|Actual|Stock|SOC in top 30 cm (Mt C)")
Expand All @@ -126,7 +126,7 @@ calcValidSOCStocks <- function(datasource = "LPJ_IPCC2006", baseyear = 1995) {
area <- setYears(dimSums(area[, 2010, ], dim = 3), NULL)
stock <- soilc * area

mapping <- toolGetMapping(name = "CountryToCellMapping.csv", type = "cell")
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)
out <- setNames(stock, "Resources|Soil Carbon|Actual|Stock|SOC in top 30 cm (Mt C)")
Expand Down
8 changes: 4 additions & 4 deletions R/calcValidTau.R
Original file line number Diff line number Diff line change
Expand Up @@ -76,9 +76,9 @@ calcValidTau <- function(datasource = "FAO2012") {
unit = "-",
description = description,
note = c("data uses initialization values for 1995 based on ",
"Dietrich J.P., Schmitz C., M\uFCller C., Fader M., Lotze-Campen H., Popp A.,",
"Measuring agricultural land-use intensity - A global analysis using a model-assisted approach",
"Ecological Modelling, Volume 232, 10 May 2012, 109-118, DOI 10.1016/j.ecolmodel.2012.03.002.",
"preprint available \u40 http://edoc.gfz-potsdam.de/pik/display.epl?mode=doc&id=5281")))
"Dietrich J.P., Schmitz C., M\uFCller C., Fader M., Lotze-Campen H., Popp A.,",
"Measuring agricultural land-use intensity - A global analysis using a model-assisted approach",
"Ecological Modelling, Volume 232, 10 May 2012, 109-118, DOI 10.1016/j.ecolmodel.2012.03.002.",
"preprint available \u40 http://edoc.gfz-potsdam.de/pik/display.epl?mode=doc&id=5281")))

}
48 changes: 22 additions & 26 deletions R/calcValidTauPastr.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,25 +11,22 @@
calcValidTauPastr <- function() {
past <- findset("past")
# Production
prod <- calcOutput("GrasslandBiomass", aggregate = F)[, past, "pastr"]
prod <- calcOutput("GrasslandBiomass", aggregate = FALSE)[, past, "pastr"]
prod <- toolCountryFill(prod, fill = 0)

# regional mapping
cell2reg <- toolGetMapping("CountryToCellMapping.csv", type = "cell")
cell2reg <- toolGetMapping("CountryToCellMapping.csv", type = "cell", where = "mappingfolder")

# pasture areas
area <- calcOutput("LUH2v2",
landuse_types = "LUH2v2",
cellular = F, aggregate = F
)[, past, "pastr"]
area <- calcOutput("LUH2v2", landuse_types = "LUH2v2", cellular = FALSE, aggregate = FALSE)[, past, "pastr"]
area <- toolCountryFill(area, fill = 0)

# Adding 'otherland' as an extra source of grass biomass comparable
# to managed pastures in India, Pakistan and Bangladesh.
otherland <-
calcOutput("LUH2v2",
landuse_types = "LUH2v2",
cellular = F, aggregate = F
cellular = FALSE, aggregate = FALSE
)[, past, c("secdn", "primn")]
area["IND", , "pastr"] <-
area["IND", , "pastr"] +
Expand All @@ -47,21 +44,20 @@ calcValidTauPastr <- function() {

# reference yields
yref <- calcOutput("GrasslandsYields",
lpjml = "lpjml5p2_pasture",
climatetype = "MRI-ESM2-0:ssp245",
subtype = "/co2/Nreturn0p5",
lsu_levels = c(seq(0, 2.2, 0.2), 2.5), past_mngmt = "mdef",
aggregate = F
)[, past, "pastr.rainfed"]
lpjml = "lpjml5p2_pasture",
climatetype = "MRI-ESM2-0:ssp245",
subtype = "/co2/Nreturn0p5", # nolint: absolute_path_linter.
lsu_levels = c(seq(0, 2.2, 0.2), 2.5), past_mngmt = "mdef",
aggregate = FALSE)[, past, "pastr.rainfed"]

yref_weights <- calcOutput("LUH2v2",
landuse_types = "LUH2v2", cellular = T,
aggregate = F
yrefWeights <- calcOutput("LUH2v2",
landuse_types = "LUH2v2", cellular = TRUE,
aggregate = FALSE
)[, past, "pastr"]
yref <- toolAggregate(yref,
rel = cell2reg, from = "celliso",
to = "iso",
weight = yref_weights
rel = cell2reg, from = "celliso",
to = "iso",
weight = yrefWeights
)
yref <- toolCountryFill(yref, fill = 0)

Expand All @@ -71,21 +67,21 @@ calcValidTauPastr <- function() {
t <- collapseNames(t)

# replacing unrealistic high tau values by regional averages
reg_map <- toolGetMapping("regionmappingH12.csv", type = "regional")
t_reg <- toolAggregate(t,
rel = reg_map, weight = area,
regMap <- toolGetMapping("regionmappingH12.csv", type = "regional", where = "madrat")
tReg <- toolAggregate(t,
rel = regMap, weight = area,
from = "CountryCode", to = "RegionCode"
)
regions <- reg_map$RegionCode
names(regions) <- reg_map[, "CountryCode"]
regions <- regMap$RegionCode
names(regions) <- regMap[, "CountryCode"]

largeTC <- where(t >= 10)$true$individual # tau threshold
colnames(largeTC)[1] <- "country"
largeTC <- as.data.frame(largeTC)

for (i in as.vector(largeTC[, "country"])) {
for (j in as.vector(largeTC[largeTC$country == i, "year"])) {
t[i, j, ] <- t_reg[regions[i], j, ]
t[i, j, ] <- tReg[regions[i], j, ]
}
}

Expand All @@ -100,4 +96,4 @@ calcValidTauPastr <- function() {
description =
"Historic Trends in managed pastures Land Use Intensity Tau based on FAO yield trends" # nolint
))
}
}
Loading

0 comments on commit 1f60b60

Please sign in to comment.