Merge pull request #3 from robinhasse/compareScenarios

Compare scenarios
pik-piam · May 8, 2024 · 527ed6e · 527ed6e
2 parents 98ee934 + ca5866e
commit 527ed6e
Show file tree

Hide file tree

Showing 21 changed files with 250 additions and 115 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -7,5 +7,7 @@
 ^codecov\.yml$
 ^\.github$
 ^.*CITATION.cff$
+^.*_Rmd/?.*$
+^.*\.pdf$
 ^.lintr$
 ^tests/.lintr$
diff --git a/.buildlibrary b/.buildlibrary
@@ -1,8 +1,8 @@
-ValidationKey: '218185'
+ValidationKey: '397020'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'
-AcceptedNotes: ~
+AcceptedNotes: Namespaces in Imports field not imported from\:\n *.mip. .piamPlotComparison.
 allowLinterWarnings: no
 enforceVersionUpdate: no
diff --git a/.gitignore b/.gitignore
@@ -2,3 +2,5 @@
 .Rhistory
 .RData
 .Ruserdata
+*.pdf
+*_Rmd/*
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -3,7 +3,7 @@
 exclude: '^tests/testthat/_snaps/.*$'
 repos:
 -   repo: https://github.com/pre-commit/pre-commit-hooks
-    rev: v4.5.0
+    rev: 2c9f875913ee60ca25ce70243dc24d5b6415598c  # frozen: v4.6.0
     hooks:
     -   id: check-case-conflict
     -   id: check-json
@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.4.0
+    rev: 7910e0323d7213f34275a7a562b9ef0fde8ce1b9  # frozen: v0.4.2
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

diff --git a/CITATION.cff b/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.1.1
-date-released: '2024-04-22'
+version: 0.2.0
+date-released: '2024-05-08'
 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:

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: reportbrick
 Title: Reporting package for BRICK
-Version: 0.1.1
-Date: 2024-04-22
+Version: 0.2.0
+Date: 2024-05-08
 Authors@R:
     person("Robin", "Hasse", , "[email protected]",
            role = c("aut", "cre"),
@@ -15,6 +15,8 @@ Imports:
   gamstransfer (>= 3.0.1),
   madrat,
   magclass,
+  mip (>= 0.148.15),
+  piamPlotComparison,
   yaml
 Suggests:
     covr,

diff --git a/R/convGDX2MIF.R b/R/convGDX2MIF.R
@@ -26,6 +26,8 @@ convGDX2MIF <- function(gdx, tmpl = NULL, file = NULL, scenario = "default", t =
     t <- as.numeric(as.character(readGdxSymbol(gdx, "ttot", asMagpie = FALSE)[[1]]))
   }
 
+  brickSets <- readBrickSets(tmpl)
+
   # central object containing all output data
   output <- NULL
 
@@ -35,19 +37,23 @@ convGDX2MIF <- function(gdx, tmpl = NULL, file = NULL, scenario = "default", t =
 
   ## Stock ====
   message("running reportBuildingStock ...")
-  output <- mbind(output, reportBuildingStock(gdx, tmpl)[, t, ])
+  output <- mbind(output, reportBuildingStock(gdx, brickSets)[, t, ])
 
   ## Construction ====
   message("running reportConstruction ...")
-  output <- mbind(output, reportConstruction(gdx, tmpl)[, t, ])
+  output <- mbind(output, reportConstruction(gdx, brickSets)[, t, ])
 
   ## Demolition ====
   message("running reportDemolition ...")
-  output <- mbind(output, reportDemolition(gdx, tmpl)[, t, ])
+  output <- mbind(output, reportDemolition(gdx, brickSets)[, t, ])
 
 
   # FINISH ---------------------------------------------------------------------
 
+  if (length(output) == 0) {
+    stop("Unable to report any variable.")
+  }
+
   # Add dimension names "scenario.model.variable"
   getSets(output)[3] <- "variable"
   output <- add_dimension(output, dim = 3.1, add = "model", nm = "BRICK")
@@ -56,6 +62,7 @@ convGDX2MIF <- function(gdx, tmpl = NULL, file = NULL, scenario = "default", t =
   # either write the *.mif or return the magpie object
   if (!is.null(file)) {
     write.report(output, file = file, ndigit = 7)
+    message("MIF file written: ", file)
   } else {
     return(output)
   }

diff --git a/R/readBrickSets.R b/R/readBrickSets.R
@@ -0,0 +1,51 @@
+#' Read brickSets mapping
+#'
+#' @param tmpl character, BRICK reporting template
+#' @returns named list with definition of common set elements
+#'
+#' @importFrom madrat toolGetMapping
+#' @importFrom yaml read_yaml
+
+readBrickSets <- function(tmpl) {
+  # use default file as basis
+  file <- "brickSets.yaml"
+  brickSets <- .readMapping(file)
+
+  # replace default sets with custom sets where defined
+  if (!is.null(tmpl)) {
+    if (file.exists(tmpl)) {
+      file <- tmpl
+      customBrickSets <- read_yaml(file)
+    } else {
+      file <- paste0("brickSets_", tmpl, ".yaml")
+      customBrickSets <- .readMapping(file)
+    }
+    brickSets[names(customBrickSets)] <- customBrickSets
+  }
+
+  # duplicate aliases
+  brickSetsExplicit <- list()
+  for (dimName in names(brickSets)) {
+    dim <- brickSets[dimName]
+    aliases <- dim[[1]][["alias"]]
+    dim[[1]][["alias"]] <- NULL
+    aliasDims <- rep(dim, length(aliases))
+    names(aliasDims) <- aliases
+    brickSetsExplicit <- c(brickSetsExplicit, c(as.list(dim), aliasDims))
+  }
+
+  attr(brickSetsExplicit, "file") <- file
+  return(brickSetsExplicit)
+}
+
+
+
+
+
+.readMapping <- function(file) {
+  toolGetMapping(name = file,
+                 type  = "sectoral",
+                 where = "reportbrick",
+                 returnPathOnly = TRUE) %>%
+    read_yaml()
+}
diff --git a/R/reportAgg.R b/R/reportAgg.R
@@ -3,7 +3,7 @@
 #' @param x MagPIE object, BRICK object
 #' @param name character, name of reporting variable. reported dimensions passed
 #'   with \code{rprt} have to be escaped with curly brackets.
-#' @param tmpl character, BRICK reporting template
+#' @param brickSets named list, BRICK reporting template
 #' @param agg named vector of dimensions to aggregate. Names are dimension names
 #'   of \code{x} and values are either set elements or subsets of set elements
 #'   to consider.
@@ -19,7 +19,7 @@
 
 reportAgg <- function(x,
                       name,
-                      tmpl = NULL,
+                      brickSets = readBrickSets(NULL),
                       agg = NULL,
                       rprt = NULL,
                       silent = TRUE) {
@@ -70,8 +70,6 @@ reportAgg <- function(x,
 
   # PREPARE --------------------------------------------------------------------
 
-  brickSets <- .readBrickSets(tmpl)
-
   # list with dimension elements to consider for aggregation and reporting
   map <- .constructDimMapping(agg, rprt, brickSets, silent)
   if (isFALSE(silent)) {
@@ -83,7 +81,7 @@ reportAgg <- function(x,
   # AGGREGATE TO REPORTING VARS ------------------------------------------------
 
   if (is.null(rprt)) {
-    out <- .agg(x, map$agg) %>%
+    out <- .agg(x, agg = map$agg, silent = silent) %>%
       .setNames(name)
   } else {
     # combination of entries of reporting dimensions
@@ -100,9 +98,18 @@ reportAgg <- function(x,
                        outName, fixed = TRUE)
       }
 
-      # select combination of reporting values and aggregate to final variable
-      do.call(mselect, c(list(x = x), comb)) %>%
-        .agg(map$agg) %>%
+      # select combination of reporting values
+      combData <- do.call(mselect, c(list(x = x), comb))
+      if (length(combData) == 0) {
+        if (isFALSE(silent)) {
+          message("Missing elements to report. Skip '", outName, "'.")
+        }
+        return(NULL)
+      }
+
+      # aggregate to final variable
+      combData %>%
+        .agg(agg = map$agg, silent = silent) %>%
         .setNames(outName)
     }, simplify = FALSE))
   }
@@ -160,53 +167,6 @@ reportAgg <- function(x,
 
 
 
-#' Read brickSets mapping
-#'
-#' @param tmpl character, BRICK reporting template
-#' @returns named list with definition of common set elements
-#'
-#' @importFrom madrat toolGetMapping
-#' @importFrom yaml read_yaml
-
-.readBrickSets <- function(tmpl) {
-
-  readIt <- function(file) {
-    toolGetMapping(name = file,
-                   type  = "sectoral",
-                   where = "reportbrick",
-                   returnPathOnly = TRUE) %>%
-      read_yaml()
-  }
-
-  file <- "brickSets.yaml"
-  brickSets <- readIt(file)
-
-  # replace default sets with custom sets where defined
-  if (!is.null(tmpl)) {
-    file <- paste0("brickSets_", tmpl, ".yaml")
-    customBrickSets <- readIt(file)
-    brickSets[names(customBrickSets)] <- customBrickSets
-  }
-
-  # duplicate aliases
-  brickSetsExplicit <- list()
-  for (dimName in names(brickSets)) {
-    dim <- brickSets[dimName]
-    aliases <- dim[[1]][["alias"]]
-    dim[[1]][["alias"]] <- NULL
-    aliasDims <- rep(dim, length(aliases))
-    names(aliasDims) <- aliases
-    brickSetsExplicit <- c(brickSetsExplicit, c(as.list(dim), aliasDims))
-  }
-
-  attr(brickSetsExplicit, "file") <- file
-  return(brickSetsExplicit)
-}
-
-
-
-
-
 #' Create tag
 #'
 #' Escape dimension name in curly brackets
@@ -227,14 +187,22 @@ 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
 #'
 #' @importFrom magclass dimSums mselect
 
-.agg <- function(x, agg) {
+.agg <- function(x, agg, silent = TRUE) {
+
+  if (length(x) == 0) {
+    return(NULL)
+  }
 
-  # return NULL if any element in any dimension is missing
   missingElements <- .missingElements(x, agg)
   if (length(missingElements) > 0) {
+    if (isFALSE(silent)) {
+      message("Missing elements to aggregate: ",
+              paste(missingElements, collapse = ", "))
+    }
     return(NULL)
   }
 
@@ -255,14 +223,18 @@ reportAgg <- function(x,
 #' @importFrom magclass getItems
 
 .missingElements <- function(x, dimLst) {
+  if (length(x) == 0) {
+    stop("'x' has length zero.")
+  }
+
   missingDims <- setdiff(names(dimLst), getSets(x))
   if (length(missingDims) > 0) {
     stop("The following dimensions are listed in 'dimLst' but missing in 'x': ",
          paste(missingDims, collapse = ", "))
   }
   unlist(lapply(names(dimLst), function(dim) {
     if (!dim %in% getSets(x)) {
-      stop("x has no dimension call")
+      stop("x has no dimension called ", dim)
     }
     setdiff(dimLst[[dim]], getItems(x, dim = dim))
   }))

diff --git a/R/reportBuildingStock.R b/R/reportBuildingStock.R
@@ -3,13 +3,13 @@
 #' Report quantities describing the stock of buildings
 #'
 #' @param gdx gams transfer container of the BRICK GDX
-#' @param tmpl character, BRICK reporting template
+#' @param brickSets character, BRICK reporting template
 #'
 #' @author Robin Hasse
 #'
 #' @importFrom magclass mbind setNames dimSums mselect collapseDim
 
-reportBuildingStock <- function(gdx, tmpl = NULL) {
+reportBuildingStock <- function(gdx, brickSets = NULL) {
 
   # READ -----------------------------------------------------------------------
 
@@ -30,47 +30,47 @@ reportBuildingStock <- function(gdx, tmpl = NULL) {
 
     ## Total ====
     reportAgg(v_stock,
-              "Stock|Buildings (bn m2)", tmpl,
+              "Stock|Buildings (bn m2)", brickSets,
               agg = c(bs = "all", hs = "all", vin = "all", loc = "all", typ = "resCom", inc = "all")),
     reportAgg(v_stock,
-              "Stock|Residential (bn m2)", tmpl,
+              "Stock|Residential (bn m2)", brickSets,
               agg = c(bs = "all", hs = "all", vin = "all", loc = "all", typ = "res", inc = "all")),
     reportAgg(v_stock,
-              "Stock|Commercial (bn m2)", tmpl,
+              "Stock|Commercial (bn m2)", brickSets,
               agg = c(bs = "all", hs = "all", vin = "all", loc = "all", typ = "com", inc = "all")),
 
 
     ## by building type ====
     reportAgg(v_stock,
-              "Stock|Residential|{typ} (bn m2)", tmpl,
+              "Stock|Residential|{typ} (bn m2)", brickSets,
               agg = c(bs = "all", hs = "all", vin = "all", loc = "all", inc = "all"),
               rprt = c(typ = "res")),
 
 
     ## by location ====
     reportAgg(v_stock,
-              "Stock|Residential|{loc} (bn m2)", tmpl,
+              "Stock|Residential|{loc} (bn m2)", brickSets,
               agg = c(bs = "all", hs = "all", vin = "all", typ = "res", inc = "all"),
               rprt = c(loc = "all")),
 
 
     ## by vintage ====
     reportAgg(v_stock,
-              "Stock|Residential|{vin} (bn m2)", tmpl,
+              "Stock|Residential|{vin} (bn m2)", brickSets,
               agg = c(bs = "all", hs = "all", loc = "all", typ = "res", inc = "all"),
               rprt = c(vin = "all")),
 
 
     ## by heating system ====
     reportAgg(v_stock,
-              "Stock|Residential|{hs} (bn m2)", tmpl,
+              "Stock|Residential|{hs} (bn m2)", brickSets,
               agg = c(bs = "all", vin = "all", loc = "all", typ = "res", inc = "all"),
               rprt = c(hs = "all")),
 
 
     ## by building type + heating system ====
     reportAgg(v_stock,
-              "Stock|Residential|{typ}|{hs} (bn m2)", tmpl,
+              "Stock|Residential|{typ}|{hs} (bn m2)", brickSets,
               agg = c(bs = "all", vin = "all", loc = "all", inc = "all"),
               rprt = c(hs = "all", typ = "res"))