add where arg to toolGetMapping

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '98484988'
+ValidationKey: '98524690'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

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: 'mrland: MadRaT land data package'
-version: 0.50.14
-date-released: '2023-10-12'
+version: 0.50.15
+date-released: '2023-10-16'
 abstract: The package provides land related data via the madrat framework.
 authors:
 - family-names: Dietrich

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mrland
 Title: MadRaT land data package
-Version: 0.50.14
-Date: 2023-10-12
+Version: 0.50.15
+Date: 2023-10-16
 Authors@R: c(
     person("Jan Philipp", "Dietrich", , "[email protected]", role = c("aut", "cre")),
     person("Abhijeet", "Mishra", role = "aut"),

R/calcBMIshr.R

@@ -1,102 +1,104 @@
 #' @title calcBMIshr
 #'
 #' @description estimates population based on BMI share
-#' 
+#'
 #' @param convert Use raw data or interpolated data. Raw data should only be used for regressions.
 #'
 #' @return List with a magpie object
 #' @author Benjamin Leon Bodirsky
 #' @seealso
 #' \code{\link{readNCDrisc}},
 #' \code{\link{calcIntake}}
-#' 
+#'
 #' @examples
-#' 
-#' \dontrun{ 
+#' \dontrun{
 #' calcOutput("BMIshr")
 #' }
-#' 
+#'
 #' @importFrom magclass getRegions dimSums
 
-calcBMIshr <- function(convert=TRUE){
-
+calcBMIshr <- function(convert = TRUE) {
   ### Adult
-  
-  x<-readSource("NCDrisc",subtype="BMI_shr",convert=FALSE)
-  mapping <- toolGetMapping(type = "sectoral", name = "NCDriscBMIshr2Lutz.csv")
-  x<-toolAggregate(x,rel = mapping,from = "NCDrisc",to = "lutz",dim = 3.1)
-  mapping <- toolGetMapping(type = "sectoral", name = "BMIgroup_adultBMI.csv")
-  adult<-toolAggregate(x,rel = mapping,from = "adultBMI",to = "BMIgroup",dim = 3.3,weight = NULL,partrel = TRUE)  
-  
+
+  x <- readSource("NCDrisc", subtype = "BMI_shr", convert = FALSE)
+  mapping <- toolGetMapping(type = "sectoral", name = "NCDriscBMIshr2Lutz.csv", where = "mappingfolder")
+  x <- toolAggregate(x, rel = mapping, from = "NCDrisc", to = "lutz", dim = 3.1)
+  mapping <- toolGetMapping(type = "sectoral", name = "BMIgroup_adultBMI.csv", where = "mappingfolder")
+  adult <- toolAggregate(x, rel = mapping, from = "adultBMI", to = "BMIgroup", dim = 3.3, weight = NULL, partrel = TRUE)
+
   ### underaged
-  
-  x<-readSource("NCDrisc",subtype="BMI_shr_underaged",convert=FALSE)
-  
+
+  x <- readSource("NCDrisc", subtype = "BMI_shr_underaged", convert = FALSE)
+
   ### aggregate to age groups, use age 5 for 0--4
-  relevant=c("age5", "age6", "age7", "age8", "age9", "age10", "age11", "age12", "age13", "age14")
-
-  x<-x[,,relevant]
-  weight<-x*0+1  ### assume equal weighting within age groups
-  mapping <- toolGetMapping(type = "sectoral", name = "NCDrisc2Lutz.csv")
-  x<-toolAggregate(x,rel = mapping,from = "NCDrisc",to = "lutz",dim = 3.1,weight = weight,partrel = TRUE)  
-  mapping <- toolGetMapping(type = "sectoral", name = "BMIgroup_underagedBMI.csv")
-  x<-toolAggregate(x,rel = mapping,from = "underagedBMI",to = "BMIgroup",dim = 3.3,weight = NULL,partrel = TRUE)  
-  underaged<-add_columns(x,addnm = c(  "mediumhigh"),dim=3.3)
-  underaged[,,c( "mediumhigh")]=0
-  ### 
-
-  out<-mbind(adult,underaged)
-  out<-out[,,getNames(adult,dim=3)] ###right order
-
-  if (convert==TRUE) {
-    BMI<-out
-    withdata <- getRegions(BMI)
-    BMI2<-toolCountryFill(BMI,fill = NA)
-    BMI2<-add_columns(BMI2,dim = 2.1,addnm = c("y1965","y1970"))
-    BMI2<-BMI2[,sort(getYears(BMI2)),]
-
-    regression<-readSource("Bodirsky2018",convert = FALSE)
-
-    gdp_pc <- collapseNames(calcOutput("GDPpc", naming = "scenario" , aggregate = FALSE)[,,"SSP2"])
-
-    bmi_regr=collapseNames(regression[,,"intercept"]+regression[,,"saturation"]*gdp_pc/(regression[,,"halfsaturation"]+gdp_pc))
-    bmi_regr=time_interpolate(bmi_regr,interpolated_year = getYears(BMI2),integrate_interpolated_years = FALSE)
-
-    mapping <- toolGetMapping(type = "sectoral", name = "Lutz2agegroups.csv")
-
-
-    BMI2<-BMI2*NA
-
-    for(agegroup in c("underaged","working","retired")){
-      ages=mapping[mapping$agegroups==agegroup,1]
-      BMI2[,,"verylow"][,,ages] =     bmi_regr[,,agegroup][,,"low"] * bmi_regr[,,agegroup][,,"lowsplit"]
-      BMI2[,,"low"][,,ages] =  bmi_regr[,,agegroup][,,"low"] * (1-bmi_regr[,,agegroup][,,"lowsplit"])
-      BMI2[,,"medium"][,,ages] =  (1-bmi_regr[,,agegroup][,,"low"] - bmi_regr[,,agegroup][,,"high"]) * (1-bmi_regr[,,agegroup][,,"mediumsplit"])
-      BMI2[,,"mediumhigh"][,,ages] =  (1-bmi_regr[,,agegroup][,,"low"] - bmi_regr[,,agegroup][,,"high"]) * (bmi_regr[,,agegroup][,,"mediumsplit"])
-      BMI2[,,"high"][,,ages] =  bmi_regr[,,agegroup][,,"high"] * (1-bmi_regr[,,agegroup][,,"highsplit"])
-      BMI2[,,"veryhigh"][,,ages] =  bmi_regr[,,agegroup][,,"high"] * bmi_regr[,,agegroup][,,"highsplit"]
+  relevant <- c("age5", "age6", "age7", "age8", "age9", "age10", "age11", "age12", "age13", "age14")
+
+  x <- x[, , relevant]
+  weight <- x * 0 + 1  ### assume equal weighting within age groups
+  mapping <- toolGetMapping(type = "sectoral", name = "NCDrisc2Lutz.csv", where = "mappingfolder")
+  x <- toolAggregate(x, rel = mapping, from = "NCDrisc", to = "lutz", dim = 3.1, weight = weight, partrel = TRUE)
+  mapping <- toolGetMapping(type = "sectoral", name = "BMIgroup_underagedBMI.csv", where = "mappingfolder")
+  x <- toolAggregate(x, rel = mapping, from = "underagedBMI", to = "BMIgroup", dim = 3.3, weight = NULL, partrel = TRUE)
+  underaged <- add_columns(x, addnm = c("mediumhigh"), dim = 3.3)
+  underaged[, , c("mediumhigh")] <- 0
+  ###
+
+  out <- mbind(adult, underaged)
+  out <- out[, , getNames(adult, dim = 3)] ### right order
+
+  if (convert) {
+    bmi <- out
+    withdata <- getItems(bmi, 1.1)
+    bmi2 <- toolCountryFill(bmi, fill = NA)
+    bmi2 <- add_columns(bmi2, dim = 2.1, addnm = c("y1965", "y1970"))
+    bmi2 <- bmi2[, sort(getYears(bmi2)), ]
+
+    regression <- readSource("Bodirsky2018", convert = FALSE)
+
+    gdpPC <- collapseNames(calcOutput("GDPpc", naming = "scenario", aggregate = FALSE)[, , "SSP2"])
+
+    bmiRegr <- collapseNames(regression[, , "intercept"]
+                             + regression[, , "saturation"] * gdpPC / (regression[, , "halfsaturation"] + gdpPC))
+    bmiRegr <- time_interpolate(bmiRegr, interpolated_year = getYears(bmi2), integrate_interpolated_years = FALSE)
+
+    mapping <- toolGetMapping(type = "sectoral", name = "Lutz2agegroups.csv", where = "mappingfolder")
+
+
+    bmi2 <- bmi2 * NA
+
+    for (agegroup in c("underaged", "working", "retired")) {
+      ages <- mapping[mapping$agegroups == agegroup, 1]
+      bmi2[, , "verylow"][, , ages] <- bmiRegr[, , agegroup][, , "low"] * bmiRegr[, , agegroup][, , "lowsplit"]
+      bmi2[, , "low"][, , ages] <- bmiRegr[, , agegroup][, , "low"] * (1 - bmiRegr[, , agegroup][, , "lowsplit"])
+      bmi2[, , "medium"][, , ages] <- ((1 - bmiRegr[, , agegroup][, , "low"] - bmiRegr[, , agegroup][, , "high"])
+                                       * (1 - bmiRegr[, , agegroup][, , "mediumsplit"]))
+      bmi2[, , "mediumhigh"][, , ages] <- ((1 - bmiRegr[, , agegroup][, , "low"] - bmiRegr[, , agegroup][, , "high"])
+                                           * (bmiRegr[, , agegroup][, , "mediumsplit"]))
+      bmi2[, , "high"][, , ages] <- bmiRegr[, , agegroup][, , "high"] * (1 - bmiRegr[, , agegroup][, , "highsplit"])
+      bmi2[, , "veryhigh"][, , ages] <- bmiRegr[, , agegroup][, , "high"] * bmiRegr[, , agegroup][, , "highsplit"]
     }
 
-    calib<-BMI[,"y1975",]-BMI2[withdata,"y1975",]
-
-    BMI2[withdata,getYears(BMI),]<-BMI[withdata,getYears(BMI),]
-
-    BMI2[withdata,c("y1965","y1970"),]=BMI2[withdata,c("y1965","y1970"),]+setYears(calib,NULL)
-    # in case that calibration created negative values or values above one, remove them and add them to the middle category
-    BMI2[BMI2<0]=0.000001
-    BMI2[BMI2>1]=1
-    BMI2[,, "medium" ]= BMI2[,, "medium" ] + (1-dimSums(BMI2,dim=3.3))
-
-    out<-BMI2   
-
+    calib <- bmi[, "y1975", ] - bmi2[withdata, "y1975", ]
+
+    bmi2[withdata, getYears(bmi), ] <- bmi[withdata, getYears(bmi), ]
+
+    bmi2[withdata, c("y1965", "y1970"), ] <- bmi2[withdata, c("y1965", "y1970"), ] + setYears(calib, NULL)
+    # in case that calibration created negative values or values above one,
+    # remove them and add them to the middle category
+    bmi2[bmi2 < 0] <- 0.000001
+    bmi2[bmi2 > 1] <- 1
+    bmi2[, , "medium"] <- bmi2[, , "medium"] + (1 - dimSums(bmi2, dim = 3.3))
+
+    out <- bmi2
+
   }
-  
-  weight <- collapseNames(calcOutput("Demography",aggregate=FALSE,education=FALSE)[,,"SSP2"])
-  weight<-time_interpolate(weight,interpolated_year = getYears(out),extrapolation_type = "constant")
-
-  return(list(x=out,
-              weight=weight,
-              unit="capita/capita",
-              description="Share of population belonging to a BMI group.",
-              isocountries=convert))
+
+  weight <- collapseNames(calcOutput("Demography", aggregate = FALSE, education = FALSE)[, , "SSP2"])
+  weight <- time_interpolate(weight, interpolated_year = getYears(out), extrapolation_type = "constant")
+
+  return(list(x = out,
+              weight = weight,
+              unit = "capita/capita",
+              description = "Share of population belonging to a BMI group.",
+              isocountries = convert))
 }

R/calcExoTcDummy.R

@@ -9,10 +9,11 @@
 #' @importFrom utils read.csv2
 
 calcExoTcDummy <- function() {
-  isoCountry  <- toolGetMapping("iso_country.csv")
+  isoCountry  <- toolGetMapping("iso_country.csv", where = "mrland")
   isoCountry1 <- as.vector(isoCountry[, "x"])
   names(isoCountry1) <- isoCountry[, "X"]
-  x <- new.magpie(cells_and_regions = isoCountry1, years = seq(1995, 2150, by = 5), names = c("crop", "pastr"), fill = 0)
+  x <- new.magpie(cells_and_regions = isoCountry1, years = seq(1995, 2150, by = 5),
+                  names = c("crop", "pastr"), fill = 0)
 
   return(list(x = x,
               weight = NULL,

R/calcPlantationContribution.R

@@ -15,9 +15,9 @@
 #' @export
 
 calcPlantationContribution <- function() {
-
   ## Read Share from source
-  out <- mbind(readSource("TimberShare", subtype = "abare", convert = TRUE), readSource("TimberShare", subtype = "brown", convert = TRUE))
+  out <- mbind(readSource("TimberShare", subtype = "abare", convert = TRUE),
+               readSource("TimberShare", subtype = "brown", convert = TRUE))
 
   out <- setYears(out, "y1995")
 
@@ -31,33 +31,34 @@ calcPlantationContribution <- function() {
   short <- paste0("y", seq(2025, 2050, 5))
   long  <- paste0("y", seq(2055, 2250, 5))
 
-  out <- time_interpolate(dataset = out, interpolated_year = year, integrate_interpolated_years = TRUE, extrapolation_type = "constant")
+  out <- time_interpolate(dataset = out, interpolated_year = year, integrate_interpolated_years = TRUE,
+                          extrapolation_type = "constant")
   out <- add_dimension(x = out, dim = 3.2, nm = scen)
 
-  out_scen <- out[, , "constant", invert = TRUE]
+  outScen <- out[, , "constant", invert = TRUE]
 
   mods <- str_extract_all(scen, "\\d+")
   names(mods) <- scen
 
-  for (i in getNames(out_scen, dim = "new")) {
+  for (i in getNames(outScen, dim = "new")) {
     for (j in 2:length(year)) {
-      present <- getYears(out_scen)[j]
-      past    <- getYears(out_scen)[j - 1]
+      present <- getYears(outScen)[j]
+      past    <- getYears(outScen)[j - 1]
 
-      scen_pattern <- mods[[i]]
+      scenPattern <- mods[[i]]
       multiplier <- c((1 + as.numeric(mods[[i]]) / 100))
 
-      if (length(grep(pattern = "0", x = scen_pattern, value = TRUE)) > 0) {
-        pos <- match(grep(pattern = "0", x = scen_pattern, value = TRUE), scen_pattern)
-        multiplier[pos] <- (1 + as.numeric(grep(pattern = "0", x = scen_pattern, value = TRUE)) / 1000)
+      if (length(grep(pattern = "0", x = scenPattern, value = TRUE)) > 0) {
+        pos <- match(grep(pattern = "0", x = scenPattern, value = TRUE), scenPattern)
+        multiplier[pos] <- (1 + as.numeric(grep(pattern = "0", x = scenPattern, value = TRUE)) / 1000)
       }
 
-      if (present %in% hist) out_scen[, present, i] <- setYears(out_scen[, past, i], NULL) * multiplier[1]
-      if (present %in% short) out_scen[, present, i] <- setYears(out_scen[, past, i], NULL) * multiplier[2]
-      if (present %in% long) out_scen[, present, i] <- setYears(out_scen[, past, i], NULL) * multiplier[3]
+      if (present %in% hist) outScen[, present, i] <- setYears(outScen[, past, i], NULL) * multiplier[1]
+      if (present %in% short) outScen[, present, i] <- setYears(outScen[, past, i], NULL) * multiplier[2]
+      if (present %in% long) outScen[, present, i] <- setYears(outScen[, past, i], NULL) * multiplier[3]
     }
   }
-  out[, , getNames(out_scen)] <- out_scen
+  out[, , getNames(outScen)] <- outScen
   out[, length(year) + 1, ] <- out[, length(year), ]
   out[out > 1] <- 1
   out <- round(out, 3)
@@ -68,13 +69,13 @@ calcPlantationContribution <- function() {
 
   ## Find standard mapping - which countries belong to REF and JPN in standard mapping -
   ## we will modify ISO codes here so that this works with all mappings
-  h12_mapping <- toolGetMapping(type = "regional", name = "h12.csv")
-  JPN <- h12_mapping[h12_mapping$RegionCode == "JPN", ]$CountryCode
-  REF <- h12_mapping[h12_mapping$RegionCode == "REF", ]$CountryCode
-  EUR <- h12_mapping[h12_mapping$RegionCode == "EUR", ]$CountryCode
-  out[JPN, , ] <- 0.00001
-  out[REF, , ] <- 0.01
-  out[EUR, , ] <- out[EUR, , ] * 3
+  h12mapping <- toolGetMapping(type = "regional", name = "regionmappingH12.csv", where = "madrat")
+  jpn <- h12mapping[h12mapping$RegionCode == "JPN", ]$CountryCode
+  ref <- h12mapping[h12mapping$RegionCode == "REF", ]$CountryCode
+  eur <- h12mapping[h12mapping$RegionCode == "EUR", ]$CountryCode
+  out[jpn, , ] <- 0.00001
+  out[ref, , ] <- 0.01
+  out[eur, , ] <- out[eur, , ] * 3
   ## WARNING : (DO NOT CHANGE 0.01 value in REF to any value lower than this as
   ## this will result in wrong plantation establishment in REF and would need
   ## adjustment in establishment calibration factors - currently 0.05 for REF)
@@ -85,9 +86,8 @@ calcPlantationContribution <- function() {
   weight <- collapseNames(calcOutput("TimberDemand", aggregate = FALSE)[, "y1995", "production"])[, , c("Roundwood")]
 
   return(list(x = out,
-    weight = weight,
-    min = 0,
-    unit = "percent",
-    description = "Calculates the share of roundwood production coming from timber plantations"))
-
+              weight = weight,
+              min = 0,
+              unit = "percent",
+              description = "Calculates the share of roundwood production coming from timber plantations"))
 }

R/calcPlantedForest.R

@@ -13,26 +13,25 @@
 #' @export
 
 calcPlantedForest <- function() {
-
   ## Read land area frpom source
   a <- readSource("FRA2020", "forest_area")
-  planted_share <- setNames(round(a[, , "plantationForest"], 3) / round(a[, , "plantedForest"], 3), NULL)
-  planted_share[is.na(planted_share)] <- 0
-  out <- setYears(planted_share[, "y2000", ], NULL)
+  plantedShare <- setNames(round(a[, , "plantationForest"], 3) / round(a[, , "plantedForest"], 3), NULL)
+  plantedShare[is.na(plantedShare)] <- 0
+  out <- setYears(plantedShare[, "y2000", ], NULL)
 
   ## Change EUR values - See Forestry GMD paper review from Pekka Lauri
-  mag_iso_reg <- toolGetMapping(type = "regional", name = "h12.csv")
-  reg_eur <- mag_iso_reg$CountryCode[mag_iso_reg$RegionCode == "EUR"]
-  out[reg_eur, , ] <- out[reg_eur, , ] * 3
-  out[reg_eur, , ][out[reg_eur, , ] > 1] <- 1
+  magIsoReg <- toolGetMapping(type = "regional", name = "regionmappingH12.csv", where = "madrat")
+  regEur <- magIsoReg$CountryCode[magIsoReg$RegionCode == "EUR"]
+  out[regEur, , ] <- out[regEur, , ] * 3
+  out[regEur, , ][out[regEur, , ] > 1] <- 1
 
   ## Weight
   weight <- setYears(setNames(round(a[, "y2000", "plantedForest"], 3), NULL), NULL)
 
   return(list(x = out,
-    weight = weight,
-    min = 0,
-    unit = "share",
-    description = "Calculates the share of plantation forest in planted forest"))
+              weight = weight,
+              min = 0,
+              unit = "share",
+              description = "Calculates the share of plantation forest in planted forest"))
 
 }

R/calcPumpingCosts.R

@@ -6,28 +6,26 @@
 #' @importFrom magclass new.magpie
 #' @importFrom utils read.csv2
 #' @examples
-#'
 #' \dontrun{
 #' calcOutput("PumpingCosts")
 #' }
 #'
+calcPumpingCosts <- function() {
 
-  calcPumpingCosts <- function() {
-
-    isoCountry  <- toolGetMapping("iso_country.csv")
-    isoCountry1 <- as.vector(isoCountry[, "x"])
-    names(isoCountry1) <- isoCountry[, "X"]
-    x <- new.magpie(cells_and_regions = isoCountry1, years = seq(1995, 2100, by = 5), names = NULL, fill = 0)
+  isoCountry  <- toolGetMapping("iso_country.csv", where = "mrland")
+  isoCountry1 <- as.vector(isoCountry[, "x"])
+  names(isoCountry1) <- isoCountry[, "X"]
+  x <- new.magpie(cells_and_regions = isoCountry1, years = seq(1995, 2100, by = 5), names = NULL, fill = 0)
 
-    #Assigning a value of 0.005 cents for India
-    x["IND", , ] <- 0.005
+  # Assigning a value of 0.005 cents for India
+  x["IND", , ] <- 0.005
 
-    weight <- x
-    weight[, , ] <- 1
+  weight <- x
+  weight[, , ] <- 1
 
   return(list(x            = x,
               weight       = weight,
               unit         = "USD per million cubic meters",
               description  = "costs of pumping irrigation water from Cornish et.al., 2004"))
 
-  }
+}