Add FE and UE reporting for space heating

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '596100'
+ValidationKey: '794840'
 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: 'reportbrick: Reporting package for BRICK'
-version: 0.3.0
-date-released: '2024-05-27'
+version: 0.4.0
+date-released: '2024-05-28'
 abstract: This package contains BRICK-specific routines to report model results. The
   main functionality is to generate a mif-file from a given BRICK model run folder.
 authors:

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: reportbrick
 Title: Reporting package for BRICK
-Version: 0.3.0
-Date: 2024-05-27
+Version: 0.4.0
+Date: 2024-05-28
 Authors@R: c(
     person("Robin", "Hasse", , "[email protected]",
            role = c("aut", "cre"),
@@ -21,7 +21,7 @@ Imports:
   knitr,
   madrat,
   magclass,
-  mip (>= 0.148.15),
+  mip (>= 0.148.17),
   piamPlotComparison,
   piamutils (>= 0.0.9),
   purrr,

NAMESPACE

@@ -22,12 +22,15 @@ importFrom(dplyr,summarise)
 importFrom(dplyr,ungroup)
 importFrom(gamstransfer,Container)
 importFrom(madrat,toolGetMapping)
+importFrom(magclass,"getNames<-")
 importFrom(magclass,"getSets<-")
 importFrom(magclass,add_dimension)
 importFrom(magclass,as.magpie)
 importFrom(magclass,collapseDim)
+importFrom(magclass,complete_magpie)
 importFrom(magclass,dimSums)
 importFrom(magclass,getItems)
+importFrom(magclass,getNames)
 importFrom(magclass,getSets)
 importFrom(magclass,mbind)
 importFrom(magclass,mselect)

R/convGDX2MIF.R

@@ -47,6 +47,10 @@ convGDX2MIF <- function(gdx, tmpl = NULL, file = NULL, scenario = "default", t =
   message("running reportDemolition ...")
   output <- mbind(output, reportDemolition(gdx, brickSets)[, t, ])
 
+  ## Energy ====
+  message("running reportEnergy ...")
+  output <- mbind(output, reportEnergy(gdx, brickSets)[, t, ])
+
 
   # FINISH ---------------------------------------------------------------------
 

R/readGdxSymbol.R

@@ -4,6 +4,7 @@
 #' @param symbol character, name of gams object
 #' @param field character, field to read (only relevant for variables)
 #' @param asMagpie boolean, return Magpie object
+#' @param stringAsFactor logical, keep default factors from gams
 #' @returns MagPIE object with data of symbol
 #'
 #' @author Robin Hasse
@@ -12,7 +13,8 @@
 #' @importFrom dplyr select rename %>% all_of
 #' @importFrom magclass as.magpie
 #'
-readGdxSymbol <- function(gdx, symbol, field = "level", asMagpie = TRUE) {
+readGdxSymbol <- function(gdx, symbol, field = "level", asMagpie = TRUE,
+                          stringAsFactor = TRUE) {
 
   allFields <- c("level", "marginal", "lower", "upper", "scale")
 
@@ -35,18 +37,28 @@ readGdxSymbol <- function(gdx, symbol, field = "level", asMagpie = TRUE) {
 
   data <- obj$records
 
+  # convert factors to character
+  if (!stringAsFactor) {
+    for (dim in setdiff(colnames(data), "value")) {
+      data[[dim]] <- as.character(data[[dim]])
+    }
+  }
+
   # remove columns
-  data <- switch(class(obj)[1],
+  switch(class(obj)[1],
     Variable = {
-      data %>%
+      data <- data %>%
         select(-all_of(setdiff(allFields, field))) %>%
         rename(value = field)
     },
     Set = {
-      data %>%
+      data <- data %>%
         select(-"element_text")
-    },
-    data
+      if (isTRUE(asMagpie)) {
+        warning("Sets are not reported as Magpie object.")
+      }
+      asMagpie <- FALSE
+    }
   )
 
   # convert to MagPIE object

R/reportAgg.R

@@ -36,22 +36,12 @@ reportAgg <- function(x,
   }
   if (!setequal(dims, c(names(agg), names(rprt)))) {
     stop("Each of the following dimension has to be either aggregated or ",
-         "reported individually: ", paste(dims, collapse = ", "),
-         " You want to aggegate ", paste(names(agg), collapse = ", "),
+         "reported individually: ", paste(dims, collapse = ", "), ". ",
+         "You want to aggegate ", paste(names(agg), collapse = ", "),
          " and report ", paste(names(rprt), collapse = ", "), ".")
   }
 
-  # find all tags escaped in curly brackets
-  tagsInName <- gregexpr("\\{[a-z]+\\}", name)[[1]]
-  tagsInName <- if (all(tagsInName == -1)) {
-    NULL
-  } else {
-    unlist(lapply(seq_along(tagsInName), function(i) {
-      substr(name,
-             tagsInName[i] + 1,
-             tagsInName[i] + attr(tagsInName, "match.length")[i] - 2)
-    }))
-  }
+  tagsInName <- .findTags(name)
 
   # check if all reported dimensions are tagged in name
   if (is.null(rprt)) {
@@ -72,6 +62,7 @@ reportAgg <- function(x,
 
   # list with dimension elements to consider for aggregation and reporting
   map <- .constructDimMapping(agg, rprt, brickSets, silent)
+
   if (isFALSE(silent)) {
     message(map)
   }
@@ -114,7 +105,6 @@ reportAgg <- function(x,
     }, simplify = FALSE))
   }
 
-
   return(out)
 }
 
@@ -128,7 +118,7 @@ reportAgg <- function(x,
 #' @param agg named vector of dimensions to aggregate
 #' @param rprt named vector of dimensions to report individually
 #' @param brickSets named list with definition of common set elements
-#' @param silent boolean, suppress warnings and printing of dimension mapping
+#' @param silent logical, suppress warnings and printing of dimension mapping
 #' @returns nested named list with dimension mapping
 
 .constructDimMapping <- function(agg, rprt, brickSets, silent) {
@@ -187,7 +177,7 @@ reportAgg <- function(x,
 #' @param x MagPIE object, BRICK object
 #' @param agg named vector of dimensions to aggregate.
 #' @returns aggregated MagPIE objects without sub dimensions in dim 3
-#' @param silent boolean, suppress warnings and printing of dimension mapping
+#' @param silent logical, suppress warnings and printing of dimension mapping
 #'
 #' @importFrom magclass dimSums mselect
 
@@ -244,7 +234,7 @@ reportAgg <- function(x,
 
 
 
-#' Set names is not NULL
+#' Wrapper around setNames
 #'
 #' @param object MAgPIE object
 #' @param nm a vector of names current names should be replaced with. If only
@@ -259,3 +249,26 @@ reportAgg <- function(x,
   }
   setNames(object, nm)
 }
+
+
+
+
+
+#' Find all tags in name escaped in curly brackets
+#'
+#' @param name character, variable name
+#' @returns vector of tags in name, NULL if there are none
+
+.findTags <- function(name) {
+  tags <- gregexpr("\\{[a-z]+\\}", name)[[1]]
+  tags <- if (all(tags == -1)) {
+    NULL
+  } else {
+    unlist(lapply(seq_along(tags), function(i) {
+      substr(name,
+             tags[i] + 1,
+             tags[i] + attr(tags, "match.length")[i] - 2)
+    }))
+  }
+  return(tags)
+}

R/reportEnergy.R

@@ -0,0 +1,117 @@
+#' Report energy demand
+#'
+#' Report final and useful energy demand for space heating
+#'
+#' @param gdx gams transfer container of the BRICK GDX
+#' @param brickSets character, BRICK reporting template
+#'
+#' @author Robin Hasse
+#'
+#' @importFrom magclass mbind getNames<- getNames mselect collapseDim
+#'   complete_magpie
+
+reportEnergy <- function(gdx, brickSets = NULL) {
+
+  # READ -----------------------------------------------------------------------
+
+  # stock variable
+  v_stock <- readGdxSymbol(gdx, "v_stock") %>%
+    mselect(qty = "area") %>%
+    collapseDim(dim = "qty")
+
+  # carrier dimension needed to report carriers
+  hsCarrier <- readGdxSymbol(gdx, "hsCarrier",
+                             asMagpie = FALSE, stringAsFactor = FALSE)
+  stock <- .addCarrierDimension(v_stock, hsCarrier)
+  stock <- complete_magpie(stock, fill = 0)
+
+  # floor-space specific energy demand
+  specDemand <- list(UE = readGdxSymbol(gdx, "p_ueDemand"),
+                     FE = readGdxSymbol(gdx, "p_feDemand"))
+
+  out <- NULL
+
+
+  # REPORT ---------------------------------------------------------------------
+
+  for (energyLevel in names(specDemand)) {
+    energyDemand <- stock * specDemand[[energyLevel]]
+    energyDemand <- energyDemand * 3.6E-6 # GWh to EJ
+    out <- mbind(out,
+
+      ## total ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|Space heating (EJ/yr)"), brickSets,
+                agg = c(bs = "all", hs = "all", carrier = "all", vin = "all", typ = "res", loc = "all", inc = "all")),
+
+
+      ## by building type ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|{typ}|Space heating (EJ/yr)"), brickSets,
+                agg = c(bs = "all", hs = "all", carrier = "all", vin = "all", loc = "all", inc = "all"),
+                rprt = c(typ = "res")),
+
+
+      ## by location ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|{loc}|Space heating (EJ/yr)"), brickSets,
+                agg = c(bs = "all", hs = "all", carrier = "all", vin = "all", typ = "res", inc = "all"),
+                rprt = c(loc = "all")),
+
+
+      ## by carrier ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|Space heating|{carrier} (EJ/yr)"), brickSets,
+                agg = c(bs = "all", hs = "all", vin = "all", loc = "all", typ = "res", inc = "all"),
+                rprt = c(carrier = "all")),
+
+
+      ## by heating technology ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|Space heating|{hs} (EJ/yr)"), brickSets,
+                agg = c(bs = "all", carrier = "all", vin = "all", loc = "all", typ = "res", inc = "all"),
+                rprt = c(hs = "all")),
+
+
+      ## by building type + carrier ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|{typ}|Space heating|{carrier} (EJ/yr)"), brickSets,
+                agg = c(bs = "all", hs = "all", vin = "all", loc = "all", inc = "all"),
+                rprt = c(carrier = "all", typ = "res")),
+
+
+      ## by location + carrier ====
+      reportAgg(energyDemand,
+                paste0(energyLevel, "|Residential|{loc}|Space heating|{carrier} (EJ/yr)"), brickSets,
+                agg = c(bs = "all", hs = "all", vin = "all", typ = "res", inc = "all"),
+                rprt = c(carrier = "all", loc = "all"))
+
+    )
+  }
+
+
+
+  return(out)
+}
+
+
+
+
+
+#' Add carrier dimesion based on heating system technology
+#'
+#' @param v_stock MagPIE object, BRICK variable
+#' @param hsCarrier data.frame, mapping between heating technology and energy
+#'  carrier
+#' @returns MagPIE object with additional carrier dimension
+
+.addCarrierDimension <- function(v_stock, hsCarrier) {
+  stock <- v_stock %>%
+    add_dimension(dim = 3.3, add = "carrier", "carrier")
+  for (i in seq_len(nrow(hsCarrier))) {
+    getNames(stock) <- sub(paste0(hsCarrier[i, "hs"], "\\.carrier"),
+                           paste(as.character(hsCarrier[i, ]), collapse = "."),
+                           getNames(stock))
+  }
+  return(stock)
+}

README.md

@@ -1,6 +1,6 @@
 # Reporting package for BRICK
 
-R package **reportbrick**, version **0.3.0**
+R package **reportbrick**, version **0.4.0**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/reportbrick)](https://cran.r-project.org/package=reportbrick)  [![R build status](https://github.com/pik-piam/reportbrick/workflows/check/badge.svg)](https://github.com/pik-piam/reportbrick/actions) [![codecov](https://codecov.io/gh/pik-piam/reportbrick/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/reportbrick) [![r-universe](https://pik-piam.r-universe.dev/badges/reportbrick)](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 **reportbrick** in publications use:
 
-Hasse R, Rosemann R (2024). _reportbrick: Reporting package for BRICK_. R package version 0.3.0, <https://github.com/pik-piam/reportbrick>.
+Hasse R, Rosemann R (2024). _reportbrick: Reporting package for BRICK_. R package version 0.4.0, <https://github.com/pik-piam/reportbrick>.
 
 A BibTeX entry for LaTeX users is
 
@@ -47,7 +47,7 @@ A BibTeX entry for LaTeX users is
   title = {reportbrick: Reporting package for BRICK},
   author = {Robin Hasse and Ricarda Rosemann},
   year = {2024},
-  note = {R package version 0.3.0},
+  note = {R package version 0.4.0},
   url = {https://github.com/pik-piam/reportbrick},
 }
 ```