From b56511ceeb40287c41b32182af98c61a6dcb8a4d Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 3 Feb 2022 14:17:15 +0100 Subject: [PATCH 1/6] create global and regional calcHistorical functions --- R/calcHistorical.R | 6 +----- R/calcHistoricalGlobal.R | 40 ++++++++++++++++++++++++++++++++++++++++ R/calcHistoricalRegion.R | 40 ++++++++++++++++++++++++++++++++++++++++ R/fullVALIDATIONREMIND.R | 6 ++++++ 4 files changed, 87 insertions(+), 5 deletions(-) create mode 100644 R/calcHistoricalGlobal.R create mode 100644 R/calcHistoricalRegion.R diff --git a/R/calcHistorical.R b/R/calcHistorical.R index d273b27b..18fde43b 100644 --- a/R/calcHistorical.R +++ b/R/calcHistorical.R @@ -177,8 +177,6 @@ calcHistorical <- function() { ARIADNE_ReferenceScenarioPop <- add_dimension(ARIADNE_ReferenceScenarioPop, dim = 3.1, add = "model", nm = "ARIADNE") - IEA_ETP <- calcOutput("IEA_ETP", aggregate = F) - IEA_EVOutlook <- calcOutput("IEA_EVOutlook", aggregate = F) # Calculate Emission Reference Values @@ -235,8 +233,6 @@ calcHistorical <- function() { BP <- calcOutput("BP", aggregate = FALSE) BP <- add_dimension(BP, dim = 3.1, add = "model", nm = "BP") - WEO_2021 <- calcOutput("IEA_WEO_2021", subtype = "regional", aggregate = F) - # Steel Production ---- worldsteel <- readSource('worldsteel', convert = FALSE) %>% madrat_mule() %>% @@ -294,7 +290,7 @@ calcHistorical <- function() { LU_EDGAR_LU, LU_CEDS, LU_FAO_EmisLUC, LU_FAO_EmisAg, LU_PRIMAPhist, IRENAcap, eurostat, #emiMktES, emiMktETS, emiMktESOthers, EU_ReferenceScenario, emiEurostat, ARIADNE_ReferenceScenarioGdp, ARIADNE_ReferenceScenarioGdpCorona, ARIADNE_ReferenceScenarioPop, EEA_GHGSectoral, EEA_GHGTotal, EEA_GHGProjections, Emi_Reference, #, EEA_GHGES - IEA_ETP, IEA_EVOutlook, INNOPATHS, JRC_Industry, JRC_Transport, JRC_ResCom, AGEB_FE, UBA_emi, UNFCCC, BP, worldsteel, WEO_2021) + IEA_EVOutlook, INNOPATHS, JRC_Industry, JRC_Transport, JRC_ResCom, AGEB_FE, UBA_emi, UNFCCC, BP, worldsteel) y <- Reduce(union,lapply(varlist,getYears)) n <- Reduce(c,lapply(varlist,getNames)) diff --git a/R/calcHistoricalGlobal.R b/R/calcHistoricalGlobal.R new file mode 100644 index 00000000..546e07ab --- /dev/null +++ b/R/calcHistoricalGlobal.R @@ -0,0 +1,40 @@ +#' @importFrom magclass setNames getNames getSets add_columns +#' @importFrom luscale rename_dimnames +#' @importFrom madrat getISOlist +#' + +calcHistoricalGlobal <- function() { + + IEA_ETP <- calcOutput("IEA_ETP", aggregate = F) + + WEO_2021 <- calcOutput("IEA_WEO_2021", subtype = "GLO", aggregate = F) + + # ====== start: blow up to union of years =================== + # find all existing years (y) and variable names (n) + + varlist <- list(IEA_ETP, WEO_2021) + + y <- Reduce(union, lapply(varlist, getYears)) + n <- Reduce(c, lapply(varlist, getNames)) + y <- sort(y) + + # create empty object with full temporal, regional and data dimensionality + data <- new.magpie(getISOlist(), y, n, fill = NA) + + getSets(data)[3] <- "model" + getSets(data)[4] <- "variable" + + # transfer data of existing years + for (i in varlist) { + data[, getYears(i), getNames(i)] <- i + } + # ====== end: blow up to union of years =================== + + # add scenario dimension + data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") + + # rename dimension "data" into "variable" + getSets(data)[5] <- "variable" + + return(list(x = data, weight = NULL, unit = "Various", description = "Historical Data")) +} diff --git a/R/calcHistoricalRegion.R b/R/calcHistoricalRegion.R new file mode 100644 index 00000000..4861b4ff --- /dev/null +++ b/R/calcHistoricalRegion.R @@ -0,0 +1,40 @@ +#' @importFrom magclass setNames getNames getSets add_columns +#' @importFrom luscale rename_dimnames +#' @importFrom madrat getISOlist +#' + +calcHistoricalRegion <- function() { + + IEA_ETP <- calcOutput("IEA_ETP", aggregate = F) + + WEO_2021 <- calcOutput("IEA_WEO_2021", subtype = "regional", aggregate = F) + + # ====== start: blow up to union of years =================== + # find all existing years (y) and variable names (n) + + varlist <- list(IEA_ETP, WEO_2021) + + y <- Reduce(union, lapply(varlist, getYears)) + n <- Reduce(c, lapply(varlist, getNames)) + y <- sort(y) + + # create empty object with full temporal, regional and data dimensionality + data <- new.magpie(getISOlist(), y, n, fill = NA) + + getSets(data)[3] <- "model" + getSets(data)[4] <- "variable" + + # transfer data of existing years + for (i in varlist) { + data[, getYears(i), getNames(i)] <- i + } + # ====== end: blow up to union of years =================== + + # add scenario dimension + data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") + + # rename dimension "data" into "variable" + getSets(data)[5] <- "variable" + + return(list(x = data, weight = NULL, unit = "Various", description = "Historical Data")) +} diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index 7508db17..57d842aa 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -15,6 +15,12 @@ fullVALIDATIONREMIND <- function(rev = 0) { #-------------- historical data --------------------------------------------------------------------- + calcOutput("Historical", round = 5, file = "historical.mif", aggregate = "region+global+missingH12") + + calcOutput("HistoricalGlobal", round = 5, file = "historical_global.mif", aggregate = "global") + + calcOutput("HistoricalRegion", round = 5, file = "historical_region.mif", aggregate = "region") + } From da008e360303735d3287493d3b49254d932fb8c4 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 3 Feb 2022 16:11:07 +0100 Subject: [PATCH 2/6] filter IEA ETP variables for regional resolution --- R/calcHistorical.R | 1 + R/calcHistoricalGlobal.R | 1 + R/calcHistoricalRegion.R | 29 ++++++++++++++++++----------- R/fullVALIDATIONREMIND.R | 3 +-- 4 files changed, 21 insertions(+), 13 deletions(-) diff --git a/R/calcHistorical.R b/R/calcHistorical.R index 18fde43b..5f43d70d 100644 --- a/R/calcHistorical.R +++ b/R/calcHistorical.R @@ -1,3 +1,4 @@ +#' Gather reference data from various sources. #' @importFrom magclass setNames getNames getSets add_columns #' @importFrom luscale rename_dimnames diff --git a/R/calcHistoricalGlobal.R b/R/calcHistoricalGlobal.R index 546e07ab..1a77422e 100644 --- a/R/calcHistoricalGlobal.R +++ b/R/calcHistoricalGlobal.R @@ -1,3 +1,4 @@ +#' Gather global reference data from various sources. Call this function with aggregate = "global". #' @importFrom magclass setNames getNames getSets add_columns #' @importFrom luscale rename_dimnames #' @importFrom madrat getISOlist diff --git a/R/calcHistoricalRegion.R b/R/calcHistoricalRegion.R index 4861b4ff..ea87051b 100644 --- a/R/calcHistoricalRegion.R +++ b/R/calcHistoricalRegion.R @@ -1,40 +1,47 @@ +#' Gather global reegional data from various sources. Call this function with aggregate = "region". #' @importFrom magclass setNames getNames getSets add_columns #' @importFrom luscale rename_dimnames #' @importFrom madrat getISOlist -#' +#' calcHistoricalRegion <- function() { IEA_ETP <- calcOutput("IEA_ETP", aggregate = F) - + + # filter regional cement and steel production data from IEA ETP + IEA_ETP <- IEA_ETP[, , c( + "Production|Industry|Cement (Mt/yr)", + "Production|Industry|Steel (Mt/yr" + ), pmatch = T, invert = T] + WEO_2021 <- calcOutput("IEA_WEO_2021", subtype = "regional", aggregate = F) - + # ====== start: blow up to union of years =================== # find all existing years (y) and variable names (n) - + varlist <- list(IEA_ETP, WEO_2021) - + y <- Reduce(union, lapply(varlist, getYears)) n <- Reduce(c, lapply(varlist, getNames)) y <- sort(y) - + # create empty object with full temporal, regional and data dimensionality data <- new.magpie(getISOlist(), y, n, fill = NA) - + getSets(data)[3] <- "model" getSets(data)[4] <- "variable" - + # transfer data of existing years for (i in varlist) { data[, getYears(i), getNames(i)] <- i } # ====== end: blow up to union of years =================== - + # add scenario dimension data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") - + # rename dimension "data" into "variable" getSets(data)[5] <- "variable" - + return(list(x = data, weight = NULL, unit = "Various", description = "Historical Data")) } diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index 57d842aa..40fcce6e 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -21,6 +21,5 @@ fullVALIDATIONREMIND <- function(rev = 0) { calcOutput("HistoricalGlobal", round = 5, file = "historical_global.mif", aggregate = "global") calcOutput("HistoricalRegion", round = 5, file = "historical_region.mif", aggregate = "region") - -} + } From 75def7bbf2047c92cc03daa15535d1c1763ffc0d Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 4 Feb 2022 14:25:39 +0100 Subject: [PATCH 3/6] switch back to only one historical.mif file --- R/calcHistoricalGlobal.R | 41 ---------------- R/calcHistoricalRegion.R | 47 ------------------- R/calcValidIEA_ETP.R | 34 ++++++++++++++ ...IEA_WEO_2021.R => calcValidIEA_WEO_2021.R} | 4 +- R/fullVALIDATIONREMIND.R | 19 ++++++-- 5 files changed, 52 insertions(+), 93 deletions(-) delete mode 100644 R/calcHistoricalGlobal.R delete mode 100644 R/calcHistoricalRegion.R create mode 100644 R/calcValidIEA_ETP.R rename R/{calcIEA_WEO_2021.R => calcValidIEA_WEO_2021.R} (96%) diff --git a/R/calcHistoricalGlobal.R b/R/calcHistoricalGlobal.R deleted file mode 100644 index 1a77422e..00000000 --- a/R/calcHistoricalGlobal.R +++ /dev/null @@ -1,41 +0,0 @@ -#' Gather global reference data from various sources. Call this function with aggregate = "global". -#' @importFrom magclass setNames getNames getSets add_columns -#' @importFrom luscale rename_dimnames -#' @importFrom madrat getISOlist -#' - -calcHistoricalGlobal <- function() { - - IEA_ETP <- calcOutput("IEA_ETP", aggregate = F) - - WEO_2021 <- calcOutput("IEA_WEO_2021", subtype = "GLO", aggregate = F) - - # ====== start: blow up to union of years =================== - # find all existing years (y) and variable names (n) - - varlist <- list(IEA_ETP, WEO_2021) - - y <- Reduce(union, lapply(varlist, getYears)) - n <- Reduce(c, lapply(varlist, getNames)) - y <- sort(y) - - # create empty object with full temporal, regional and data dimensionality - data <- new.magpie(getISOlist(), y, n, fill = NA) - - getSets(data)[3] <- "model" - getSets(data)[4] <- "variable" - - # transfer data of existing years - for (i in varlist) { - data[, getYears(i), getNames(i)] <- i - } - # ====== end: blow up to union of years =================== - - # add scenario dimension - data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") - - # rename dimension "data" into "variable" - getSets(data)[5] <- "variable" - - return(list(x = data, weight = NULL, unit = "Various", description = "Historical Data")) -} diff --git a/R/calcHistoricalRegion.R b/R/calcHistoricalRegion.R deleted file mode 100644 index ea87051b..00000000 --- a/R/calcHistoricalRegion.R +++ /dev/null @@ -1,47 +0,0 @@ -#' Gather global reegional data from various sources. Call this function with aggregate = "region". -#' @importFrom magclass setNames getNames getSets add_columns -#' @importFrom luscale rename_dimnames -#' @importFrom madrat getISOlist -#' - -calcHistoricalRegion <- function() { - - IEA_ETP <- calcOutput("IEA_ETP", aggregate = F) - - # filter regional cement and steel production data from IEA ETP - IEA_ETP <- IEA_ETP[, , c( - "Production|Industry|Cement (Mt/yr)", - "Production|Industry|Steel (Mt/yr" - ), pmatch = T, invert = T] - - WEO_2021 <- calcOutput("IEA_WEO_2021", subtype = "regional", aggregate = F) - - # ====== start: blow up to union of years =================== - # find all existing years (y) and variable names (n) - - varlist <- list(IEA_ETP, WEO_2021) - - y <- Reduce(union, lapply(varlist, getYears)) - n <- Reduce(c, lapply(varlist, getNames)) - y <- sort(y) - - # create empty object with full temporal, regional and data dimensionality - data <- new.magpie(getISOlist(), y, n, fill = NA) - - getSets(data)[3] <- "model" - getSets(data)[4] <- "variable" - - # transfer data of existing years - for (i in varlist) { - data[, getYears(i), getNames(i)] <- i - } - # ====== end: blow up to union of years =================== - - # add scenario dimension - data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") - - # rename dimension "data" into "variable" - getSets(data)[5] <- "variable" - - return(list(x = data, weight = NULL, unit = "Various", description = "Historical Data")) -} diff --git a/R/calcValidIEA_ETP.R b/R/calcValidIEA_ETP.R new file mode 100644 index 00000000..6dae52a3 --- /dev/null +++ b/R/calcValidIEA_ETP.R @@ -0,0 +1,34 @@ +#' Generate IEA ETP data used for validation in historical.mif +#' +#' @md +#' @return A [`magpie`][magclass::magclass] object. +#' +#' @author Falk Benke +#' +#' @param varSet either "all" or "only_regi_meaningful" to filter variables that are too imprecise on regional level +#' @export + +calcValidIEA_ETP <- function(varSet) { + + if (!varSet %in% c("all", "only_regi_meaningful")) { + stop("Not a valid subtype! Must be either \"all\" or \"only_regi_meaningful\"") + } + + data <- calcOutput("IEA_ETP", aggregate = F) + + if (varSet == "only_regi_meaningful") { + data <- data[, , c( + "Production|Industry|Cement (Mt/yr)", + "Production|Industry|Steel (Mt/yr" + ), pmatch = T, invert = T] + } + + data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") + + return(list( + x = data, + weight = NULL, + unit = c("EJ/yr", "Mt CO2/yr", "Mt/yr", "bn pkm/yr", "bn tkm/yr"), + description = "IEA ETP projections as REMIND variables" + )) +} diff --git a/R/calcIEA_WEO_2021.R b/R/calcValidIEA_WEO_2021.R similarity index 96% rename from R/calcIEA_WEO_2021.R rename to R/calcValidIEA_WEO_2021.R index 75c78849..5e93f6ce 100644 --- a/R/calcIEA_WEO_2021.R +++ b/R/calcValidIEA_WEO_2021.R @@ -10,8 +10,8 @@ #' @importFrom rlang sym #' @export +calcValidIEA_WEO_2021 <- function(subtype = "GLO") { -calcIEA_WEO_2021 <- function(subtype = "GLO") { if (!subtype %in% c("GLO", "regional")) { stop("Not a valid subtype! Must be either \"regional\" or \"GLO\"") } @@ -74,6 +74,8 @@ calcIEA_WEO_2021 <- function(subtype = "GLO") { 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 <- add_dimension(x, dim = 3.1, add = "scenario", nm = "historical") return(list( x = x, diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index 40fcce6e..d3385382 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -16,10 +16,21 @@ fullVALIDATIONREMIND <- function(rev = 0) { #-------------- historical data --------------------------------------------------------------------- - calcOutput("Historical", round = 5, file = "historical.mif", aggregate = "region+global+missingH12") + valfile <- "historical.mif" - calcOutput("HistoricalGlobal", round = 5, file = "historical_global.mif", aggregate = "global") + calcOutput("Historical", round = 5, file = valfile, aggregate = "region+global+missingH12", + append = FALSE, na_warning = FALSE, try = TRUE) - calcOutput("HistoricalRegion", round = 5, file = "historical_region.mif", aggregate = "region") + calcOutput(type = "ValidIEA_ETP", aggregate = "GLO", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, varSet = "all") + + calcOutput(type = "ValidIEA_ETP", aggregate = "region", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, varSet = "only_regi_meaningful") + + calcOutput(type = "ValidIEA_WEO_2021", aggregate = "GLO", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, subtype = "GLO") + + calcOutput(type = "ValidIEA_WEO_2021", aggregate = "region", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, subtype = "regional") - } +} From 7e2a612c56c9613c9c9d370514b32bc3a4ac90b8 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 11 Feb 2022 11:06:49 +0100 Subject: [PATCH 4/6] replace validate functions with parameters --- R/calcIEA_ETP.R | 16 ++++++++- ...ValidIEA_WEO_2021.R => calcIEA_WEO_2021.R} | 13 ++++--- R/calcValidIEA_ETP.R | 34 ------------------- R/fullVALIDATIONREMIND.R | 20 ++++++----- 4 files changed, 35 insertions(+), 48 deletions(-) rename R/{calcValidIEA_WEO_2021.R => calcIEA_WEO_2021.R} (89%) delete mode 100644 R/calcValidIEA_ETP.R diff --git a/R/calcIEA_ETP.R b/R/calcIEA_ETP.R index cf9ec883..fd6e7528 100644 --- a/R/calcIEA_ETP.R +++ b/R/calcIEA_ETP.R @@ -5,6 +5,8 @@ #' #' @author Falk Benke #' +#' @param filterOutput either "only_regi_meaningful" to filter variables that are too imprecise on regional level, or NULL +#' @param isValidation indicates if result will be used in validation (as opposed to generating input data) #' @importFrom dplyr select mutate left_join #' @importFrom madrat toolGetMapping #' @importFrom magclass as.magpie @@ -12,7 +14,7 @@ #' @importFrom stats aggregate na.pass #' @export -calcIEA_ETP <- function() { +calcIEA_ETP <- function(filterOutput = NULL, isValidation = FALSE) { mapping <- toolGetMapping("Mapping_IEA_ETP.csv", type = "reportingVariables") %>% filter(!is.na(!!sym("REMIND")), !!sym("REMIND") != "") %>% @@ -52,6 +54,18 @@ calcIEA_ETP <- function() { x <- aggregate(value ~ region + year + model + variable, x, sum, na.action = na.pass) %>% as.magpie() + + + if (!is.null(filterOutput) && filterOutput == "only_regi_meaningful") { + x <- x[, , c( + "Production|Industry|Cement (Mt/yr)", + "Production|Industry|Steel (Mt/yr" + ), pmatch = T, invert = T] + } + + if (isValidation) { + x <- add_dimension(x, dim = 3.1, add = "scenario", nm = "historical") + } return(list( x = x, diff --git a/R/calcValidIEA_WEO_2021.R b/R/calcIEA_WEO_2021.R similarity index 89% rename from R/calcValidIEA_WEO_2021.R rename to R/calcIEA_WEO_2021.R index 5e93f6ce..69718686 100644 --- a/R/calcValidIEA_WEO_2021.R +++ b/R/calcIEA_WEO_2021.R @@ -2,7 +2,8 @@ #' #' @md #' @return A [`magpie`][magclass::magclass] object. -#' @param subtype Either "GLO" or "regional" +#' @param subtype Either "GLO" or "regional", i.e. global or regional data from source +#' @param isValidation indicates if result will be used in validation (as opposed to generating input data) #' @author Falk Benke #' @importFrom dplyr select mutate left_join case_when #' @importFrom madrat toolGetMapping @@ -10,8 +11,7 @@ #' @importFrom rlang sym #' @export -calcValidIEA_WEO_2021 <- function(subtype = "GLO") { - +calcIEA_WEO_2021 <- function(subtype = "GLO", isValidation = FALSE) { if (!subtype %in% c("GLO", "regional")) { stop("Not a valid subtype! Must be either \"regional\" or \"GLO\"") } @@ -74,11 +74,14 @@ calcValidIEA_WEO_2021 <- function(subtype = "GLO") { 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 <- add_dimension(x, dim = 3.1, add = "scenario", nm = "historical") + + if (isValidation) { + x <- add_dimension(x, dim = 3.1, add = "scenario", nm = "historical") + } return(list( x = x, + weight = NULL, unit = c("GW", "EJ/yr", "Mt CO2/yr"), description = "IEA WEO 2021 values as REMIND variables" )) diff --git a/R/calcValidIEA_ETP.R b/R/calcValidIEA_ETP.R deleted file mode 100644 index 6dae52a3..00000000 --- a/R/calcValidIEA_ETP.R +++ /dev/null @@ -1,34 +0,0 @@ -#' Generate IEA ETP data used for validation in historical.mif -#' -#' @md -#' @return A [`magpie`][magclass::magclass] object. -#' -#' @author Falk Benke -#' -#' @param varSet either "all" or "only_regi_meaningful" to filter variables that are too imprecise on regional level -#' @export - -calcValidIEA_ETP <- function(varSet) { - - if (!varSet %in% c("all", "only_regi_meaningful")) { - stop("Not a valid subtype! Must be either \"all\" or \"only_regi_meaningful\"") - } - - data <- calcOutput("IEA_ETP", aggregate = F) - - if (varSet == "only_regi_meaningful") { - data <- data[, , c( - "Production|Industry|Cement (Mt/yr)", - "Production|Industry|Steel (Mt/yr" - ), pmatch = T, invert = T] - } - - data <- add_dimension(data, dim = 3.1, add = "scenario", nm = "historical") - - return(list( - x = data, - weight = NULL, - unit = c("EJ/yr", "Mt CO2/yr", "Mt/yr", "bn pkm/yr", "bn tkm/yr"), - description = "IEA ETP projections as REMIND variables" - )) -} diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index d3385382..1d1d66b8 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -21,16 +21,20 @@ fullVALIDATIONREMIND <- function(rev = 0) { calcOutput("Historical", round = 5, file = valfile, aggregate = "region+global+missingH12", append = FALSE, na_warning = FALSE, try = TRUE) - calcOutput(type = "ValidIEA_ETP", aggregate = "GLO", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, varSet = "all") + calcOutput(type = "IEA_ETP", aggregate = "GLO", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, + filterOutput = NULL, isValidation = TRUE) - calcOutput(type = "ValidIEA_ETP", aggregate = "region", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, varSet = "only_regi_meaningful") + calcOutput(type = "IEA_ETP", aggregate = "region", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, + filterOutput = "only_regi_meaningful", isValidation = TRUE) - calcOutput(type = "ValidIEA_WEO_2021", aggregate = "GLO", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, subtype = "GLO") + calcOutput(type = "IEA_WEO_2021", aggregate = "GLO", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, + subtype = "GLO", isValidation = TRUE) - calcOutput(type = "ValidIEA_WEO_2021", aggregate = "region", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, subtype = "regional") + calcOutput(type = "IEA_WEO_2021", aggregate = "region", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, + subtype = "regional", isValidation = TRUE) } From 0ffd01ddf35078b0eb177ce7dea4ed16286c8b85 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Wed, 16 Feb 2022 18:25:58 +0100 Subject: [PATCH 5/6] remove redundant parameter 'filterOutput' --- R/calcIEA_ETP.R | 8 ++++---- R/calcIEA_WEO_2021.R | 13 +++++++------ R/convertIEA_WEO_2021.R | 10 +++++----- R/fullVALIDATIONREMIND.R | 16 ++++++---------- 4 files changed, 22 insertions(+), 25 deletions(-) diff --git a/R/calcIEA_ETP.R b/R/calcIEA_ETP.R index fd6e7528..ead81167 100644 --- a/R/calcIEA_ETP.R +++ b/R/calcIEA_ETP.R @@ -5,7 +5,7 @@ #' #' @author Falk Benke #' -#' @param filterOutput either "only_regi_meaningful" to filter variables that are too imprecise on regional level, or NULL +#' @param aggregate Boolean indicating whether output data aggregation should be performed or not #' @param isValidation indicates if result will be used in validation (as opposed to generating input data) #' @importFrom dplyr select mutate left_join #' @importFrom madrat toolGetMapping @@ -14,7 +14,7 @@ #' @importFrom stats aggregate na.pass #' @export -calcIEA_ETP <- function(filterOutput = NULL, isValidation = FALSE) { +calcIEA_ETP <- function(aggregate, isValidation = FALSE) { mapping <- toolGetMapping("Mapping_IEA_ETP.csv", type = "reportingVariables") %>% filter(!is.na(!!sym("REMIND")), !!sym("REMIND") != "") %>% @@ -55,8 +55,8 @@ calcIEA_ETP <- function(filterOutput = NULL, isValidation = FALSE) { x <- aggregate(value ~ region + year + model + variable, x, sum, na.action = na.pass) %>% as.magpie() - - if (!is.null(filterOutput) && filterOutput == "only_regi_meaningful") { + # filter variables that are too imprecise on regional level + if (aggregate == "region") { x <- x[, , c( "Production|Industry|Cement (Mt/yr)", "Production|Industry|Steel (Mt/yr" diff --git a/R/calcIEA_WEO_2021.R b/R/calcIEA_WEO_2021.R index 69718686..a24f09e4 100644 --- a/R/calcIEA_WEO_2021.R +++ b/R/calcIEA_WEO_2021.R @@ -2,7 +2,7 @@ #' #' @md #' @return A [`magpie`][magclass::magclass] object. -#' @param subtype Either "GLO" or "regional", i.e. global or regional data from source +#' @param aggregate Boolean indicating whether output data aggregation should be performed or not #' @param isValidation indicates if result will be used in validation (as opposed to generating input data) #' @author Falk Benke #' @importFrom dplyr select mutate left_join case_when @@ -11,9 +11,10 @@ #' @importFrom rlang sym #' @export -calcIEA_WEO_2021 <- function(subtype = "GLO", isValidation = FALSE) { - if (!subtype %in% c("GLO", "regional")) { - stop("Not a valid subtype! Must be either \"regional\" or \"GLO\"") +calcIEA_WEO_2021 <- function(aggregate, isValidation = FALSE) { + + if (!aggregate %in% c("global", "region")) { + aggregate <- "global" } mapping <- toolGetMapping("Mapping_IEA_WEO_2021.csv", type = "reportingVariables") %>% @@ -23,7 +24,7 @@ calcIEA_WEO_2021 <- function(subtype = "GLO", isValidation = FALSE) { mapping$variable <- trimws(mapping$variable) - data <- readSource("IEA_WEO_2021", subtype = subtype) + data <- readSource("IEA_WEO_2021", subtype = aggregate) # copy over Stated Policies Scenario for 2010 - 2020 to other scenarios for (s in getNames(data, dim = 1)) { @@ -58,7 +59,7 @@ calcIEA_WEO_2021 <- function(subtype = "GLO", isValidation = FALSE) { x <- as.magpie(x, spatial = 1, temporal = 2, data = 5) - if (subtype == "GLO") { + 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)"] diff --git a/R/convertIEA_WEO_2021.R b/R/convertIEA_WEO_2021.R index e228b455..7822c234 100644 --- a/R/convertIEA_WEO_2021.R +++ b/R/convertIEA_WEO_2021.R @@ -1,14 +1,14 @@ #' Disaggregates IEA WEO 2021 Data #' @param x MAgPIE object to be converted #' @return A [`magpie`][magclass::magclass] object. -#' @param subtype Either "GLO" or "regional" +#' @param subtype Either "global" or "region" #' @author Falk Benke #' @importFrom madrat getISOlist #' -convertIEA_WEO_2021 <- function(x, subtype = "GLO") { +convertIEA_WEO_2021 <- function(x, subtype = "global") { PE <- calcOutput("PE", aggregate = FALSE) - if (subtype == "GLO") { + if (subtype == "global") { # for now, we only have complete data on global level x.world <- x["World", , ] @@ -25,7 +25,7 @@ convertIEA_WEO_2021 <- function(x, subtype = "GLO") { weight <- PE[, 2016, "PE (EJ/yr)"] x.world <- toolAggregate(x.world, rel = mapping_world, weight = weight) return(x.world) - } else if (subtype == "regional") { + } else if (subtype == "region") { .removeNaRegions <- function(x) { remove <- magpply(x, function(y) all(is.na(y)), MARGIN = 1) return(x[!remove, , ]) @@ -124,6 +124,6 @@ convertIEA_WEO_2021 <- function(x, subtype = "GLO") { return(x.regional) } else { - stop("Not a valid subtype! Must be either \"regional\" or \"GLO\"") + stop("Not a valid subtype! Must be either \"region\" or \"global\"") } } diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index 1d1d66b8..54f453c3 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -21,20 +21,16 @@ fullVALIDATIONREMIND <- function(rev = 0) { calcOutput("Historical", round = 5, file = valfile, aggregate = "region+global+missingH12", append = FALSE, na_warning = FALSE, try = TRUE) - calcOutput(type = "IEA_ETP", aggregate = "GLO", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, - filterOutput = NULL, isValidation = TRUE) + calcOutput(type = "IEA_ETP", aggregate = "global", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) calcOutput(type = "IEA_ETP", aggregate = "region", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, - filterOutput = "only_regi_meaningful", isValidation = TRUE) + append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) - calcOutput(type = "IEA_WEO_2021", aggregate = "GLO", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, - subtype = "GLO", isValidation = TRUE) + calcOutput(type = "IEA_WEO_2021", aggregate = "global", file = valfile, + append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) calcOutput(type = "IEA_WEO_2021", aggregate = "region", file = valfile, - append = TRUE, na_warning = FALSE, try = TRUE, - subtype = "regional", isValidation = TRUE) + append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) } From 99282fc6262b9df29bdc79898290eb6d1aa2bd82 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 17 Feb 2022 11:28:56 +0100 Subject: [PATCH 6/6] type 2 upgrade --- .buildlibrary | 2 +- .zenodo.json | 2 +- DESCRIPTION | 4 ++-- R/calcIEA_ETP.R | 26 +++++++++++++------------- R/convertIEA_WEO_2021.R | 16 ++++++++-------- R/fullVALIDATIONREMIND.R | 10 +++++----- README.md | 6 +++--- man/calcHistorical.Rd | 11 +++++++++++ man/calcIEA_ETP.Rd | 7 ++++++- man/calcIEA_WEO_2021.Rd | 6 ++++-- man/convertIEA_WEO_2021.Rd | 4 ++-- 11 files changed, 56 insertions(+), 38 deletions(-) create mode 100644 man/calcHistorical.Rd diff --git a/.buildlibrary b/.buildlibrary index 3584a1f8..b1f905c1 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '20562120' +ValidationKey: '20753600' 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 index 32fe201d..854ce552 100644 --- a/.zenodo.json +++ b/.zenodo.json @@ -1,6 +1,6 @@ { "title": "mrremind: MadRat REMIND Input Data Package", - "version": "0.108.0", + "version": "0.109.0", "description": "

The mrremind packages contains data preprocessing for the REMIND model.<\/p>", "creators": [ { diff --git a/DESCRIPTION b/DESCRIPTION index ee342515..45045603 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: mrremind Type: Package Title: MadRat REMIND Input Data Package -Version: 0.108.0 -Date: 2022-02-16 +Version: 0.109.0 +Date: 2022-02-17 Authors@R: c(person("Lavinia", "Baumstark", email = "lavinia@pik-potsdam.de", role = c("aut","cre")), person("Renato", "Rodrigues", role = "aut"), person("Antoine", "Levesque", role = "aut"), diff --git a/R/calcIEA_ETP.R b/R/calcIEA_ETP.R index ead81167..e0359424 100644 --- a/R/calcIEA_ETP.R +++ b/R/calcIEA_ETP.R @@ -15,29 +15,29 @@ #' @export calcIEA_ETP <- function(aggregate, isValidation = FALSE) { - + mapping <- toolGetMapping("Mapping_IEA_ETP.csv", type = "reportingVariables") %>% filter(!is.na(!!sym("REMIND")), !!sym("REMIND") != "") %>% mutate(!!sym("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 <- 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, @@ -51,27 +51,27 @@ calcIEA_ETP <- function(aggregate, isValidation = FALSE) { !!sym("year") := as.numeric(as.character(!!sym("year"))) ) %>% select("region", "year", "model", "variable" = "REMIND", "value") - + x <- aggregate(value ~ region + year + model + variable, x, sum, na.action = na.pass) %>% as.magpie() - + # filter variables that are too imprecise on regional level if (aggregate == "region") { x <- x[, , c( "Production|Industry|Cement (Mt/yr)", "Production|Industry|Steel (Mt/yr" - ), pmatch = T, invert = T] + ), pmatch = TRUE, invert = TRUE] } - + if (isValidation) { x <- add_dimension(x, dim = 3.1, add = "scenario", nm = "historical") } return(list( - x = x, + x = x, weight = NULL, unit = c("EJ/yr", "Mt CO2/yr", "Mt/yr", "bn pkm/yr", "bn tkm/yr"), description = "IEA ETP projections as REMIND variables" )) - + } diff --git a/R/convertIEA_WEO_2021.R b/R/convertIEA_WEO_2021.R index 7822c234..d30f8ee5 100644 --- a/R/convertIEA_WEO_2021.R +++ b/R/convertIEA_WEO_2021.R @@ -39,7 +39,7 @@ convertIEA_WEO_2021 <- function(x, subtype = "global") { regions <- intersect(regions_in, getItems(x, dim = 1)) # iso countries in x - ctry <- toolCountry2isocode(getItems(x, dim = 1), warn = F) + ctry <- toolCountry2isocode(getItems(x, dim = 1), warn = FALSE) ctry <- ctry[!is.na(ctry)] # mapping of regions to iso countries other than in ctry (i.e. other regions) @@ -58,12 +58,12 @@ convertIEA_WEO_2021 <- function(x, subtype = "global") { return(toolCountryFill(x2, fill = NA, verbosity = 2)) } - getItems(x1, dim = 1) <- toolCountry2isocode(getItems(x1, dim = 1), warn = F) + 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) } @@ -71,14 +71,14 @@ convertIEA_WEO_2021 <- function(x, subtype = "global") { x.reg <- x[c( "Atlantic Basin", "East of Suez", "NonOPEC", "OPEC", "Japan and Korea", "Southeast Asia", "Other", "European Union", "World" - ), , , invert = T] + ), , , 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 = T] + x.reg <- x.reg[, 2040, , invert = TRUE] regions <- c("Africa", "Asia Pacific", "Central and South America", "Europe", "Eurasia", "Middle East", "North America") @@ -117,11 +117,11 @@ convertIEA_WEO_2021 <- function(x, subtype = "global") { x.regional <- mbind(x.regional, .disaggregate_regions(x_in = j, regions_in = regions)) } - x.regional <- x.regional[, , "dummy", invert = T] + x.regional <- x.regional[, , "dummy", invert = TRUE] Non28EUcountries <- c("ALA", "FRO", "GIB", "GGY", "IMN", "JEY") - x.regional[Non28EUcountries,,] <- 0 - + x.regional[Non28EUcountries, , ] <- 0 + return(x.regional) } else { stop("Not a valid subtype! Must be either \"region\" or \"global\"") diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index 54f453c3..061695d6 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -15,21 +15,21 @@ fullVALIDATIONREMIND <- function(rev = 0) { #-------------- historical data --------------------------------------------------------------------- - + valfile <- "historical.mif" - + calcOutput("Historical", round = 5, file = valfile, aggregate = "region+global+missingH12", append = FALSE, na_warning = FALSE, try = TRUE) - + calcOutput(type = "IEA_ETP", aggregate = "global", file = valfile, append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) - + calcOutput(type = "IEA_ETP", aggregate = "region", file = valfile, append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) calcOutput(type = "IEA_WEO_2021", aggregate = "global", file = valfile, append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) - + calcOutput(type = "IEA_WEO_2021", aggregate = "region", file = valfile, append = TRUE, na_warning = FALSE, try = TRUE, isValidation = TRUE) diff --git a/README.md b/README.md index 9ed66cd1..c350b2b2 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # MadRat REMIND Input Data Package -R package **mrremind**, version **0.108.0** +R package **mrremind**, version **0.109.0** [![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/ui#builds) @@ -38,7 +38,7 @@ In case of questions / problems please contact Lavinia Baumstark