Merge pull request #193 from fbenke-pik/master

Replace wrongly introduced 0s with NAs in BP source

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '19405126'
+ValidationKey: '19430264'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

.zenodo.json

@@ -1,6 +1,6 @@
 {
   "title": "mrremind: MadRat REMIND Input Data Package",
-  "version": "0.102.1",
+  "version": "0.102.2",
   "description": "<p>The mrremind packages contains data preprocessing for the REMIND model.<\/p>",
   "creators": [
     {

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: mrremind
 Type: Package
 Title: MadRat REMIND Input Data Package
-Version: 0.102.1
-Date: 2022-01-14
+Version: 0.102.2
+Date: 2022-01-20
 Authors@R: c(person("Lavinia", "Baumstark", email = "[email protected]", role = c("aut","cre")),
              person("Renato", "Rodrigues", role = "aut"),
              person("Antoine", "Levesque", role = "aut"),

R/calcBP.R

@@ -4,7 +4,6 @@
 #' @return A [`magpie`][magclass::magclass] object.
 #'
 #' @author Falk Benke
-#' @param subtype Either "Emission", "Capacity", "Generation", "Consumption", "Trade" or "Price"
 #' @importFrom dplyr select mutate left_join
 #' @importFrom madrat toolGetMapping toolCountryFill
 #' @importFrom magclass as.magpie mselect
@@ -13,7 +12,7 @@
 #' @importFrom stats aggregate
 #' @export
 
-calcBP <- function(subtype) {
+calcBP <- function() {
   .readFactors <- function() {
     factors <- toolGetMapping("BP_Renewable_Efficiency_Factors.csv", type = "sectoral")
     colnames(factors) <- c("year", "factor")
@@ -44,96 +43,84 @@ calcBP <- function(subtype) {
       return()
   }
 
-  if (subtype == "Emission") {
-    data <- .convert(readSource("BP", subtype = "Emission"))
-    unit <- c("Mt CO2/yr")
-  }
+  # Emission
+  data <- .convert(readSource("BP", subtype = "Emission"))
+
+  # Capacity
+  data <- rbind(data, .convert(readSource("BP", subtype = "Capacity")))
 
-  else if (subtype == "Capacity") {
-    data <- .convert(readSource("BP", subtype = "Capacity"))
-    unit <- c("GW")
-  }
+  # Generation  
+  data <- rbind(data, .convert(readSource("BP", subtype = "Generation")))
+
+  # Consumption
+
+  # prepare consumption data
+  consumption <- readSource("BP", subtype = "Consumption")
+
+  # rescale renewables to direct equivalence method by multiplying with the numbers given on sheet "Methodology"
+  renewables.factors <- .readFactors() %>%
+    as.magpie() %>%
+    dimReduce()
+  renewables.vars <- c("Solar Consumption (EJ)", "Wind Consumption (EJ)", "Nuclear Consumption (EJ)", "Hydro Consumption (EJ)")
 
-  else if (subtype == "Generation") {
-    data <- .convert(readSource("BP", subtype = "Generation"))
-    unit <- c("EJ/yr")
-  }
+  # recalculate renewables to direct equivalent accounting
+  consumption.renewables <- consumption[, , renewables.vars] * renewables.factors
+
+  consumption.fossils <- consumption[, , c(renewables.vars, "Primary Energy Consumption (EJ)"), invert = T]
+
+  # recalculate total pe consumption to direct equivalent accounting
+
+  # 1. deduct original nuclear and electricity generation by renewables
+  pe.elec.renewable <- readSource("BP", subtype = "Generation")[, , "Generation|Electricity|Renewable (EJ)"]
+  pe.nuclear <- consumption[, , "Nuclear Consumption (EJ)"]
+  consumption.pe <- consumption[, , "Primary Energy Consumption (EJ)"] - pe.nuclear - pe.elec.renewable
+
+  # 2. add adjusted nuclear and renewables values
+  pe.elec.renewable.dea <- pe.elec.renewable * renewables.factors
+  pe.nuclear.dea <- pe.nuclear * renewables.factors
+  consumption.pe <- consumption.pe + pe.elec.renewable.dea + pe.nuclear.dea
+
+  data <- rbind(
+    data,
+    .convert(consumption.fossils),
+    .convert(consumption.renewables),
+    .convert(consumption.pe)
+  )
 
-  else if (subtype == "Consumption") {
-
-    # prepare consumption data
-
-    consumption <- readSource("BP", subtype = "Consumption")
-
-    # rescale renewables to direct equivalence method by multiplying with the numbers given on sheet "Methodology"
-    renewables.factors <- .readFactors() %>%
-      as.magpie() %>%
-      dimReduce()
-    renewables.vars <- c("Solar Consumption (EJ)", "Wind Consumption (EJ)", "Nuclear Consumption (EJ)", "Hydro Consumption (EJ)")
-
-    # recalculate renewables to direct equivalent accounting
-    consumption.renewables <- consumption[, , renewables.vars] * renewables.factors
-
-    consumption.fossils <- consumption[, , c(renewables.vars, "Primary Energy Consumption (EJ)"), invert = T]
-
-    # recalculate total pe consumption to direct equivalent accounting
-
-    # 1. deduct original nuclear and electricity generation by renewables
-    pe.elec.renewable <- readSource("BP", subtype = "Generation")[, , "Generation|Electricity|Renewable (EJ)"]
-    pe.nuclear <- consumption[, , "Nuclear Consumption (EJ)"]
-    consumption.pe <- consumption[, , "Primary Energy Consumption (EJ)"] - pe.nuclear - pe.elec.renewable
-
-    # 2. add adjusted nuclear and renewables values
-    pe.elec.renewable.dea <- pe.elec.renewable * renewables.factors
-    pe.nuclear.dea <- pe.nuclear * renewables.factors
-    consumption.pe <- consumption.pe + pe.elec.renewable.dea + pe.nuclear.dea
-
-    data <- rbind(
-      .convert(consumption.fossils),
-      .convert(consumption.renewables),
-      .convert(consumption.pe)
-    )
-
-    unit <- c("EJ/yr")
-  }
+  # Trade
 
-  else if (subtype == "Trade") {
-
-    # calculate net oil trade
-    trade.oil <- readSource("BP", subtype = "Trade Oil")
-    trade.oil.net <- trade.oil[, , "Trade|Export|Oil (kb/d)"] - trade.oil[, , "Trade|Import|Oil (kb/d)"]
-    getNames(trade.oil.net) <- c("Net Trade|Oil (kb/d)")
-    getSets(trade.oil.net) <- c("region", "year", "data")
-
-    # calculate net coal trade
-    trade.coal <- readSource("BP", subtype = "Trade Coal")
-    trade.coal.net <- trade.coal[, , "Trade|Export|Coal (EJ)"] - trade.coal[, , "Trade|Import|Coal (EJ)"]
-    getNames(trade.coal.net) <- c("Net Trade|Coal (EJ)")
-    getSets(trade.coal.net) <- c("region", "year", "data")
-
-    # calculate net gas trade
-    trade.gas <- readSource("BP", subtype = "Trade Gas")
-    trade.gas.net <- trade.gas[, , "Trade|Export|Gas (bcm)"] - trade.gas[, , "Trade|Import|Gas (bcm)"]
-    getNames(trade.gas.net) <- c("Net Trade|Gas (bcm)")
-    getSets(trade.gas.net) <- c("region", "year", "data")
-
-    data <- rbind(
-      .convert(trade.oil),
-      .convert(trade.oil.net),
-      .convert(trade.gas),
-      .convert(trade.gas.net),
-      .convert(trade.coal),
-      .convert(trade.coal.net)
-    )
-    unit <- c("EJ/yr")
-  }
+  # calculate net oil trade
+  trade.oil <- readSource("BP", subtype = "Trade Oil")
+  trade.oil.net <- trade.oil[, , "Trade|Export|Oil (kb/d)"] - trade.oil[, , "Trade|Import|Oil (kb/d)"]
+  getNames(trade.oil.net) <- c("Net Trade|Oil (kb/d)")
+  getSets(trade.oil.net) <- c("region", "year", "data")
+
+  # calculate net coal trade
+  trade.coal <- readSource("BP", subtype = "Trade Coal")
+  trade.coal.net <- trade.coal[, , "Trade|Export|Coal (EJ)"] - trade.coal[, , "Trade|Import|Coal (EJ)"]
+  getNames(trade.coal.net) <- c("Net Trade|Coal (EJ)")
+  getSets(trade.coal.net) <- c("region", "year", "data")
+
+  # calculate net gas trade
+  trade.gas <- readSource("BP", subtype = "Trade Gas")
+  trade.gas.net <- trade.gas[, , "Trade|Export|Gas (bcm)"] - trade.gas[, , "Trade|Import|Gas (bcm)"]
+  getNames(trade.gas.net) <- c("Net Trade|Gas (bcm)")
+  getSets(trade.gas.net) <- c("region", "year", "data")
 
-  else if (subtype == "Price") {
-    data <- .convert(readSource("BP", subtype = "Price"))
-    unit <- c("US$2005/GJ")
-  } else {
-    stop("Not a valid subtype!")
-  }
+  data <- rbind(
+    data,
+    .convert(trade.oil),
+    .convert(trade.oil.net),
+    .convert(trade.gas),
+    .convert(trade.gas.net),
+    .convert(trade.coal),
+    .convert(trade.coal.net)
+  )
+
+  # Trade
+
+  p <- readSource("BP", subtype = "Price")
+  data <- rbind(data, .convert(p))
 
   x <- left_join(
     data,
@@ -142,9 +129,7 @@ calcBP <- function(subtype) {
   ) %>%
     filter(!!sym("REMIND") != "") %>%
     mutate(
-      !!sym("value") := ifelse(
-        is.na(!!sym("value")), 0, !!sym("value") * !!sym("conversion")
-      ),
+      !!sym("value") := !!sym("value") * !!sym("conversion"),
       !!sym("REMIND") := paste0(!!sym("REMIND"), " (", !!sym("Unit_REMIND"), ")")
     ) %>%
     select("variable" = "REMIND", "region", "year", "value")
@@ -153,17 +138,15 @@ calcBP <- function(subtype) {
     as.magpie() %>%
     toolCountryFill(fill = 0)
 
-  if (subtype == "Price") {
-    weights <- x
-    weights[, , ] <- 1
-  } else {
-    weights <- NULL
-  }
+  weights <- x
+  weights[,,] <- NA
+  weights[,,"US$2005/GJ", pmatch = T] <- 1
 
   return(list(
     x = x, 
     weight = weights,
-    unit = unit,
+    mixed_aggregation = T, 
+    unit = c("Mt CO2/yr", "GW", "EJ/yr", "US$2005/GJ"),
     description = "Historical BP values as REMIND variables"
   ))
 }

R/calcHistorical.R

@@ -227,18 +227,8 @@ calcHistorical <- function() {
   UNFCCC <- add_dimension(UNFCCC, dim = 3.1, add = "model", nm = "UNFCCC")
 
   # BP data
-  BP_Emi <- calcOutput("BP", subtype = "Emission", aggregate = FALSE)
-  BP_Emi <- add_dimension(BP_Emi, dim = 3.1, add = "model", nm = "BP")
-  BP_Cap <- calcOutput("BP", subtype = "Capacity", aggregate = FALSE)
-  BP_Cap <- add_dimension(BP_Cap, dim = 3.1, add = "model", nm = "BP")
-  BP_Gen <- calcOutput("BP", subtype = "Generation", aggregate = FALSE)
-  BP_Gen <- add_dimension(BP_Gen, dim = 3.1, add = "model", nm = "BP")
-  BP_Consump <- calcOutput("BP", subtype = "Consumption", aggregate = FALSE)
-  BP_Consump <- add_dimension(BP_Consump, dim = 3.1, add = "model", nm = "BP")
-  BP_Trad <- calcOutput("BP", subtype = "Trade", aggregate = FALSE)
-  BP_Trad <- add_dimension(BP_Trad, dim = 3.1, add = "model", nm = "BP")
-  BP_Price <- calcOutput("BP", subtype = "Price", aggregate = FALSE)
-  BP_Price <- add_dimension(BP_Price, dim = 3.1, add = "model", nm = "BP")
+  BP <- calcOutput("BP", aggregate = FALSE)
+  BP <- add_dimension(BP, dim = 3.1, add = "model", nm = "BP")
 
   # currently we don't include global data because regional disaggregation is too unprecise to 
   # compare the data on any other than global level
@@ -253,8 +243,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_Emi, BP_Cap, BP_Gen, BP_Consump, BP_Trad, BP_Price, WEO_2021)
+                  IEA_ETP, IEA_EVOutlook, INNOPATHS, JRC_Industry, JRC_Transport, JRC_ResCom, AGEB_FE, UBA_emi, UNFCCC, BP, WEO_2021)
 
   y <- Reduce(union,lapply(varlist,getYears))
   n <- Reduce(c,lapply(varlist,getNames))

R/convertBP.R

@@ -23,10 +23,17 @@ convertBP <- function(x, subtype) {
     return(x[!remove, , ])
   }
 
+  .removeNaYears <- function(x) {
+    remove <- magpply(x, function(y) all(is.na(y)), MARGIN = 2)
+    return(x[,!remove, ])
+  }
+
+
   # disaggregate regions of x by mapping to iso countries belonging to that regions, but not listed in x (i.e. other countries)
   .disaggregate_regions <- function(x_in, regions) {
 
     x <- .removeNaRegions(x_in)
+    x <- .removeNaYears(x)
 
     # full mapping of regions to iso countries
     mapping_full <- toolGetMapping("regionmappingBP_Full.csv", type = "regional")
@@ -50,19 +57,23 @@ convertBP <- function(x, subtype) {
     x1 <- x[regions, , invert = TRUE]
     getItems(x1, dim = 1) <- toolCountry2isocode(getItems(x1, dim = 1), warn = F)
     x1 <- toolCountryFill(x1, fill = 0, verbosity = 2)
-    x1[is.na(x1)] <- 0
 
     # combine the two objects
     x <- x1 + x2
+    x <- add_columns(x, setdiff(getItems(x_in, dim = 2), getItems(x, dim = 2)), dim = 2)
     return(x)
   }
 
+
   .mergeReg <- function(x, from, to) {
-    x1 <- mbind(
-      new.magpie(to, getYears(x), getNames(x), fill = dimSums(x[from, , ], dim = 1, na.rm = T)),
-      x[from, , invert = T]
-    )
-    return(x1)
+    x1 <- new.magpie(to, getYears(x), getNames(x), fill = NA)
+    for (n in getNames(x)) {
+      tmp <- x[, , n]
+      tmp <- .removeNaYears(tmp)
+      x1[, getItems(tmp, dim = 2), n] <- dimSums(tmp[intersect(getItems(x, dim = 1), from), , ], dim = 1, na.rm = T)
+    }
+
+    return(mbind(x[from, , invert = T], x1))
   }
 
   getItems(x, dim = 1) <- gsub("\\bUS\\b", "USA", getItems(x, dim = 1))

R/readBP.R

@@ -5,7 +5,7 @@
 #' @return A [`magpie`][magclass::magclass] object.
 #' @author Aman Malik, Falk Benke
 #' @importFrom tidyr gather
-#' @importFrom dplyr filter %>%
+#' @importFrom dplyr filter %>% mutate
 #' @importFrom readxl read_excel
 #' @importFrom reshape merge_recurse
 #' @importFrom reshape2 melt

README.md

@@ -1,6 +1,6 @@
 # MadRat REMIND Input Data Package
 
-R package **mrremind**, version **0.102.1**
+R package **mrremind**, version **0.102.2**
 
 [![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://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 <lavinia@pik-po
 
 To cite package **mrremind** in publications use:
 
-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 (2022). _mrremind: MadRat REMIND Input Data Package_. R package version 0.102.1.
+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 (2022). _mrremind: MadRat REMIND Input Data Package_. R package version 0.102.2.
 
 A BibTeX entry for LaTeX users is
 
@@ -47,6 +47,6 @@ 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},
   year = {2022},
-  note = {R package version 0.102.1},
+  note = {R package version 0.102.2},
 }
 ```