reportAgg now allows combined dimension mapping.

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '997200'
+ValidationKey: '1197840'
 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.5.0
-date-released: '2024-08-09'
+version: 0.6.0
+date-released: '2024-08-29'
 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.5.0
-Date: 2024-08-09
+Version: 0.6.0
+Date: 2024-08-29
 Authors@R: c(
     person("Robin", "Hasse", , "robin.hasse@pik-potsdam.de",
            role = c("aut", "cre"),
@@ -26,6 +26,7 @@ Imports:
   piamutils (>= 0.0.9),
   purrr,
   rmarkdown,
+  stringr,
   tidyr,
   yaml
 Suggests:

NAMESPACE

@@ -2,12 +2,14 @@
 
 export(convGDX2MIF)
 export(plotBRICKCalib)
+export(readBrickSets)
 export(reportCalibration)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,.data)
 importFrom(dplyr,across)
 importFrom(dplyr,all_of)
 importFrom(dplyr,any_of)
+importFrom(dplyr,everything)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
@@ -34,12 +36,16 @@ importFrom(magclass,getNames)
 importFrom(magclass,getSets)
 importFrom(magclass,mbind)
 importFrom(magclass,mselect)
+importFrom(magclass,ndim)
 importFrom(magclass,setNames)
 importFrom(magclass,write.report)
 importFrom(piamutils,getSystemFile)
 importFrom(rmarkdown,render)
+importFrom(stringr,str_escape)
 importFrom(tidyr,crossing)
 importFrom(tidyr,replace_na)
+importFrom(tidyr,separate)
+importFrom(tidyr,unite)
 importFrom(utils,capture.output)
 importFrom(utils,tail)
 importFrom(utils,write.csv)

R/convGDX2MIF.R

@@ -96,9 +96,12 @@ convGDX2MIF <- function(gdx,
 
 .findInconsistenSetElements <- function(brickSets, gdx) {
   m <- Container$new(gdx)
-  setsGdx <- setNames(m$getSymbols(names(brickSets)), names(brickSets))
+  sets <- unique(.split(names(brickSets)))
+  setsGdx <- setNames(m$getSymbols(sets), sets)
   do.call(rbind, lapply(names(brickSets), function(s) {
-    elementsGdx <- as.character(setsGdx[[s]]$records[[1]])
+    elementsGdx <- .combinations(lapply(.split(s), function(ps) {
+      as.character(setsGdx[[ps]]$records[[1]])
+    }))
     elementsMap <- names(brickSets[[s]][["elements"]])
     inconsistencies <- list(missing = setdiff(elementsGdx, elementsMap),
                             surplus = setdiff(elementsMap, elementsGdx))

R/helper.R

@@ -0,0 +1,39 @@
+#' Split dimension names
+#'
+#' Split each entry of a character vector and return one unnested character
+#' vector.
+#'
+#' @author Robin Hasse
+#'
+#' @param x character vector
+#' @param split character used to split \code{x}
+#' @returns character vector with each dimension as an own entry
+
+.split <- function(x, split = "\\.") {
+  if (is.null(x)) {
+    return(NULL)
+  }
+  unlist(strsplit(x, split))
+}
+
+
+
+
+
+
+#' All Combinations of dimension elements
+#'
+#' @param lst names list of dimension entries
+#' @returns character vector with all combinations of the dimension elements
+#'   each separated by \code{.}
+#'
+#' @author Robin Hasse
+#'
+#' @importFrom dplyr everything %>%
+#' @importFrom tidyr unite
+
+.combinations <- function(lst) {
+  do.call(expand.grid, lst) %>%
+    unite("combinations", everything(), sep = ".") %>%
+    getElement("combinations")
+}

R/readBrickSets.R

@@ -1,17 +1,30 @@
 #' Read brickSets mapping
 #'
+#' This function creates an explicit named list with the elements of all BRICK
+#' dimensions and corresponding reporting names.
+#'
 #' @param tmpl character, BRICK reporting template
 #' @returns named list with definition of common set elements
 #'
+#' @author Robin Hasse
+#'
 #' @importFrom madrat toolGetMapping
 #' @importFrom yaml read_yaml
+#' @export
+
+readBrickSets <- function(tmpl = NULL) {
+
+
+
+  # use default file as basis --------------------------------------------------
 
-readBrickSets <- function(tmpl) {
-  # use default file as basis
   file <- "brickSets.yaml"
   brickSets <- .readMapping(file)
 
-  # replace default sets with custom sets where defined
+
+
+  # replace default sets with custom sets where defined ------------------------
+
   if (!is.null(tmpl)) {
     if (file.exists(tmpl)) {
       file <- tmpl
@@ -24,7 +37,10 @@ readBrickSets <- function(tmpl) {
   }
   message("Read reporting template: ", file)
 
-  # duplicate aliases and childs
+
+
+  # duplicate aliases and childs -----------------------------------------------
+
   brickSetsExplicit <- list()
   for (dimName in names(brickSets)) {
     dim <- brickSets[dimName]
@@ -51,6 +67,47 @@ readBrickSets <- function(tmpl) {
   }
 
 
+
+  # auto-fill combined dimensions ----------------------------------------------
+
+  # Combined dimensions can be defined without explicit elements.
+  # - If elements are missing entirely, all combinations of the primary
+  #   dimensions are filled automatically.
+  # - If elements are given as a list without reporting names (which requires a
+  #   named list) or missing entirely, reporting names are filled automatically
+  #   separating the primary reporting names with |
+  #   - If all elements of a combined dimension element are identical, the
+  #     reporting name is not repeated but used once.
+
+  combinedDims <- grep("\\.", names(brickSetsExplicit), value = TRUE)
+  for (cd in combinedDims) {
+    dims <- .split(cd)
+    if (is.null(brickSetsExplicit[[cd]][["elements"]])) {
+      # add all combinatinos of primary dimensions as elements
+      brickSetsExplicit[[cd]][["elements"]] <-
+        .combinations(lapply(dims, function(dim) {
+          names(brickSetsExplicit[[dim]][["elements"]])
+        }))
+    }
+    if (!is.list(brickSetsExplicit[[cd]][["elements"]])) {
+      # paste reporting names of primary dimensions
+      brickSetsExplicit[[cd]][["elements"]] <- stats::setNames(
+        lapply(brickSetsExplicit[[cd]][["elements"]], function(elem) {
+          elemVec <- .split(elem)
+          if (all(elemVec == elemVec[1])) {
+            # no repetition of reporting names if all elements are identical
+            return(brickSetsExplicit[[dims[1]]][["elements"]][[elemVec[1]]])
+          }
+          paste(lapply(seq_along(dims), function(i) {
+            brickSetsExplicit[[dims[i]]][["elements"]][[elemVec[i]]]
+          }), collapse = "|")
+        }),
+        brickSetsExplicit[[cd]][["elements"]]
+      )
+    }
+  }
+
+
   attr(brickSetsExplicit, "file") <- file
   return(brickSetsExplicit)
 }
@@ -60,9 +117,8 @@ readBrickSets <- function(tmpl) {
 
 
 .readMapping <- function(file) {
-  toolGetMapping(name = file,
-                 type  = "sectoral",
-                 where = "reportbrick",
-                 returnPathOnly = TRUE) %>%
-    read_yaml()
+  read_yaml(toolGetMapping(name = file,
+                           type  = "sectoral",
+                           where = "reportbrick",
+                           returnPathOnly = TRUE))
 }