filter IEA ETP production data using a custom aggregation function

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '38572284'
+ValidationKey: '384142370'
 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: 'mrremind: MadRat REMIND Input Data Package'
-version: 0.192.9
-date-released: '2024-09-30'
+version: 0.192.10
+date-released: '2024-10-01'
 abstract: The mrremind packages contains data preprocessing for the REMIND model.
 authors:
 - family-names: Baumstark

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mrremind
 Title: MadRat REMIND Input Data Package
-Version: 0.192.9
-Date: 2024-09-30
+Version: 0.192.10
+Date: 2024-10-01
 Authors@R: c(
     person("Lavinia", "Baumstark", , "[email protected]", role = c("aut", "cre")),
     person("Renato", "Rodrigues", role = "aut"),

NAMESPACE

@@ -47,7 +47,6 @@ export(convertUBA)
 export(convertUNFCCC)
 export(convertUNIDO)
 export(convertUSGS)
-export(filter_historical_mif)
 export(fullTHRESHOLDS)
 export(readADVANCE_WP2)
 export(readAGEB)

R/calcIEA_ETP.R

@@ -6,57 +6,110 @@
 #' @author Falk Benke
 #'
 #' @importFrom dplyr select mutate left_join
-#' @importFrom rlang sym
-#' @importFrom stats aggregate na.pass
 #' @export
 
 calcIEA_ETP <- function() {
 
+  .map <- function(x, mapping) {
+
+    data <- as.data.frame(x) %>%
+      as_tibble() %>%
+      select(
+        "region" = "Region", "scenario" = "Data1", "variable" = "Data2",
+        "year" = "Year", "value" = "Value"
+      ) %>%
+      filter(!is.na(.data$value))
+
+    data <- full_join(data, mapping, by = "variable", relationship = "many-to-many") %>%
+      filter(.data$REMIND != "")
+
+    # composite REMIND variables that must be removed from the data,
+    # because we do not have all the components in the IEA data
+    remove <- data %>% filter(is.na(.data$value))
+
+    data <- data %>%
+      filter(!is.na(.data$value),
+             !(.data$REMIND %in% unique(remove$REMIND))) %>%
+      mutate(
+        "value" = .data$value * .data$Conversion,
+        "REMIND" = paste0(.data$REMIND, " (", .data$Unit_REMIND, ")"),
+        "model" = paste0("IEA ETP ", .data$scenario),
+        "year" = as.numeric(as.character(.data$year))
+      ) %>%
+      select("region", "year", "model", "variable" = "REMIND", "value")
+
+    x <- aggregate(value ~ region + year + model + variable, data, sum) %>%
+      as.magpie()
+
+    return(x)
+  }
+
   mapping <- toolGetMapping("Mapping_IEA_ETP.csv", type = "reportingVariables", where = "mrremind") %>%
-    filter(!is.na(!!sym("REMIND")), !!sym("REMIND") != "") %>%
-    mutate("Conversion" = as.numeric(!!sym("Conversion"))) %>%
-    select("variable" = "IEA_ETP", "REMIND", "Conversion", "Unit_REMIND")
-
-  mapping$variable <- trimws(mapping$variable)
-  mapping$REMIND <- trimws(mapping$REMIND)
-
-  x1 <- readSource("IEA_ETP", subtype = "industry")
-  x2 <- readSource("IEA_ETP", subtype = "transport")
-  x3 <- readSource("IEA_ETP", subtype = "buildings")
-  x4 <- readSource("IEA_ETP", subtype = "summary")
-
-  data <- mbind(x1, x2, x3, x4)
-
-  data <- as.data.frame(data) %>%
-    as_tibble() %>%
-    select(
-      "region" = "Region", "scenario" = "Data1", "variable" = "Data2",
-      "year" = "Year", "value" = "Value"
-    )
-
-  x <- left_join(
-    data,
-    mapping,
-    by = "variable",
-    relationship = "many-to-many"
-  ) %>%
-    filter(!!sym("REMIND") != "") %>%
+    filter(!is.na(.data$REMIND), .data$REMIND != "") %>%
     mutate(
-      "value" = !!sym("value") * !!sym("Conversion"),
-      "REMIND" = paste0(!!sym("REMIND"), " (", !!sym("Unit_REMIND"), ")"),
-      "model" = paste0("IEA ETP ", !!sym("scenario")),
-      "year" = as.numeric(as.character(!!sym("year")))
+      "Conversion" = as.numeric(.data$Conversion),
+      "variable" = trimws(.data$IEA_ETP),
+      "REMIND" = trimws(.data$REMIND)
     ) %>%
-    select("region", "year", "model", "variable" = "REMIND", "value")
+    select("variable", "REMIND", "Conversion", "Unit_REMIND")
+
+  xReg <- mbind(
+    readSource("IEA_ETP", subtype = "industry"),
+    readSource("IEA_ETP", subtype = "transport"),
+    readSource("IEA_ETP", subtype = "buildings"),
+    readSource("IEA_ETP", subtype = "summary")
+  )
+
+  dataReg <- .map(xReg, mapping) %>%
+    toolCountryFill(fill = NA, verbosity = 2)
+
+  # set 0s in other CHA countries than China to approximate CHA as China
+  dataReg[c("HKG", "MAC", "TWN"), , ] <- 0
+
+  xGlo <- mbind(
+    readSource("IEA_ETP", subtype = "industry", convert = FALSE)["WORLD", , ],
+    readSource("IEA_ETP", subtype = "transport", convert = FALSE)["WORLD", , ],
+    readSource("IEA_ETP", subtype = "buildings", convert = FALSE)["WORLD", , ],
+    readSource("IEA_ETP", subtype = "summary", convert = FALSE)["WORLD", , ]
+  )
+
+  getItems(xGlo, dim = 1) <- "GLO"
+  dataGlo <- .map(xGlo, mapping)
+
+  # includes global values from the original source instead of calculating
+  # them as the sum of all countries (as countries are incomplete)
+  .customAggregate <- function(x, rel, to = NULL, glo) {
+    x <- toolAggregate(x, rel = rel, to = to)
+
+    if ("GLO" %in% getItems(x, dim = 1)) {
+      out <- new.magpie(
+        cells_and_regions = getItems(x, dim = 1),
+        years = union(getYears(x), getYears(glo)),
+        names = union(getNames(x), getNames(glo)),
+        fill = NA,
+        sets = names(dimnames(x))
+      )
+
+      x <- x["GLO", , , invert = TRUE]
+
+      out[getItems(x, dim = 1), getYears(x), getNames(x)] <- x
+      out["GLO", getYears(glo), getNames(glo)] <- glo
+
+      return(out)
+    } else {
+      return(x)
+    }
+  }
+
+
 
-  x <- aggregate(value ~ region + year + model + variable, x, sum, na.action = na.pass) %>%
-    as.magpie()
 
   return(list(
-    x = x,
+    x = dataReg,
     weight = NULL,
+    aggregationFunction = .customAggregate,
+    aggregationArguments = list(glo = dataGlo),
     unit = c("EJ/yr", "Mt CO2/yr", "Mt/yr", "bn pkm/yr", "bn tkm/yr"),
     description = "IEA ETP projections as REMIND variables"
   ))
-
 }

R/convertIEA_ETP.R

@@ -6,68 +6,28 @@
 #'
 convertIEA_ETP <- function(x, subtype) {
 
-  getItems(x, dim = 1) <- lapply(getItems(x, dim = 1), function(y) ifelse(y == "NonOECD", "Non-OECD", y))
-
-  regmapping <- toolGetMapping("regionmappingIEA_ETP.csv", where = "mappingfolder", type = "regional")
-
+  map <- toolGetMapping("regionmappingIEA_ETP.csv", where = "mrremind", type = "regional")
   fe <- calcOutput("FE", source = "IEA", aggregate = FALSE)
 
-  v <- magpply(x[c("OECD", "Non-OECD"), , , invert = T], function(y) all(is.na(y)), MARGIN = 3)
-  v.oecd.only <- getNames(x[, , v])
-
-  if (is.null(v.oecd.only)) {
-    v.full <- getNames(x)
-  } else {
-    v.full <- getNames(x[, , v.oecd.only, invert = T])
-  }
-
   # disaggregate ASEAN
-  x.asean <- x["ASEAN", , v.full]
-  m <- select(regmapping, c("EEAReg", "CountryCode")) %>% filter(!!sym("EEAReg") == "ASEAN")
+  x.asean <- x["ASEAN", , ]
+  m <- select(map, c("EEAReg", "CountryCode")) %>% filter(.data$EEAReg == "ASEAN")
   w <- fe[m$CountryCode, 2005, "FE|Transport (EJ/yr)"]
   x.asean <- toolAggregate(x.asean, m, from = "EEAReg", to = "CountryCode", weight = w)
 
   # disaggregate European Union
-  x.eu <- x["European Union", , v.full]
-  m <- select(regmapping, c("EEAReg", "CountryCode")) %>% filter(!!sym("EEAReg") == "EUR")
+  x.eu <- x["European Union", , ]
+  m <- select(map, c("EEAReg", "CountryCode")) %>% filter(.data$EEAReg == "EUR")
   w <- fe[m$CountryCode, 2005, "FE|Transport (EJ/yr)"]
   x.eu <- toolAggregate(x.eu, m, from = "EEAReg", to = "CountryCode", weight = w)
 
-  # entries that don't require disaggregation
-  x.ctry <- x[c("Brazil", "China", "India", "Mexico", "Russia", "South Africa", "United States"), , v.full]
-  getItems(x.ctry, dim = 1) <- toolCountry2isocode(getItems(x.ctry, dim = 1), warn = F)
-
-  # disaggregate OECD data for variables with both OECD and finer regional granularity
-  x.oecd.other <- x[c("OECD", "Non-OECD"), , v.full]
-
-  # get OECD/Non-OECD values not accounted for in other regions
-  x.oecd.other["OECD", , ] <- x.oecd.other["OECD", , ] -
-    dimSums(x[c("European Union", "Mexico", "United States"), , v.full], dim = 1)
-  x.oecd.other["Non-OECD", , ] <- x.oecd.other["Non-OECD", , ] -
-    dimSums(x[c("ASEAN", "Brazil", "China", "India", "Russia", "South Africa"), , v.full], dim = 1)
-  m <- select(regmapping, c("OECD", "CountryCode")) %>%
-    filter(!(!!sym("CountryCode") %in% c(getItems(x.asean, dim = 1), getItems(x.eu, dim = 1), getItems(x.ctry, dim = 1))))
-  w <- fe[m$CountryCode, 2005, "FE|Transport (EJ/yr)"]
-  x.oecd.other <- toolAggregate(x.oecd.other, m, from = "OECD", to = "CountryCode", weight = w)
-
-  x.full <- new.magpie(getISOlist(), getYears(x), names = getNames(x), fill = 0)
+  # transform entries that don't require disaggregation
+  x.ctry <- x[c("Brazil", "China", "India", "Mexico", "Russia", "South Africa", "United States"), , ]
+  getItems(x.ctry, dim = 1) <- toolCountry2isocode(getItems(x.ctry, dim = 1), warn = FALSE)
 
-  # for variables with only OECD/nonOECD data we disaggregate this to country-level
-  if (!is.null(v.oecd.only)) {
-    w <- fe[regmapping$CountryCode, 2005, "FE|Transport (EJ/yr)"]
-    x.oecd <- x[c("OECD", "Non-OECD"), , v.oecd.only]
-    x.oecd <- toolAggregate(x.oecd, regmapping, from = "OECD", to = "CountryCode", weight = w)
-    x.full[getItems(x.oecd, dim = 1), , v.oecd.only] <- x.oecd
-  }
 
-  # for variables with OECD/nonOECD data and addtl. region and country data
-  # 1) we disaggregate the more fine-granular regions ASEAN and European Union first
-  # 2) then calculate the values for the OECD/nonOECD regions minus the values for explicitly listed countries/regions
-  # and disaggregate them to the countries not listed explicitly
-  x.full[getItems(x.asean, dim = 1), , v.full] <- x.asean
-  x.full[getItems(x.eu, dim = 1), , v.full] <- x.eu
-  x.full[getItems(x.ctry, dim = 1), , v.full] <- x.ctry
-  x.full[getItems(x.oecd.other, dim = 1), , v.full] <- x.oecd.other
+  x <- mbind(x.asean, x.eu, x.ctry)
+  x <- toolCountryFill(x, fill = NA, verbosity = 2)
 
-  return(x.full)
+  return(x)
 }

R/fullVALIDATIONREMIND.R

@@ -259,7 +259,4 @@ fullVALIDATIONREMIND <- function(rev = 0) {
     try = FALSE, years = years,
     writeArgs = list(scenario = "historical", model = "INDSTAT2")
   )
-
-  # filter variables that are too imprecise on regional level ----
-  filter_historical_mif()
 }

R/readEuropeanEnergyDatasheets.R

@@ -15,7 +15,7 @@
 #' or "EU27" (latest data from August 23 without GBR)
 #' @importFrom tidyr drop_na extract
 #' @importFrom readxl excel_sheets read_excel
-#' @importFrom stats aggregate
+#' @importFrom stats aggregate na.pass
 #'
 readEuropeanEnergyDatasheets <- function(subtype) {
   if (!subtype %in% c("EU27", "EU28")) {

R/readIEA_ETP.R

@@ -19,7 +19,7 @@ readIEA_ETP <- function(subtype) {
         file = "ETP2017_industry_summary.xlsx",
         prefix = "Industry",
         sheets = list(
-          "OECD", "Non-OECD",
+          "WORLD", "OECD", "Non-OECD",
           "ASEAN", "Brazil", "China", "European Union",
           "India", "Mexico", "Russia", "South Africa", "United States"
         ),
@@ -149,7 +149,7 @@ readIEA_ETP <- function(subtype) {
         file = "ETP2017_buildings_summary.xlsx",
         prefix = "Buildings",
         sheets = list(
-          "OECD", "NonOECD",
+          "WORLD", "OECD", "NonOECD",
           "ASEAN", "Brazil", "China", "European Union",
           "India", "Mexico", "Russia", "South Africa", "United States"
         ),
@@ -278,7 +278,7 @@ readIEA_ETP <- function(subtype) {
         file = "ETP2017_scenario_summary.xlsx",
         prefix = "Summary",
         sheets = list(
-          "OECD", "NonOECD",
+          "WORLD", "OECD", "NonOECD",
           "ASEAN", "Brazil", "China", "European Union",
           "India", "Mexico", "Russia", "South Africa", "United States"
         ),
@@ -452,7 +452,7 @@ readIEA_ETP <- function(subtype) {
         file = "ETP2017_transport_summary.xlsx",
         prefix = "Transport",
         sheets = list(
-          "OECD", "Non-OECD",
+          "WORLD", "OECD", "Non-OECD",
           "ASEAN", "Brazil", "China", "European Union",
           "India", "Mexico", "Russia", "South Africa", "United States"
         ),