-
Notifications
You must be signed in to change notification settings - Fork 31
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'master' of github.com:pik-piam/mrcommons into eurostat
- Loading branch information
Showing
12 changed files
with
261 additions
and
115 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,116 +1,89 @@ | ||
| #' calcIOEdgeBuildings | ||
| #' | ||
| #' Calculates buildings-related energy flows from the IEA energy balances. 'output_EDGE_buildings' is a key input | ||
| #' to EDGE-Buildings providing the historic final energy demand from buildings. 'output_EDGE' does the same for | ||
| #' Calculates buildings-related energy flows from the IEA energy balances. | ||
| #' 'output_EDGE_buildings' is a key input to EDGE-Buildings providing the | ||
| #' historic final energy demand from buildings. 'output_EDGE' does the same for | ||
| #' buildings and industry together. | ||
| #' | ||
| #' @param subtype Data subtype. See default argument for possible values. | ||
| #' @param ieaVersion Release version of IEA data, either 'default' | ||
| #' (vetted and used in REMIND) or 'latest'. | ||
| #' @return IEA data as MAgPIE object aggregated to country level | ||
| #' @returns IEA data as MAgPIE object aggregated to country level | ||
| #' | ||
| #' @author Pascal Sauer, Anastasis Giannousakis, Robin Hasse | ||
| #' | ||
| #' @author Pascal Sauer, Anastasis Giannousakis | ||
| #' @examples | ||
| #' \dontrun{ | ||
| #' a <- calcOutput("IOEdgeBuildings", subtype = "output_EDGE_buildings") | ||
| #' } | ||
| #' | ||
| #' @seealso \code{\link{calcOutput}} | ||
| #' @importFrom dplyr %>% all_of | ||
| #' | ||
| #' @importFrom dplyr %>% .data all_of filter select | ||
| #' @importFrom tidyr unite | ||
| calcIOEdgeBuildings <- function(subtype = c("output_EDGE", "output_EDGE_buildings"), ieaVersion = "default") { | ||
| #' @importFrom madrat readSource toolGetMapping toolAggregate calcOutput | ||
| #' @importFrom utils read.csv2 | ||
| #' @importFrom magclass as.magpie getNames mselect | ||
|
|
||
| calcIOEdgeBuildings <- function(subtype = c("output_EDGE", "output_EDGE_buildings"), | ||
| ieaVersion = c("default", "latest")) { | ||
|
|
||
| subtype <- match.arg(subtype) | ||
| switch(subtype, | ||
| output_EDGE = { | ||
| mapping <- toolGetMapping(type = "sectoral", | ||
| name = "structuremappingIO_outputs.csv", | ||
| where = "mrcommons", returnPathOnly = TRUE) | ||
| target <- "EDGEitems" | ||
| }, | ||
| output_EDGE_buildings = { | ||
| mapping <- toolGetMapping(type = "sectoral", | ||
| name = "structuremappingIO_outputs.csv", | ||
| where = "mrcommons", returnPathOnly = TRUE) | ||
| target <- "EDGE_buildings" | ||
| }) | ||
|
|
||
| if (!(ieaVersion %in% c("default", "latest"))) { | ||
| stop("Invalid parameter `ieaVersion`. Must be either 'default' or 'latest'") | ||
| } | ||
|
|
||
| ieaSubtype <- if (ieaVersion == "default") "EnergyBalances" else "EnergyBalances-latest" | ||
|
|
||
| # read in data and convert from ktoe to EJ | ||
| data <- readSource("IEA", subtype = ieaSubtype) * 4.1868e-5 | ||
|
|
||
| ieamatch <- read.csv2(mapping, stringsAsFactors = FALSE, na.strings = "") | ||
|
|
||
| # delete NAs rows | ||
| ieamatch <- ieamatch[c("iea_product", "iea_flows", target, "Weight")] %>% | ||
| ieaVersion <- match.arg(ieaVersion) | ||
|
|
||
|
|
||
|
|
||
| # READ ----------------------------------------------------------------------- | ||
|
|
||
| # convert from ktoe to EJ | ||
| data <- switch(ieaVersion, | ||
| default = readSource("IEA", subtype = "EnergyBalances"), | ||
| latest = readSource("IEA", subtype = "EnergyBalances-latest") | ||
| ) * 4.1868e-5 | ||
|
|
||
|
|
||
|
|
||
| # AGGREGATE ------------------------------------------------------------------ | ||
|
|
||
| target <- switch(subtype, | ||
| output_EDGE = "EDGEitems", | ||
| output_EDGE_buildings = "EDGE_buildings" | ||
| ) | ||
|
|
||
| mapping <- toolGetMapping(type = "sectoral", | ||
| name = "structuremappingIO_outputs.csv", | ||
| where = "mrcommons", returnPathOnly = TRUE) %>% | ||
| read.csv2(stringsAsFactors = FALSE, na.strings = "") %>% | ||
| select(all_of(c("iea_product", "iea_flows", target, "Weight"))) %>% | ||
| na.omit() %>% | ||
| unite("target", all_of(target), sep = ".") %>% | ||
| unite("product.flow", c("iea_product", "iea_flows"), sep = ".", remove = FALSE) %>% | ||
| filter(!!sym("product.flow") %in% getNames(data)) | ||
|
|
||
| magpieNames <- ieamatch[["target"]] %>% unique() | ||
|
|
||
| # in case we include IEA categories in the output, iea categories in `ieamatch` got renamed | ||
| ieapname <- "iea_product" | ||
| ieafname <- "iea_flows" | ||
|
|
||
| reminditems <- do.call(mbind, | ||
| lapply(magpieNames, function(item) { | ||
| testdf <- ieamatch[ieamatch$target == item, c(ieapname, ieafname, "Weight")] | ||
| prfl <- paste(testdf[, ieapname], testdf[, ieafname], sep = ".") | ||
| vec <- as.numeric(ieamatch[rownames(testdf), "Weight"]) | ||
| names(vec) <- prfl | ||
| tmp <- data[, , prfl] * as.magpie(vec) | ||
| tmp <- dimSums(tmp, dim = 3, na.rm = TRUE) | ||
| getNames(tmp) <- item | ||
| return(tmp) | ||
| })) | ||
|
|
||
| # Split residential Biomass into traditional and modern biomass depending upon the income per capita | ||
| if (subtype == "output_EDGE") { | ||
| nBiotrad <- "feresbiotrad" | ||
| nBiomod <- "feresbiomod" | ||
| nBioshare <- "feresbioshare" | ||
| } else if (subtype == "output_EDGE_buildings") { | ||
| nBiotrad <- "biotrad" | ||
| nBiomod <- "biomod" | ||
| nBioshare <- "bioshare" | ||
| } | ||
| # Read-in data to compute income per capita | ||
| gdp <- calcOutput("GDPPast", aggregate = FALSE) | ||
| pop <- calcOutput("PopulationPast", aggregate = FALSE) | ||
| gdppop <- gdp[, intersect(getYears(gdp), getYears(pop)), ] / pop[, intersect(getYears(gdp), getYears(pop)), ] | ||
| # Create a lambda which is 1 for income per capita <= 10000, and 0 above 15000 | ||
| # the multiplication by gdppop was necessary to avoid error from vector length. | ||
| lambda <- pmin(gdppop * 0 + 1, pmax(0 * gdppop, (15000 - gdppop) / (15000 - 10000))) | ||
| lambda <- time_interpolate(lambda, getYears(reminditems), extrapolation_type = "constant") | ||
|
|
||
| # Split Bioshare (residential PRIMSBIO) between traditional and modern biomass according to lambda | ||
| bioshareTrad <- setNames(reminditems[, , nBioshare] * lambda, nBiotrad) | ||
| bioshareMod <- setNames(reminditems[, , nBioshare] - bioshareTrad, nBiomod) | ||
|
|
||
| # In case biomod and biotrad do not exist yet in the data set, create dummy items | ||
| if (!any(nBiomod %in% getNames(reminditems))) { | ||
| reminditems <- mbind(reminditems, | ||
| setNames(reminditems[, , nBioshare] * 0, nBiomod)) | ||
| } | ||
| if (!any(nBiotrad %in% getNames(reminditems))) { | ||
| reminditems <- mbind(reminditems, | ||
| setNames(reminditems[, , nBioshare] * 0, nBiotrad)) | ||
| } | ||
|
|
||
| # Add the values from bioshare to the other modern and traditional biomass | ||
| reminditems[, , nBiotrad] <- reminditems[, , nBiotrad] + bioshareTrad | ||
| reminditems[, , nBiomod] <- reminditems[, , nBiomod] + bioshareMod | ||
|
|
||
| # Remove the bioshare item | ||
| reminditems <- reminditems[, , nBioshare, invert = TRUE] | ||
|
|
||
| return(list(x = reminditems, weight = NULL, unit = "EJ", | ||
| description = paste("Historic final energy demand from buildings (and industry)", | ||
| "based on the 2022 IEA World Energy Balances"))) | ||
| filter(.data[["product.flow"]] %in% getNames(data), | ||
| .data[["Weight"]] != 0) %>% | ||
| mutate(Weight = as.numeric(.data[["Weight"]])) | ||
|
|
||
| weight <- as.magpie(mapping[, c("iea_product", "iea_flows", "Weight")]) | ||
|
|
||
| data <- toolAggregate(data[, , mapping[["product.flow"]]] * weight, | ||
| rel = mapping, from = "product.flow", to = "target", dim = 3) | ||
| getSets(data)[3] <- "d3" | ||
|
|
||
|
|
||
|
|
||
| # SPLIT BIOMASS -------------------------------------------------------------- | ||
|
|
||
| gdppop <- calcOutput("GDPpc", average2020 = FALSE, aggregate = FALSE) %>% | ||
| mselect(variable = "gdppc_SSP2", collapseNames = TRUE) | ||
|
|
||
| data <- switch(subtype, | ||
| output_EDGE = toolSplitBiomass(data, gdppop, split = "feresbioshare", | ||
| into = c("feresbiotrad", "feresbiomod")), | ||
| output_EDGE_buildings = toolSplitBiomass(data, gdppop, split = "bioshare") | ||
| ) | ||
|
|
||
| return(list(x = data, | ||
| weight = NULL, | ||
| unit = "EJ/yr", | ||
| description = paste("Historic FE demand from buildings", | ||
| "(and industry) based on IEA Energy Balances"))) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,48 @@ | ||
| #' Split Biomass into modern and traditional | ||
| #' | ||
| #' We assume that below a given GDP/cap level, all biomass is traditional and | ||
| #' above a higher limit, all biomass is modern with a linear transition between | ||
| #' the limits. | ||
| #' | ||
| #' @param x MagPIE object including biomass data | ||
| #' @param gdppop MagPIE object with GDP/cap data | ||
| #' @param split character, name of item to split | ||
| #' @param into character vector of length two with the names of the split items | ||
| #' @param dim dimension of \code{x} with the item to split | ||
| #' @param limits numeric vector of length two with the corresponding GDP/cap | ||
| #' limits. The default values used to be 10k and 15k USD/cap converted from | ||
| #' 2005 to 2017 dollars. | ||
| #' @returns MagPIE object including split biomass data | ||
| #' | ||
| #' @author Robin Hasse | ||
| #' | ||
| #' @importFrom dplyr %>% | ||
| #' @importFrom magclass time_interpolate setNames getYears | ||
| #' @export | ||
|
|
||
| toolSplitBiomass <- function(x, | ||
| gdppop, | ||
| split = "biomass", | ||
| into = c("biotrad", "biomod"), | ||
| dim = 3.1, | ||
| limits = c(1.23E4, 1.85E4)) { | ||
|
|
||
| .rename <- function(x, to) { | ||
| getItems(x, dim)[getItems(x, dim) == split] <- to | ||
| return(x) | ||
| } | ||
|
|
||
| r <- getItems(x, 1) | ||
| weight <- ((gdppop[r, , ] - limits[1]) / (limits[2] - limits[1])) %>% | ||
| collapseDim() %>% | ||
| time_interpolate(getYears(x), extrapolation_type = "constant") %>% | ||
| pmax(0) %>% | ||
| pmin(1) | ||
|
|
||
| items <- setdiff(getItems(x, dim), split) | ||
| xSplit <- lapply(into, function(i) if (i %in% items) x[, , i] else 0) | ||
|
|
||
| mbind(xSplit[[2]] + .rename(x[, , split] * weight, into[2]), | ||
| xSplit[[1]] + .rename(x[, , split] * (1 - weight), into[1]), | ||
| x[, , setdiff(getItems(x, dim), c(split, into))]) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.