From 6e767cb88513ad4b42c477aa43ae01d4e6e49959 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 11 Jan 2024 17:57:25 +0100 Subject: [PATCH] spread mapping accross calc functions --- .buildlibrary | 2 +- CITATION.cff | 4 +- DESCRIPTION | 6 +- R/calcFEdemand.R | 107 +++++++---------------------------- R/calcFeDemandBuildings.R | 70 +++++++++++++++-------- R/calcFeDemandIndustry.R | 63 +++++++++++++++++---- R/calcFeDemandTransport.R | 8 ++- README.md | 6 +- man/calcFeDemandBuildings.Rd | 2 +- 9 files changed, 133 insertions(+), 135 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index a3b5bbe8..3bdcc312 100644 --- a/.buildlibrary +++ b/.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' diff --git a/CITATION.cff b/CITATION.cff index 728a33da..f07b9c99 100644 --- a/CITATION.cff +++ b/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 diff --git a/DESCRIPTION b/DESCRIPTION index cb4496b1..e752934f 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/calcFEdemand.R b/R/calcFEdemand.R index 80e73e67..eae1142c 100644 --- a/R/calcFEdemand.R +++ b/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) } diff --git a/R/calcFeDemandBuildings.R b/R/calcFeDemandBuildings.R index a37968be..3fe5f969 100644 --- a/R/calcFeDemandBuildings.R +++ b/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$" ) diff --git a/R/calcFeDemandIndustry.R b/R/calcFeDemandIndustry.R index b31db065..6ceef72e 100644 --- a/R/calcFeDemandIndustry.R +++ b/R/calcFeDemandIndustry.R @@ -10,7 +10,7 @@ calcFeDemandIndustry <- function() { # ---- _ modify Industry FE data to carry on current trends ---- v <- grep("\\.fe(..i$|ind)", getNames(stationary), value = TRUE) - dataInd <- stationary[, , v] %>% + modified <- stationary[, , v] %>% as.quitte() %>% as_tibble() %>% select("scenario", "iso3c" = "region", "pf" = "item", "year" = "period", @@ -25,12 +25,12 @@ calcFeDemandIndustry <- function() { phasein_period <- c(2020, 2050) # FIXME: extend to 2055 to keep 35 yrs? phasein_time <- phasein_period[2] - phasein_period[1] - dataInd <- bind_rows( - dataInd %>% + modified <- bind_rows( + modified %>% filter(phasein_period[1] > !!sym("year")), inner_join( # calculate regional trend - dataInd %>% + modified %>% # get trend period filter(between(!!sym("year"), historic_trend[1], historic_trend[2]), 0 != !!sym("value")) %>% @@ -48,9 +48,9 @@ calcFeDemandIndustry <- function() { # only use negative trends (decreasing energy use) mutate(trend = ifelse(!!sym("trend") < 1, !!sym("trend"), NA)), # modify data projection - dataInd %>% + modified %>% filter(phasein_period[1] <= !!sym("year")) %>% - interpolate_missing_periods(year = phasein_period[1]:max(dataInd$year)) %>% + interpolate_missing_periods(year = phasein_period[1]:max(modified$year)) %>% group_by(!!sym("scenario"), !!sym("iso3c"), !!sym("pf")) %>% mutate(growth = replace_na(!!sym("value") / lag(!!sym("value")), 1)) %>% full_join(regionmapping %>% select(-"country"), "iso3c"), @@ -72,7 +72,7 @@ calcFeDemandIndustry <- function() { !!sym("value"), !!sym("value_"))) %>% ungroup() %>% select(-"region", -"value_", -"trend", -"growth") %>% - filter(!!sym("year") %in% unique(dataInd$year)) + filter(!!sym("year") %in% unique(modified$year)) ) %>% rename("region" = "iso3c", "item" = "pf") %>% as.magpie() @@ -86,16 +86,57 @@ calcFeDemandIndustry <- function() { f <- 0.95^pmax(0, log(f)) # get Industry FE items - v <- grep("^SSP1\\.fe(..i$|ind)", getNames(dataInd), value = TRUE) + v <- grep("^SSP1\\.fe(..i$|ind)", getNames(modified), value = TRUE) # apply changes for (i in 1:length(y)) { if (1 != f[i]) { - dataInd[, y[i], v] <- dataInd[, y[i], v] * f[i] + modified[, y[i], v] <- modified[, y[i], v] * f[i] } } - return(list(x = dataInd, weight = NULL, unit = "EJ", - description = "final energy demand in industry")) + # ---- _ apply mapping ---- + + data <- mbind(stationary[, , getNames(modified), invert = TRUE], modified) + + mapping <- toolGetMapping(type = "sectoral", name = "structuremappingIO_outputs.csv", + where = "mappingfolder") + + mapping <- mapping %>% + select("EDGEitems", "REMINDitems_out", "weight_Fedemand") %>% + na.omit() %>% + filter(.data$EDGEitems %in% getNames(data, dim = "item")) %>% + # REMIND variables in focus: those ending with i and stationary items with industry focus + filter(grepl("i$", .data$REMINDitems_out) | + (grepl("s$", .data$REMINDitems_out)) & grepl("fe(..i$|ind)", .data$EDGEitems)) %>% + distinct() + + 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)) + + # ---- _ prepare output + + return(list(x = remind, weight = NULL, unit = "EJ", + description = "final energy demand in industry")) } diff --git a/R/calcFeDemandTransport.R b/R/calcFeDemandTransport.R index 97ec3738..08190bb0 100644 --- a/R/calcFeDemandTransport.R +++ b/R/calcFeDemandTransport.R @@ -1,16 +1,18 @@ #' @author Alois Dirnaicher, Johanna Hoppe, Falk Benke calcFeDemandTransport <- function() { + # Read in stationary data and map to REMIND variables ---- + + # REMIND transport items trp_nodes <- c("ueelTt", "ueLDVt", "ueHDVt") - # Read in stationary data and map to REMIND variables ---- data <- readSource("Stationary") # aggregate to 5-year averages to suppress volatility data <- toolAggregateTimeSteps(data) mapping <- toolGetMapping(type = "sectoral", name = "structuremappingIO_outputs.csv", - where = "mappingfolder") + where = "mappingfolder") mapping <- mapping %>% select("EDGEitems", "REMINDitems_out", "weight_Fedemand") %>% @@ -180,7 +182,7 @@ calcFeDemandTransport <- function() { # Prepare Output ---- # replace SDP data calculated in readSource("Stationary") with corrected data - remind <- mbind(remind[ , , getNames(dem_iso), invert = TRUE], dem_iso) + remind <- mbind(remind[, , getNames(dem_iso), invert = TRUE], dem_iso) return(list(x = remind, weight = NULL, unit = "EJ", description = "final energy demand in transport")) diff --git a/README.md b/README.md index 6ccef0dd..ac0b3279 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # MadRat REMIND Input Data Package -R package **mrremind**, version **0.174.2.9005** +R package **mrremind**, version **0.174.2.9006** [![CRAN status](https://www.r-pkg.org/badges/version/mrremind)](https://cran.r-project.org/package=mrremind) [![R build status](https://github.com/pik-piam/mrremind/workflows/check/badge.svg)](https://github.com/pik-piam/mrremind/actions) [![codecov](https://codecov.io/gh/pik-piam/mrremind/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrremind) [![r-universe](https://pik-piam.r-universe.dev/badges/mrremind)](https://pik-piam.r-universe.dev/builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Lavinia Baumstark . +Baumstark L, Rodrigues R, Levesque A, Oeser J, Bertram C, Mouratiadou I, Malik A, Schreyer F, Soergel B, Rottoli M, Mishra A, Dirnaichner A, Pehl M, Giannousakis A, Klein D, Strefler J, Feldhaus L, Brecha R, Rauner S, Dietrich J, Bi S, Benke F, Weigmann P, Richters O, Hasse R, Fuchs S, Mandaroux R (2024). _mrremind: MadRat REMIND Input Data Package_. R package version 0.174.2.9006, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {mrremind: MadRat REMIND Input Data Package}, author = {Lavinia Baumstark and Renato Rodrigues and Antoine Levesque and Julian Oeser and Christoph Bertram and Ioanna Mouratiadou and Aman Malik and Felix Schreyer and Bjoern Soergel and Marianna Rottoli and Abhijeet Mishra and Alois Dirnaichner and Michaja Pehl and Anastasis Giannousakis and David Klein and Jessica Strefler and Lukas Feldhaus and Regina Brecha and Sebastian Rauner and Jan Philipp Dietrich and Stephen Bi and Falk Benke and Pascal Weigmann and Oliver Richters and Robin Hasse and Sophie Fuchs and Rahel Mandaroux}, year = {2024}, - note = {R package version 0.174.2.9005}, + note = {R package version 0.174.2.9006}, url = {https://github.com/pik-piam/mrremind}, } ``` diff --git a/man/calcFeDemandBuildings.Rd b/man/calcFeDemandBuildings.Rd index 371df19d..144dbd1f 100644 --- a/man/calcFeDemandBuildings.Rd +++ b/man/calcFeDemandBuildings.Rd @@ -7,7 +7,7 @@ calcFeDemandBuildings(subtype) } \arguments{ -\item{subtype}{FE_buildings or UE_buildings} +\item{subtype}{FE, FE_buildings or UE_buildings} } \description{ Returns the EDGE-Buildings data at the REMIND level