final lucode changes

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '1210118'
+ValidationKey: '1390130'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'

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: 'mredgebuildings: Prepare data to be used by the EDGE-Buildings model'
-version: 0.6.1
-date-released: '2024-04-25'
+version: 0.7.0
+date-released: '2024-05-16'
 abstract: Prepare data to be used by the EDGE-Buildings model.
 authors:
 - family-names: Hasse

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mredgebuildings
 Title: Prepare data to be used by the EDGE-Buildings model
-Version: 0.6.1
-Date: 2024-04-25
+Version: 0.7.0
+Date: 2024-05-16
 Authors@R: c(
     person("Robin", "Hasse", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-1818-3186")),

R/calcFloorspacePast.R

@@ -231,65 +231,3 @@ makeFloorspaceProjection <- function(df, gdppop, dens, endOfHistory, periodBegin
 
   return(dataPred)
 }
-<<<<<<< HEAD
-
-
-#' Extrapolate missing values beyond existing periods
-#'
-#' @param chunk grouped data.frame
-#' @param key column holding values for extrapolation
-#' @param slopeOfLast number of values for boundary regression
-#'
-#' @return data.frame with extrapolated column \code{key}
-
-extrapolateMissingPeriods <- function(chunk, key, slopeOfLast = 5) {
-  # remove NAs
-  outChunk <- chunk
-  chunk <- chunk[!is.na(chunk[[key]]), ]
-
-  # not enough values available for regression
-  if (nrow(chunk) < 2) {
-    # constant value
-    if (nrow(chunk) == 1) {
-      outChunk[[key]] <- unique(chunk[[key]])
-    } else {
-      # no value
-      outChunk[[key]] <- NA
-    }
-  } else {
-    upperPeriod <- max(chunk$period)
-    lowerPeriod <- min(chunk$period)
-
-    form <- as.formula(paste(key, "~ period"))
-
-    # linear regression at upper and lower end
-    mUpper <- lm(form, tail(arrange(chunk, "period"), slopeOfLast))
-    mLower <- lm(form, head(arrange(chunk, "period"), slopeOfLast))
-
-    # extrapolate both ends
-    outChunk[["valueUpper"]] <- predict(mUpper, newdata = outChunk["period"])
-    outChunk[["valueLower"]] <- predict(mLower, newdata = outChunk["period"])
-
-    # shift extrapolation to match last data points
-    outChunk[["valueUpper"]] <- outChunk[["valueUpper"]] *
-      as.numeric(outChunk[outChunk$period == upperPeriod, key] /
-                   outChunk[outChunk$period == upperPeriod, "valueUpper"])
-    outChunk[["valueLower"]] <- outChunk[["valueLower"]] *
-      as.numeric(outChunk[outChunk$period == lowerPeriod, key] /
-                   outChunk[outChunk$period == lowerPeriod, "valueLower"])
-
-    # fill missing lower/upper ends
-    outChunk[[key]] <- ifelse(outChunk[["period"]] > max(chunk$period),
-                              outChunk[["valueUpper"]],
-                              outChunk[[key]])
-    outChunk[[key]] <- ifelse(outChunk[["period"]] < min(chunk$period),
-                              outChunk[["valueLower"]],
-                              outChunk[[key]])
-    outChunk[["valueUpper"]] <- NULL
-    outChunk[["valueLower"]] <- NULL
-  }
-
-  return(outChunk)
-}
-=======
->>>>>>> 510a17d (improved disaggregation)

R/calcPFUDB.R

@@ -144,6 +144,14 @@ calcPFUDB <- function() {
 
   ## Prepare toolDisaggregate Input ====
 
+  # merge existing disaggregated FE data
+  feDisagg <- feOdyssee %>%
+    left_join(feIEAEEI, by = c("region", "period", "carrier", "enduse")) %>%
+    mutate(value = ifelse(is.na(.data[["value.x"]]),
+                          .data[["value.y"]],
+                          .data[["value.x"]])) %>%
+    select("region", "period", "carrier", "enduse", "value")
+
   # calculate enduse-carrier shares for IEA EEI data
   sharesIEAEEI <- feIEAEEI %>%
     group_by(across(all_of(c("region", "period")))) %>%

R/convertWEO.R

@@ -0,0 +1,83 @@
+#' Convert WEO enduse shares w.r.t. to global final energy demand
+#'
+#' @param x readWEO object
+#'
+#' @author Hagen Tockhorn
+#'
+#' @importFrom madrat toolGetMapping
+#' @importFrom quitte aggregate_map
+
+convertWEO <- function(x) {
+
+  # READ DATA-------------------------------------------------------------------
+
+  data <- as.quitte(x)
+
+  # region mapping
+  regmapping <- toolGetMapping(name  = "regionmappingWEO.csv",
+                               type  = "regional",
+                               where = "mredgebuildings")
+
+  # fe weights
+  fe <- calcOutput("ShareETP",
+                   subtype = "enduse",
+                   aggregate = FALSE,
+                   feOnly = TRUE) %>%
+    as.quitte()
+
+
+  # CORRECTIONS-----------------------------------------------------------------
+
+  data <- data %>%
+    select("region", "period", "enduse", "value") %>%
+    rename(variable = "enduse") %>%
+    mutate(unit = NA)
+
+  # Taken from EDGE-B by Antoine Levesque:
+  # "OCD's appliances and lighting is too high compared to electricity consumption"
+
+  dataCorr <- data %>%
+    mutate(value = ifelse(.data[["region"]] == "Other OECD" &
+                            .data[["variable"]] %in% c("appliances", "lighting"),
+                          .data[["value"]] * 0.56,
+                          .data[["value"]])) %>%
+    mutate(value = ifelse(.data[["region"]] == "Middle East" &
+                            .data[["variable"]] %in% c("appliances", "lighting", "space_cooling"),
+                          .data[["value"]] * 0.65,
+                          .data[["value"]])) %>%
+    mutate(value = ifelse(.data[["region"]] == "Southeast Asia" &
+                            .data[["variable"]] %in% c("appliances", "lighting", "space_cooling"),
+                          .data[["value"]] * 0.66,
+                          .data[["value"]]))
+
+
+  # PROCESS DATA----------------------------------------------------------------
+
+  fe <- fe %>%
+    select("region", "period", "enduse", "value") %>%
+    rename("variable" = "enduse")
+
+
+  dataDisagg <- dataCorr %>%
+    aggregate_map(mapping = regmapping,
+                  by = c(region = "RegionCode"),
+                  weights = fe %>%
+                    rename(weight_val_col = "value"),
+                  weight_item_col = "region",
+                  forceAggregation = TRUE) %>%
+    rename(enduse = "variable")
+
+
+  data <- dataDisagg %>%
+    select("region", "period", "enduse", "value")
+
+
+  # OUTPUT----------------------------------------------------------------------
+
+  data <- data %>%
+    as.quitte() %>%
+    as.magpie %>%
+    toolCountryFill()
+
+  return(data)
+}

R/extrapolateMissingPeriods.R

@@ -17,15 +17,15 @@ extrapolateMissingPeriods <- function(chunk, key, slopeOfLast = 5) {
   if (nrow(chunk) < 2) {
     # constant value
     if (nrow(chunk) == 1) {
-      outChunk[[key]] = unique(chunk[[key]])
+      outChunk[[key]] <- unique(chunk[[key]])
     }
     # no value
-    else {
+    else { # nolint
       outChunk[[key]] <- NA
     }
   }
 
-  else {
+  else { #nolint
     upperPeriod <- max(chunk$period)
     lowerPeriod <- min(chunk$period)
 

R/join_all.R

@@ -15,7 +15,7 @@
 #'
 #' @importFrom dplyr left_join right_join full_join anti_join semi_join
 
-join_all <- function(x,
+join_all <- function(x, # nolint object_name_linter
                      y,
                      by = NULL,
                      .direction = "left",

R/readWEO.R

@@ -0,0 +1,29 @@
+#' Read WEO enduse shares w.r.t. to global final energy demand
+#'
+#' @param subtype variable to define data subset ("Buildings", "Transport", "Industry")
+#'
+#' @author Hagen Tockhorn
+
+readWEO <- function(subtype) {
+
+  file <- "WEO_10.2.xlsx"
+
+  # Read Data
+  data <- read_xlsx(file, sheet = 2)
+
+  # Process Data
+  data <- data %>%
+    filter(.data[["sector"]] == subtype) %>%
+    gather("region", "value", 3:12) %>%
+    mutate(period = 2014,
+           region = gsub("\\.", " ", .data[["region"]]),
+           enduse = tolower(.data[["enduse"]]),
+           enduse = gsub(" ", "_", .data[["enduse"]])) %>%
+    select("region", "period", "enduse", "value")
+
+  data <- data %>%
+    as.quitte() %>%
+    as.magpie()
+
+  return(data)
+}

README.md

@@ -1,6 +1,6 @@
 # Prepare data to be used by the EDGE-Buildings model
 
-R package **mredgebuildings**, version **0.6.1**
+R package **mredgebuildings**, version **0.7.0**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/mredgebuildings)](https://cran.r-project.org/package=mredgebuildings)  [![R build status](https://github.com/pik-piam/mredgebuildings/workflows/check/badge.svg)](https://github.com/pik-piam/mredgebuildings/actions) [![codecov](https://codecov.io/gh/pik-piam/mredgebuildings/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mredgebuildings) [![r-universe](https://pik-piam.r-universe.dev/badges/mredgebuildings)](https://pik-piam.r-universe.dev/builds)
 
@@ -38,7 +38,7 @@ In case of questions / problems please contact Robin Hasse <robin.hasse@pik-pots
 
 To cite package **mredgebuildings** in publications use:
 
-Hasse R, Führlich P, Levesque A, Tockhorn H (2024). _mredgebuildings: Prepare data to be used by the EDGE-Buildings model_. R package version 0.6.1, <https://github.com/pik-piam/mredgebuildings>.
+Hasse R, Führlich P, Levesque A, Tockhorn H (2024). _mredgebuildings: Prepare data to be used by the EDGE-Buildings model_. R package version 0.7.0, <https://github.com/pik-piam/mredgebuildings>.
 
 A BibTeX entry for LaTeX users is
 
@@ -47,7 +47,7 @@ A BibTeX entry for LaTeX users is
   title = {mredgebuildings: Prepare data to be used by the EDGE-Buildings model},
   author = {Robin Hasse and Pascal Führlich and Antoine Levesque and Hagen Tockhorn},
   year = {2024},
-  note = {R package version 0.6.1},
+  note = {R package version 0.7.0},
   url = {https://github.com/pik-piam/mredgebuildings},
 }
 ```