spread mapping accross calc functions

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '343891697655'
+ValidationKey: '343944004404'
 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.174.2.9005
-date-released: '2024-01-09'
+version: 0.174.2.9006
+date-released: '2024-01-12'
 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.174.2.9005
-Date: 2024-01-09
+Version: 0.174.2.9006
+Date: 2024-01-12
 Authors@R: c(
     person("Lavinia", "Baumstark", , "lavinia@pik-potsdam.de", role = c("aut", "cre")),
     person("Renato", "Rodrigues", role = "aut"),
@@ -81,4 +81,4 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 LazyData: no
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0

R/calcFEdemand.R

@@ -4,7 +4,6 @@
 #'
 #' @param use_ODYM_RECC per-capita pathways for `SDP_xx` scenarios?  (Defaults
 #'   to `FALSE`.)
-#'
 #' @importFrom assertr assert not_na verify
 #' @importFrom data.table :=
 #' @importFrom dplyr anti_join arrange as_tibble between bind_rows case_when
@@ -83,7 +82,7 @@ calcFEdemand <- function(use_ODYM_RECC = FALSE) {
 
       SSA_countries <- read_delim(
         file = toolGetMapping(type = 'regional', name = 'regionmappingH12.csv',
-        returnPathOnly = TRUE, where = "mappingfolder"),
+                              returnPathOnly = TRUE, where = "mappingfolder"),
         delim = ';',
         col_names = c('country', 'iso3c', 'region'),
         col_types = 'ccc',
@@ -106,7 +105,7 @@ calcFEdemand <- function(use_ODYM_RECC = FALSE) {
           # no reduction for SSA countries before 2050, to allow for more
           # equitable industry and infrastructure development
           f = cumprod(ifelse(2020 > year, 1, pmin(cutoff, 1 + 4*epsilon*((sgma/GDPpC)^exp1 - (sgma/GDPpC)^exp2))
-                             ))) %>%
+          ))) %>%
         ungroup() %>%
         select(-GDPpC) %>%
         filter(year %in% years)
@@ -182,93 +181,26 @@ calcFEdemand <- function(use_ODYM_RECC = FALSE) {
         return()
     }
 
-    # Data Processing ----
-
-    stationary <- readSource("Stationary")
-    buildings  <- readSource("EdgeBuildings", subtype = "FE")
-
-    # all 2016 values are zero
-    # TODO: RH please revisit this # nolint
-    buildings <- buildings[, 2016, invert = TRUE]
-
-    # aggregate to 5-year averages to suppress volatility
-    buildings <- toolAggregateTimeSteps(buildings)
-    stationary <- toolAggregateTimeSteps(stationary)
-
-    buildings <- mselect(buildings, rcp = "fixed", collapseNames = TRUE)
-
-    # extrapolate years missing in buildings, but existing in stationary
-    misingYearsBuildings <- setdiff(getYears(stationary), getYears(buildings))
-    buildings <- time_interpolate(buildings,
-                                  interpolated_year = misingYearsBuildings,
-                                  integrate_interpolated_years = TRUE,
-                                  extrapolation_type = "constant")
-
-    data <- mbind(stationary, buildings)
+    # TODO: move stationary fix to transport
 
+    feBuildings <- calcOutput("FeDemandBuildings", subtype = "FE", warnNA = FALSE, aggregate = FALSE)
     feIndustry <- calcOutput("FeDemandIndustry", warnNA = FALSE, aggregate = FALSE)
+    feTransport <- calcOutput("FeDemandTransport", warnNA = FALSE, aggregate = FALSE)
 
-    data <- mbind(data[ , , getNames(feIndustry), invert = TRUE], feIndustry)
 
-    # Prepare Mapping ----
+    # add up industry and buildings contributions to stationary
+    stationaryItems <- c("fehes", "feh2s")
+    feStationary <- feIndustry[, , stationaryItems] + feBuildings[, , stationaryItems]
 
-    mapping = toolGetMapping(type = "sectoral", name = "structuremappingIO_outputs.csv", where = "mappingfolder")
-
-    # add total buildings electricity demand: feelb = feelcb + feelhpb + feelrhb
-
-    mapping <- rbind(
-      mapping,
-      mapping %>%
-        filter(.data$REMINDitems_out %in% c("feelcb", "feelhpb", "feelrhb")) %>%
-        mutate(REMINDitems_out = "feelb")
+    remind <- mbind(
+      feBuildings[, , stationaryItems, invert = T],
+      feIndustry[, , stationaryItems, invert = T],
+      feStationary,
+      feTransport
     )
 
-    mapping <- mapping %>%
-      select("EDGEitems", "REMINDitems_out", "weight_Fedemand") %>%
-      na.omit() %>%
-      filter(.data$EDGEitems %in% getNames(data, dim = "item")) %>%
-      filter(!.data$REMINDitems_out %in% c("ueelTt", "ueLDVt", "ueHDVt")) %>%
-      distinct()
-
-
-
-    # TODO: not all industry / buildings items ate in mapping (REMIND_out)
-    # if (length(setdiff(getNames(data, dim = "item"), mapping$EDGEitems) > 0)) {
-    #   stop("Not all EDGE items are in the mapping")
-    # }
-
-    # Apply Mapping ----
-
-    remind <- new.magpie(cells_and_regions = getItems(data, dim = 1),
-                         years = getYears(data),
-                         names = cartesian(getNames(data, dim = "scenario"), unique(mapping$REMINDitems_out)),
-                         sets = getSets(data))
-
-    for (v in unique(mapping$REMINDitems_out)) {
-
-      w <- mapping %>%
-        filter(.data$REMINDitems_out == v) %>%
-        select(-"REMINDitems_out") %>%
-        as.magpie()
-
-      tmp <- mselect(data, item = getNames(w)) * w
-
-      tmp <- dimSums(tmp, dim = "item", na.rm = TRUE) %>%
-        add_dimension(dim = 3.3, add = "item", nm = v)
-
-      remind[, , getNames(tmp)] <- tmp
-    }
-
-    # change the scenario names for consistency with REMIND sets
-    getNames(remind) <- gsub("^SSP", "gdp_SSP", getNames(remind))
-    getNames(remind) <- gsub("SDP", "gdp_SDP", getNames(remind))
-
-
     ######################
 
-    # TODO: add calcFeDemand Buildings with FE only
-
-    years <- getYears(data)
     subtype <- "FE"
 
     if ('FE' == subtype) {
@@ -315,7 +247,7 @@ calcFEdemand <- function(use_ODYM_RECC = FALSE) {
         complete(t = c(1993:2015, 2041:2150), fill = list(f = 1)) %>%
         arrange(!!sym('t')) %>%
         mutate(f = cumprod(!!sym('f'))) %>%
-        filter(t %in% getYears(data, as.integer = TRUE)) %>%
+        filter(t %in% getYears(remind, as.integer = TRUE)) %>%
         ungroup() %>%
         select(-'IEIR', -'FEIR')
 
@@ -343,15 +275,14 @@ calcFEdemand <- function(use_ODYM_RECC = FALSE) {
         as.quitte() %>%
         as.magpie()
 
-      feTransport <- calcOutput("FeDemandTransport", warnNA = FALSE, aggregate = FALSE)
-      feIndustryModifications <- addSDP_industry(remind)
+
+      feIndustryModifications <- addSDP_industry(remind) # TODO
 
       # delete punk SDP data calculated illicitly in readEDGE('FE_stationary')
       remind <- mbind(
-        remind[,,setdiff(getNames(remind),
+        remind[,,setdiff(getNames(remind), # TODO
                               getNames(feIndustryModifications))],
-        feIndustryModifications,
-        feTransport)
+        feIndustryModifications)
 
       ## calculate *real* useful (i.e., motive) energy instead of
       ## fossil-fuel equivalents for light- and heavy-duty vehicles
@@ -585,7 +516,7 @@ calcFEdemand <- function(use_ODYM_RECC = FALSE) {
             unique(industry_subsectors_material_relative_change$scenario))) %>%
           interpolate_missing_periods_(
             periods = list(
-              year = unique(pmax(as.integer(sub('y', '', years, fixed = TRUE)),
+              year = unique(pmax(getYears(remind, as.integer = TRUE),
                                  min(.$year)))),
             expand.values = TRUE)
       }

R/calcFeDemandBuildings.R

@@ -1,11 +1,11 @@
 #' Returns the EDGE-Buildings data at the REMIND level
 #'
-#' @param subtype FE_buildings or UE_buildings
+#' @param subtype FE, FE_buildings or UE_buildings
 #'
 #' @author Robin Hasse, Falk Benke
 calcFeDemandBuildings <- function(subtype) {
 
-  if (!subtype %in% c("FE_buildings", "UE_buildings")) {
+  if (!subtype %in% c("FE", "FE_buildings", "UE_buildings")) {
     stop(paste0("Unsupported subtype: ", subtype))
   }
 
@@ -22,13 +22,18 @@ calcFeDemandBuildings <- function(subtype) {
   buildings <- toolAggregateTimeSteps(buildings)
   stationary <- toolAggregateTimeSteps(stationary)
 
-  # rename RCP scenarios in buildings
-  rcps <- paste0("rcp", gsub("p", "", getItems(buildings, "rcp")))
-  rcps <- gsub("rcpfixed", "none", rcps)
-  getItems(buildings, "rcp") <- rcps
-
-  # expand stationary to all RCP scenarios
-  stationary <- toolAddDimensions(x = stationary, dimVals = rcps, dimName = "rcp", dimCode = 3.2)
+  if (subtype == "FE") {
+    # drop RCP dimension (use fixed RCP)
+    buildings <- mselect(buildings, rcp = "fixed", collapseNames = TRUE)
+  } else {
+    # rename RCP scenarios in buildings
+    rcps <- paste0("rcp", gsub("p", "", getItems(buildings, "rcp")))
+    rcps <- gsub("rcpfixed", "none", rcps)
+    getItems(buildings, "rcp") <- rcps
+
+    # expand stationary to all RCP scenarios
+    stationary <- toolAddDimensions(x = stationary, dimVals = rcps, dimName = "rcp", dimCode = 3.2)
+  }
 
   # extrapolate years missing in buildings, but existing in stationary
   misingYearsBuildings <- setdiff(getYears(stationary), getYears(buildings))
@@ -37,11 +42,12 @@ calcFeDemandBuildings <- function(subtype) {
                                 integrate_interpolated_years = TRUE,
                                 extrapolation_type = "constant")
 
-  data <- mbind(stationary[, getYears(stationary), ], buildings[, getYears(stationary), ])
+  data <- mbind(stationary, buildings)
 
   # Prepare Mapping ----
 
-  mapping <- toolGetMapping(type = "sectoral", name = "structuremappingIO_outputs.csv", where = "mappingfolder")
+  mapping <- toolGetMapping(type = "sectoral", name = "structuremappingIO_outputs.csv",
+                            where = "mappingfolder")
 
   # add total buildings electricity demand: feelb = feelcb + feelhpb + feelrhb
 
@@ -62,24 +68,37 @@ calcFeDemandBuildings <- function(subtype) {
     stop("Not all EDGE items are in the mapping")
   }
 
-  remindVars <- filter(mapping, grepl("^fe..b$|^feel..b$|^feelcb$", .data$REMINDitems_out))
-  remindVars <- unique(remindVars$REMINDitems_out)
-
-  # extend mapping for Useful Energy
+  if (subtype == "FE") {
 
-  if (subtype == "UE_buildings") {
+    # REMIND variables in focus: those ending with b and stationary items not in industry focus
     mapping <- mapping %>%
-      mutate(EDGEitems = gsub("_fe$", "_ue", .data[["EDGEitems"]]),
-             REMINDitems_out = gsub("^fe", "ue", .data[["REMINDitems_out"]])) %>%
-      rbind(mapping)
-    remindVars <- gsub("^fe", "ue", remindVars)
+      filter(grepl("b$", .data$REMINDitems_out) |
+               (grepl("s$", .data$REMINDitems_out)) & !grepl("fe(..i$|ind)", .data$EDGEitems))
+    remindVars <- unique(mapping$REMINDitems_out)
+    remindDims <- cartesian(getNames(data, dim = "scenario"), remindVars)
+
+  } else {
+
+    remindVars <- filter(mapping, grepl("^fe..b$|^feel..b$|^feelcb$", .data$REMINDitems_out))
+    remindVars <- unique(remindVars$REMINDitems_out)
+    remindDims <- cartesian(getNames(data, dim = "scenario"), rcps, remindVars)
+
+    # extend mapping for Useful Energy
+
+    if (subtype == "UE_buildings") {
+      mapping <- mapping %>%
+        mutate(EDGEitems = gsub("_fe$", "_ue", .data[["EDGEitems"]]),
+               REMINDitems_out = gsub("^fe", "ue", .data[["REMINDitems_out"]])) %>%
+        rbind(mapping)
+      remindVars <- gsub("^fe", "ue", remindVars)
+    }
   }
 
   # Apply Mapping ----
 
   remind <- new.magpie(cells_and_regions = getItems(data, dim = 1),
                        years = getYears(data),
-                       names = cartesian(getNames(data, dim = "scenario"), rcps, remindVars),
+                       names = remindDims,
                        sets = getSets(data))
 
   for (v in remindVars) {
@@ -100,7 +119,10 @@ calcFeDemandBuildings <- function(subtype) {
   # Prepare Output ----
 
   # remove missing NAVIGATE scenarios
-  remind <- remind[, , grep("SSP2EU_(NAV|CAMP)_[a-z]*\\.rcp", getItems(remind, 3), value = TRUE), invert = TRUE]
+  if (subtype %in% c("FE_buildings", "UE_buildings")) {
+    remind <- remind[, , grep("SSP2EU_(NAV|CAMP)_[a-z]*\\.rcp", getItems(remind, 3), value = TRUE),
+                     invert = TRUE]
+  }
 
   # change the scenario names for consistency with REMIND sets
   getNames(remind) <- gsub("^SSP", "gdp_SSP", getNames(remind))
@@ -112,11 +134,13 @@ calcFeDemandBuildings <- function(subtype) {
   }
 
   description <- switch(subtype,
-    FE_buildings = "demand pathways for final energy in buildings and industry in the original file",
+    FE = "final energy demand in buildings and industry (stationary)",
+    FE_buildings = "final energy demand in buildings",
     UE_buildings = "useful energy demand in buildings"
   )
 
   outputStructure <- switch(subtype,
+    FE = "^gdp_(SSP[1-5].*|SDP.*)\\.(fe|ue)",
     FE_buildings = "^gdp_(SSP[1-5]|SDP).*\\..*\\.fe.*b$",
     UE_buildings = "^gdp_(SSP[1-5]|SDP).*\\..*\\.fe.*b$"
   )