Merge pull request pik-piam#337 from fbenke-pik/WEO

Update IEA WEO 2021 data
robinhasse · Jan 11, 2023 · 4787a61 · 4787a61
2 parents d13381a + c66dc01
commit 4787a61
Show file tree

Hide file tree

Showing 8 changed files with 142 additions and 105 deletions.
diff --git a/.buildlibrary b/.buildlibrary
@@ -1,4 +1,4 @@
-ValidationKey: '29315582'
+ValidationKey: '29341005'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

diff --git a/.zenodo.json b/.zenodo.json
@@ -1,6 +1,6 @@
 {
   "title": "mrremind: MadRat REMIND Input Data Package",
-  "version": "0.151.4",
+  "version": "0.151.5",
   "description": "<p>The mrremind packages contains data preprocessing for the\n    REMIND model.<\/p>",
   "creators": [
     {

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: mrremind
 Title: MadRat REMIND Input Data Package
-Version: 0.151.4
-Date: 2023-01-06
+Version: 0.151.5
+Date: 2023-01-10
 Authors@R: c(
     person("Lavinia", "Baumstark", , "[email protected]", role = c("aut", "cre")),
     person("Renato", "Rodrigues", role = "aut"),

diff --git a/NAMESPACE b/NAMESPACE
@@ -116,6 +116,7 @@ importFrom(dplyr,recode)
 importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
 importFrom(dplyr,rename_)
+importFrom(dplyr,rename_all)
 importFrom(dplyr,right_join)
 importFrom(dplyr,row_number)
 importFrom(dplyr,select)

diff --git a/R/calcIEA_WEO_2021.R b/R/calcIEA_WEO_2021.R
@@ -12,15 +12,18 @@
 #' @importFrom stats aggregate
 #' @export
 
-calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) {
+calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) { # nolint
 
   if (!aggregate %in% c("global", "region")) {
     aggregate <- "global"
   }
 
-  mapping <- toolGetMapping("Mapping_IEA_WEO_2021.csv", type = "reportingVariables") %>%
+  mapping <- toolGetMapping("Mapping_IEA_WEO_2021_complete.csv", type = "sectoral") %>%
     filter(!is.na(!!sym("REMIND")), !!sym("REMIND") != "") %>%
-    mutate(!!sym("WEO") := paste0(!!sym("WEO"), " (", !!sym("Unit_WEO"), ")")) %>%
+    mutate(
+      !!sym("WEO") := paste0(!!sym("WEO"), " (", !!sym("Unit_WEO"), ")"), # nolint
+      !!sym("Conversion") := as.numeric(!!sym("Conversion")) # nolint
+    ) %>%
     select("variable" = "WEO", "REMIND", "Conversion", "unit" = "Unit_WEO", "Unit_REMIND")
 
   mapping$variable <- trimws(mapping$variable)
@@ -29,7 +32,8 @@ calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) {
 
   # copy over Stated Policies Scenario for 2010 - 2020 to other scenarios
   for (s in getNames(data, dim = 1)) {
-    data[, c("y2010", "y2019", "y2020"), s] <- data[, c("y2010", "y2019", "y2020"), "Stated Policies Scenario"][, , getNames(data[, , s], dim = 2)]
+    data[, c("y2010", "y2019", "y2020"), s] <-
+      data[, c("y2010", "y2019", "y2020"), "Stated Policies Scenario"][, , getNames(data[, , s], dim = 2)]
   }
 
   data <- as.data.frame(data) %>%
@@ -38,8 +42,9 @@ calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) {
       "region" = "Region", "scenario" = "Data1", "variable" = "Data2",
       "year" = "Year", "value" = "Value"
     ) %>%
-    mutate(!!sym("scenario_short") := case_when(
+    mutate(!!sym("scenario_short") := case_when( # nolint
       scenario == "Stated Policies Scenario" ~ "SPS",
+      scenario == "Announced pledges scenario" ~ "APS",
       scenario == "Announced Pledges Scenario" ~ "APS",
       scenario == "Sustainable Development Scenario" ~ "SDS",
       scenario == "Net Zero Emissions by 2050 Scenario" ~ "Net2050"
@@ -53,8 +58,8 @@ calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) {
     filter(!!sym("REMIND") != "") %>%
     mutate(
       !!sym("value") := !!sym("value") * !!sym("Conversion"),
-      !!sym("REMIND") := paste0(!!sym("REMIND"), " (", !!sym("Unit_REMIND"), ")"),
-      !!sym("model") := paste0("IEA WEO 2021 ", !!sym("scenario_short"))
+      !!sym("REMIND") := paste0(!!sym("REMIND"), " (", !!sym("Unit_REMIND"), ")"), # nolint
+      !!sym("model") := paste0("IEA WEO 2021 ", !!sym("scenario_short")) # nolint
     ) %>%
     select("region", "year", "model", "variable" = "REMIND", "value")
 
@@ -64,24 +69,37 @@ calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) {
 
   if (aggregate == "global") {
     x <- add_columns(x, "Cap|Electricity|Biomass|w/o CC (GW)", dim = 3.2)
-    x[, , "Cap|Electricity|Biomass|w/o CC (GW)"] <- x[, , "Cap|Electricity|Biomass (GW)"] - x[, , "Cap|Electricity|Biomass|w/ CC (GW)"]
+    x[, , "Cap|Electricity|Biomass|w/o CC (GW)"] <-
+      x[, , "Cap|Electricity|Biomass (GW)"] - x[, , "Cap|Electricity|Biomass|w/ CC (GW)"]
 
     x <- add_columns(x, "Cap|Electricity|Coal (GW)", dim = 3.2)
-    x[, , "Cap|Electricity|Coal (GW)"] <- x[, , "Cap|Electricity|Coal|w/o CC (GW)"] + x[, , "Cap|Electricity|Coal|w/ CC (GW)"]
+    x[, , "Cap|Electricity|Coal (GW)"] <-
+      x[, , "Cap|Electricity|Coal|w/o CC (GW)"] + x[, , "Cap|Electricity|Coal|w/ CC (GW)"]
 
     x <- add_columns(x, "Cap|Electricity|Solar (GW)", dim = 3.2)
-    x[, , "Cap|Electricity|Solar (GW)"] <- x[, , "Cap|Electricity|Solar|CSP (GW)"] + x[, , "Cap|Electricity|Solar|PV (GW)"]
+    x[, , "Cap|Electricity|Solar (GW)"] <-
+      x[, , "Cap|Electricity|Solar|CSP (GW)"] + x[, , "Cap|Electricity|Solar|PV (GW)"]
 
     x <- add_columns(x, "Cap|Electricity|Fossil (GW)", dim = 3.2)
-    x[, , "Cap|Electricity|Fossil (GW)"] <- x[, , "Cap|Electricity|Fossil|w/o CC (GW)"] + x[, , "Cap|Electricity|Fossil|w/ CC (GW)"]
+    x[, , "Cap|Electricity|Fossil (GW)"] <-
+      x[, , "Cap|Electricity|Fossil|w/o CC (GW)"] + x[, , "Cap|Electricity|Fossil|w/ CC (GW)"]
 
     x <- add_columns(x, "Cap|Electricity|Gas (GW)", dim = 3.2)
-    x[, , "Cap|Electricity|Gas (GW)"] <- x[, , "Cap|Electricity|Gas|w/o CC (GW)"] + x[, , "Cap|Electricity|Gas|w/ CC (GW)"]
+    x[, , "Cap|Electricity|Gas (GW)"] <-
+      x[, , "Cap|Electricity|Gas|w/o CC (GW)"] + x[, , "Cap|Electricity|Gas|w/ CC (GW)"]
 
     x <- add_columns(x, "SE|Electricity|Solar (EJ/yr)", dim = 3.2)
-    x[, , "SE|Electricity|Solar (EJ/yr)"] <- x[, , "SE|Electricity|Solar|PV (EJ/yr)"] + x[, , "SE|Electricity|Solar|CSP (EJ/yr)"]
+    x[, , "SE|Electricity|Solar (EJ/yr)"] <-
+      x[, , "SE|Electricity|Solar|PV (EJ/yr)"] + x[, , "SE|Electricity|Solar|CSP (EJ/yr)"]
   }
 
+  # correct PE|Nuclear and PE
+  # PE Nuclear is usually reported in direct equivalents, values from IEA are
+  # roughly 3 times higher than the REMIND ones
+  x[, , "PE (EJ/yr)"] <- x[, , "PE (EJ/yr)"] - x[, , "PE|Nuclear (EJ/yr)"]
+  x[, , "PE|Nuclear (EJ/yr)"] <- x[, , "PE|Nuclear (EJ/yr)"] / 3
+  x[, , "PE (EJ/yr)"] <- x[, , "PE (EJ/yr)"] + x[, , "PE|Nuclear (EJ/yr)"]
+
   if (isValidation) {
     x <- add_dimension(x, dim = 3.1, add = "scenario", nm = "historical")
   }

diff --git a/R/convertIEA_WEO_2021.R b/R/convertIEA_WEO_2021.R
@@ -6,121 +6,125 @@
 #' @importFrom madrat getISOlist
 #'
 
-convertIEA_WEO_2021 <- function(x, subtype = "global") {
-  PE <- calcOutput("PE", aggregate = FALSE)
+convertIEA_WEO_2021 <- function(x, subtype = "global") { # nolint
+  pe <- calcOutput("PE", aggregate = FALSE)
   if (subtype == "global") {
-
     # for now, we only have complete data on global level
-    x.world <- x["World", , ]
+    xWorld <- x["World", , ]
+
+    # remove all-NA variables
+    remove <- magpply(xWorld, function(y) all(is.na(y)), MARGIN = 3)
+    xWorld <- xWorld[, , !remove]
 
     # to integrate the data in historical.mif, we need to disaggregate to country level
     # the disaggregation is very unprecise and therefore values below global granularity
     # are not reliable
 
-    mapping_world <- tibble(
+    mappingWorld <- tibble(
       regions = "World",
       country = getISOlist()
     )
 
-    weight <- PE[, 2014, "PE (EJ/yr)"]
-    x.world <- toolAggregate(x.world, rel = mapping_world, weight = weight)
-    return(x.world)
+    weight <- pe[, 2014, "PE (EJ/yr)"]
+    xWorld <- toolAggregate(xWorld, rel = mappingWorld, weight = weight)
+    return(xWorld)
   } else if (subtype == "region") {
     .removeNaRegions <- function(x) {
       remove <- magpply(x, function(y) all(is.na(y)), MARGIN = 1)
       return(x[!remove, , ])
     }
 
-    mapping_full <- toolGetMapping("regionmapping_IEA_WEO_2021.csv", type = "regional")
+    mappingFull <- toolGetMapping("regionmapping_IEA_WEO_2021.csv", type = "regional")
 
-    .disaggregate_regions <- function(x_in, regions_in) {
-      x <- .removeNaRegions(x_in)
+    .disaggregateRegions <- function(xIn, regionsIn) {
+      x <- .removeNaRegions(xIn)
 
-      regions <- intersect(regions_in, getItems(x, dim = 1))
+      regions <- intersect(regionsIn, getItems(x, dim = 1))
+
+      if (length(regions) == 0) {
+        return(toolCountryFill(x, fill = NA, verbosity = 2))
+      }
 
-      # iso countries in x
-      ctry <- toolCountry2isocode(getItems(x, dim = 1), warn = FALSE)
-      ctry <- ctry[!is.na(ctry)]
+      # ISO countries in x and the corresponding mapping
+      ctry <- setdiff(getItems(x, dim = 1), regions)
+      mappingCtry <- mappingFull[mappingFull$ISO3.code %in% ctry &
+                                   mappingFull$Region_name %in% regions, ]
 
-      # mapping of regions to iso countries other than in ctry (i.e. other regions)
-      mapping_regions <- mapping_full[mapping_full$Region_name %in% regions &
-        !mapping_full$ISO3.code %in% ctry & mapping_full$ISO3.code != "SUN", ]
+      # subtract country values in x from region values
+      # e.g. USA from North America, if both are in data
+      xSub <- x[mappingCtry$ISO3.code, , ]
+      getItems(xSub, dim = 1) <- mappingCtry$Region_name
+      x[unique(mappingCtry$Region_name), , ] <- x[unique(mappingCtry$Region_name), , ] - dimSums(xSub, dim = 3)
 
-      weight <- PE[mapping_regions$ISO3.code, 2014, "PE (EJ/yr)"]
+      # mapping of regions to ISO countries other than in ctry (i.e. other regions)
+      mappingRegions <- mappingFull[mappingFull$Region_name %in% regions &
+                                      !mappingFull$ISO3.code %in% ctry & mappingFull$ISO3.code != "SUN", ]
+
+      # regions fully covered by country values can be removed
+      coveredRegions <- setdiff(regions, unique(mappingRegions$Region_name))
+
+      if (length(coveredRegions) > 0) {
+        x <- x[coveredRegions, , invert = TRUE]
+        regions <- setdiff(regions, coveredRegions)
+      }
 
-      # disaggregation of other regions to iso countries
-      x2 <- toolAggregate(x[regions, , ], rel = mapping_regions, weight = weight)
+      weight <- pe[mappingRegions$ISO3.code, 2014, "PE (EJ/yr)"]
 
-      # iso countries in x that do not need to be disaggregated
+      # disaggregation of other regions to ISO countries
+      x2 <- toolAggregate(x[regions, , ], rel = mappingRegions, weight = weight)
+
+      # ISO countries in x that do not need to be disaggregated
       x1 <- x[regions, , invert = TRUE]
 
-      if (length(getRegions(x1)) == 0) {
+      if (length(getItems(x1, dim = 1)) == 0) {
         return(toolCountryFill(x2, fill = NA, verbosity = 2))
       }
 
-      getItems(x1, dim = 1) <- toolCountry2isocode(getItems(x1, dim = 1), warn = FALSE)
-
       # combine the two objects
       x <- mbind(x1, x2)
       x <- toolCountryFill(x, fill = NA, verbosity = 2)
 
       return(x)
     }
 
-    # exclude all regions we don't want to disaggregate due to redundancies or lack of accuracy
-    x.reg <- x[c(
+    # exclude all regions we don't want to disaggregate due to redundancies,
+    # low relevance, or lack of accuracy
+    xReg <- x[c(
       "Atlantic Basin", "East of Suez", "NonOPEC", "OPEC", "Japan and Korea",
-      "Southeast Asia", "Other", "European Union", "World"
+      "Southeast Asia", "Other", "European Union", "World",
+      "Advanced economies", "Emerging market and developing economies",
+      "International Energy Agency", "OECD", "Non-OECD",
+      "North Africa", "Sub-Saharan Africa", "Rest of world",
+      "Other Asia Pacific", "Other Europe"
     ), , , invert = TRUE]
 
-    # remove all-na variables
-    remove <- magpply(x.reg, function(y) all(is.na(y)), MARGIN = 3)
-    x.reg <- x.reg[, , !remove]
-
-    # remove 2040 as year, as source has no regional data for this year
-    x.reg <- x.reg[, 2040, , invert = TRUE]
+    # remove all-NA variables
+    remove <- magpply(xReg, function(y) all(is.na(y)), MARGIN = 3)
+    xReg <- xReg[, , !remove]
 
-    regions <- c("Africa", "Asia Pacific", "Central and South America", "Europe",
-                 "Eurasia", "Middle East", "North America")
-
-    x.regional <- NULL
+    regions <- c(
+      "Africa", "Asia Pacific", "Central and South America", "Europe",
+      "Eurasia", "Middle East", "North America"
+    )
+    x1 <- xReg[regions, , ]
 
-    for (i in getNames(x.reg)) {
-      j <- x.reg[, , i]
+    # convert country names to ISO
+    ctry <- toolCountry2isocode(getItems(xReg, dim = 1), warn = FALSE)
+    x2 <- xReg[!is.na(ctry), , ]
+    getItems(x2, dim = 1) <- ctry[!is.na(ctry)]
+    xReg <- mbind(x1, x2)
 
+    xRegional <- NULL
+    for (i in getItems(xReg, dim = 3)) {
+      j <- xReg[, , i]
       j <- .removeNaRegions(j)
-
-      if ("United States" %in% getRegions(j) & "North America" %in% getRegions(j)) {
-        j["North America", , ] <- j["North America", , ] - j["United States", , ]
-      }
-
-      if ("Brazil" %in% getRegions(j) & "Central and South America" %in% getRegions(j)) {
-        j["Central and South America", , ] <- j["Central and South America", , ] - j["Brazil", , ]
-      }
-
-      if ("Japan" %in% getRegions(j) & "Asia Pacific" %in% getRegions(j)) {
-        j["Asia Pacific", , ] <- j["Asia Pacific", , ] - j["Japan", , ]
-      }
-
-      if ("India" %in% getRegions(j) & "Asia Pacific" %in% getRegions(j)) {
-        j["Asia Pacific", , ] <- j["Asia Pacific", , ] - j["India", , ]
-      }
-
-      if ("China" %in% getRegions(j) & "Asia Pacific" %in% getRegions(j)) {
-        j["Asia Pacific", , ] <- j["Asia Pacific", , ] - j["China", , ]
-      }
-
-      if ("Russia" %in% getRegions(j) & "Eurasia" %in% getRegions(j)) {
-        j["Eurasia", , ] <- j["Eurasia", , ] - j["Russia", , ]
-      }
-
-      x.regional <- mbind(x.regional, .disaggregate_regions(x_in = j, regions_in = regions))
+      xRegional <- mbind(xRegional, .disaggregateRegions(xIn = j, regionsIn = regions))
     }
 
-    Non28EUcountries <- c("ALA", "FRO", "GIB", "GGY", "IMN", "JEY")
-    x.regional[Non28EUcountries, , ] <- 0
+    non28EUcountries <- c("ALA", "FRO", "GIB", "GGY", "IMN", "JEY")
+    xRegional[non28EUcountries, , ] <- 0
 
-    return(x.regional)
+    return(xRegional)
   } else {
     stop("Not a valid subtype! Must be either \"region\" or \"global\"")
   }

diff --git a/R/readIEA_WEO_2021.R b/R/readIEA_WEO_2021.R
@@ -3,26 +3,40 @@
 #'
 #' @return A [`magpie`][magclass::magclass] object.
 #' @author Falk Benke
-#' @importFrom dplyr filter %>% distinct group_by ungroup
+#' @importFrom dplyr filter %>% distinct group_by ungroup rename_all
 #' @importFrom rlang sym
-#' 
+#'
+
+readIEA_WEO_2021 <- function() { # nolint
 
-readIEA_WEO_2021 <- function() {
-  variable <- NULL
-
   data <- rbind(
-    read.csv(file = "WEO2021_Free_Data_Regions.csv")  %>% mutate(source := "A"),
-    read.csv(file = "WEO2021_Free_Data_Supply_Refining.csv") %>% mutate(source := "B"),
-    read.csv(file = "WEO2021_Free_Data_World.csv") %>% mutate(source := "C")
-  ) %>% mutate(
-    variable := paste0(!!sym("Category"), "-", !!sym("Product"), "-", !!sym("Flow"), " (", !!sym("Unit"), ")"),
-    year = as.numeric(!!sym("Year"))
-  ) %>% select("Region", "year", "Scenario", "variable", "Value") %>%
-    group_by(!!sym("Region"), !!sym("year"), !!sym("Scenario"), !!sym("variable")) %>%
+    read.csv2(
+      file = "complete/WEO2021_Extended_Data_Regions.csv",
+      sep = ","
+    ) %>% rename_all(tolower),
+    read.csv2(
+      file = "complete/WEO2021_Extended_Data_Supply_Refining_Trade_Prices.csv",
+      sep = ","
+    ) %>% rename_all(tolower),
+    read.csv(
+      file = "complete/WEO2021_Extended_Data_World.csv",
+      sep = ","
+    ) %>% rename_all(tolower)
+  ) %>%
+    mutate(
+      !!sym("value") := ifelse(!!sym("unit") == "PJ", as.numeric(!!sym("value")) / 1000, as.numeric(!!sym("value"))),
+      !!sym("unit") := ifelse(!!sym("unit") == "PJ", "EJ", !!sym("unit")),
+      variable = paste0(!!sym("category"), "-", !!sym("product"), "-", !!sym("flow"), " (", !!sym("unit"), ")"),
+      year = as.numeric(!!sym("year"))
+    ) %>%
+    select("region", "year", "scenario", "variable", "value") %>%
+    group_by(
+      !!sym("region"), !!sym("year"), !!sym("scenario"), !!sym("variable")
+    ) %>%
     distinct() %>%
     ungroup()
-
-  x <- as.magpie(data, temporal = 2, spatial = 1, datacol = 5)
-  x <- magpiesort(x)
 
+  as.magpie(data, temporal = 2, spatial = 1, datacol = 5) %>%
+    magpiesort() %>%
+    return()
 }