diff --git a/.buildlibrary b/.buildlibrary index 7ac2407..d612a5f 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '997200' +ValidationKey: '1197840' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 41b5a1d..0b6cd4c 100644 --- 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.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: diff --git a/DESCRIPTION b/DESCRIPTION index 2f4e2f3..92b2569 100644 --- a/DESCRIPTION +++ b/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: diff --git a/NAMESPACE b/NAMESPACE index 62b8a9c..c6c5f02 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/convGDX2MIF.R b/R/convGDX2MIF.R index e9860b8..cc9e3d2 100644 --- a/R/convGDX2MIF.R +++ b/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)) diff --git a/R/helper.R b/R/helper.R new file mode 100644 index 0000000..0259a1a --- /dev/null +++ b/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") +} diff --git a/R/readBrickSets.R b/R/readBrickSets.R index 0a3022e..709c9f0 100644 --- a/R/readBrickSets.R +++ b/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)) } diff --git a/R/reportAgg.R b/R/reportAgg.R index 8f29c5e..330f36e 100644 --- a/R/reportAgg.R +++ b/R/reportAgg.R @@ -11,11 +11,17 @@ #' dimension names of \code{x} and values are either set elements or subsets #' of set elements to report. #' @param silent boolean, suppress warnings and printing of dimension mapping +#' @note To consider specific combinations of dimensions in both \code{agg} or +#' \code{rprt}, the combination can be given just like one dimension +#' separated by \code{.}. #' #' @author Robin Hasse #' -#' @importFrom magclass getSets +#' @importFrom magclass getSets ndim #' @importFrom utils tail capture.output +#' @importFrom tidyr separate +#' @importFrom dplyr %>% +#' @importFrom stringr str_escape reportAgg <- function(x, name, @@ -29,16 +35,17 @@ reportAgg <- function(x, dims <- unname(tail(getSets(x, 3), -2)) # check that each dimension is either aggregated or reported - missingDims <- setdiff(dims, c(names(agg), names(rprt))) + specifiedDims <- .split(c(names(agg), names(rprt))) + missingDims <- setdiff(dims, specifiedDims) if (length(missingDims) > 0) { stop("The following dimensions are neither aggregated nor reported ", "individually: ", paste(missingDims, collapse = ", ")) } - if (!setequal(dims, c(names(agg), names(rprt)))) { + if (!setequal(dims, specifiedDims)) { 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 = ", "), - " and report ", paste(names(rprt), collapse = ", "), ".") + "You want to aggegate ", paste(.split(names(agg)), collapse = ", "), + " and report ", paste(.split(names(rprt)), collapse = ", "), ".") } tagsInName <- .findTags(name) @@ -50,9 +57,9 @@ reportAgg <- function(x, paste(tagsInName, collapse = ", ")) } } else { - if (!setequal(names(rprt), tagsInName)) { + if (!setequal(.split(names(rprt)), .split(tagsInName))) { stop("Inconsistency between name tags (", paste(tagsInName, collapse = ", "), - ") and reported dimensions (", paste(names(rprt)), ").") + ") and reported dimensions (", paste(.split(names(rprt))), ").") } } @@ -87,10 +94,19 @@ reportAgg <- function(x, } else { # combination of entries of reporting dimensions rprtCombinations <- do.call(expand.grid, map$rprt) + for (cd in grep("\\.", colnames(rprtCombinations), value = TRUE)) { + if (cd %in% tagsInName) { + # the combined dimension tag is used -> nothing to do + next + } + # the combined dimension is tagged individually -> split the combined + # dimension and their entries to treat them as multiple primary dimensions + rprtCombinations <- rprtCombinations %>% + separate(cd, .split(cd)) + } # loop over reporting combinations out <- do.call(mbind, apply(rprtCombinations, 1, function(comb) { - # replace dimension tags to get final variable name outName <- name for (r in names(comb)) { @@ -100,7 +116,7 @@ reportAgg <- function(x, } # select combination of reporting values - combData <- do.call(mselect, c(list(x = x), comb)) + combData <- .select(x, comb) if (length(combData) == 0) { if (isFALSE(silent)) { message("Missing elements to report. Skip '", outName, "'.") @@ -137,13 +153,12 @@ reportAgg <- function(x, mElements <- lapply(names(m), function(d) { # check if dim is defined in brickSets if (!(d %in% names(brickSets))) { - stop("The brick sets file ", attr(brickSets, "file"), "has no mapping ", + stop("The brick sets file ", attr(brickSets, "file"), " has no mapping ", "for the dimension '", d, "'.") } # explicit list of dimension elements unlist(lapply(m[[d]], function(val) { - if (val %in% names(brickSets[[d]][["elements"]])) { return(val) } @@ -206,7 +221,7 @@ reportAgg <- function(x, return(NULL) } - do.call(mselect, c(list(x = x, agg))) %>% + do.call(.select, c(list(x = x, agg))) %>% dimSums(na.rm = TRUE) } @@ -227,16 +242,24 @@ reportAgg <- function(x, stop("'x' has length zero.") } - missingDims <- setdiff(names(dimLst), getSets(x)) + missingDims <- setdiff(.split(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 called ", dim) + if (!all(.split(dim) %in% getSets(x))) { + stop("x has no dimension(s) called ", paste(.split(dim), collapse = ", ")) + } + if (grepl("\\.", dim)) { + existingElements <- unique(sub( + pattern = paste(rep("(.*)", magclass::ndim(x, 3)), collapse = "\\."), + replacement = paste(paste0("\\", match(.split(dim), tail(getSets(x), -2))), collapse = "\\."), + x = getItems(x, dim = 3) + )) + return(setdiff(dimLst[[dim]], existingElements)) } - setdiff(dimLst[[dim]], getItems(x, dim = dim)) + return(setdiff(dimLst[[dim]], getItems(x, dim = dim))) })) } @@ -270,7 +293,7 @@ reportAgg <- function(x, #' @returns vector of tags in name, NULL if there are none .findTags <- function(name) { - tags <- gregexpr("\\{[a-z]+\\}", name)[[1]] + tags <- gregexpr("\\{[a-z\\.]+\\}", name)[[1]] tags <- if (all(tags == -1)) { NULL } else { @@ -282,3 +305,52 @@ reportAgg <- function(x, } return(tags) } + + + + + +#' select values from MAgPIE-obect +#' +#' This is a wrapper around \code{magclass::mselect} that also allows the +#' selection of combinations of multiple dimensions. +#' +#' @param x MAgPIE object +#' @param ... entry selection. Combined dimensions have to be seperated with +#' \code{.} for both the set names and the set elements. +#' @returns MAgPIE object containing only selected entries + +.select <- function(x, ...) { + dims <- as.list(...) + combinedDims <- grep("\\.", names(dims), value = TRUE) + singleDims <- setdiff(names(dims), combinedDims) + + if (length(singleDims) > 0) { + x <- mselect(x, dims[singleDims]) + } + + if (length(combinedDims) > 0) { + # successively select combined dimensions + x <- Reduce(x = combinedDims, init = x, f = function(data, cd) { + # wild card selection that should find every element in each dimension + patternRaw <- rep("[a-zA-Z0-9-]+", ndim(data, 3)) + names(patternRaw) <- tail(getSets(data), -2) + + # build a regex that combines the patterns for each element combination + # with a OR relationship + regex <- paste(unlist(lapply(dims[[cd]], function(elem) { + # take wild card selection and replace elements that have to be matched + pattern <- patternRaw + pattern[.split(cd)] <- str_escape(.split(elem)) + # subdimensions of MAgPIE objects are separated with . + paste(pattern, collapse = "\\.") + })), collapse = "|") + + # select matching items + items <- grep(regex, getItems(x, 3), value = TRUE) + data[, , items] + }) + } + + return(x) +} diff --git a/README.md b/README.md index 8b3be27..97f5295 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Reporting package for BRICK -R package **reportbrick**, version **0.5.0** +R package **reportbrick**, version **0.6.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 . +Hasse R, Rosemann R (2024). _reportbrick: Reporting package for BRICK_. R package version 0.6.0, . 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.5.0}, + note = {R package version 0.6.0}, url = {https://github.com/pik-piam/reportbrick}, } ``` diff --git a/inst/extdata/sectoral/brickSets.yaml b/inst/extdata/sectoral/brickSets.yaml index a2b076f..95ec665 100644 --- a/inst/extdata/sectoral/brickSets.yaml +++ b/inst/extdata/sectoral/brickSets.yaml @@ -39,6 +39,23 @@ hsr: subsets: [all, elec] +## Renovation ==== +bsr.hsr: + subsets: + all: [low.biom, low.dihe, low.ehp1, low.reel, low.h2bo, low.gabo, + low.libo, low.sobo, low.0, + med.biom, med.dihe, med.ehp1, med.reel, med.h2bo, med.gabo, + med.libo, med.sobo, med.0, + high.biom, high.dihe, high.ehp1, high.reel, high.h2bo, high.gabo, + high.libo, high.sobo, high.0, + 0.biom, 0.dihe, 0.ehp1, 0.reel, 0.h2bo, 0.gabo,0.libo, 0.sobo] + +hs.hsr: + subsets: + identRepl: [biom.biom, dihe.dihe, ehp1.ehp1, reel.reel, h2bo.h2bo, + gabo.gabo, libo.libo, sobo.sobo] + + ## Energy carrier ==== carrier: elements: diff --git a/inst/extdata/sectoral/brickSets_ignoreShell_onlyRes.yaml b/inst/extdata/sectoral/brickSets_ignoreShell_onlyRes.yaml index e9d216f..43bc924 100644 --- a/inst/extdata/sectoral/brickSets_ignoreShell_onlyRes.yaml +++ b/inst/extdata/sectoral/brickSets_ignoreShell_onlyRes.yaml @@ -22,4 +22,11 @@ typ: MFH: MFH subsets: res: [SFH, MFH] + + +## Renovation ==== +# Only `0` for renovation +bsr.hsr: + subsets: + all: [0.biom, 0.dihe, 0.ehp1, 0.reel, 0.h2bo, 0.gabo, 0.libo, 0.sobo] ... diff --git a/man/dot-combinations.Rd b/man/dot-combinations.Rd new file mode 100644 index 0000000..a02531a --- /dev/null +++ b/man/dot-combinations.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helper.R +\name{.combinations} +\alias{.combinations} +\title{All Combinations of dimension elements} +\usage{ +.combinations(lst) +} +\arguments{ +\item{lst}{names list of dimension entries} +} +\value{ +character vector with all combinations of the dimension elements + each separated by \code{.} +} +\description{ +All Combinations of dimension elements +} +\author{ +Robin Hasse +} diff --git a/man/dot-select.Rd b/man/dot-select.Rd new file mode 100644 index 0000000..e6a79a6 --- /dev/null +++ b/man/dot-select.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/reportAgg.R +\name{.select} +\alias{.select} +\title{select values from MAgPIE-obect} +\usage{ +.select(x, ...) +} +\arguments{ +\item{x}{MAgPIE object} + +\item{...}{entry selection. Combined dimensions have to be seperated with +\code{.} for both the set names and the set elements.} +} +\value{ +MAgPIE object containing only selected entries +} +\description{ +This is a wrapper around \code{magclass::mselect} that also allows the +selection of combinations of multiple dimensions. +} diff --git a/man/dot-split.Rd b/man/dot-split.Rd new file mode 100644 index 0000000..0d9db50 --- /dev/null +++ b/man/dot-split.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helper.R +\name{.split} +\alias{.split} +\title{Split dimension names} +\usage{ +.split(x, split = "\\\\.") +} +\arguments{ +\item{x}{character vector} + +\item{split}{character used to split \code{x}} +} +\value{ +character vector with each dimension as an own entry +} +\description{ +Split each entry of a character vector and return one unnested character +vector. +} +\author{ +Robin Hasse +} diff --git a/man/readBrickSets.Rd b/man/readBrickSets.Rd index e2ed1ad..bbddba7 100644 --- a/man/readBrickSets.Rd +++ b/man/readBrickSets.Rd @@ -4,7 +4,7 @@ \alias{readBrickSets} \title{Read brickSets mapping} \usage{ -readBrickSets(tmpl) +readBrickSets(tmpl = NULL) } \arguments{ \item{tmpl}{character, BRICK reporting template} @@ -13,5 +13,9 @@ readBrickSets(tmpl) named list with definition of common set elements } \description{ -Read brickSets mapping +This function creates an explicit named list with the elements of all BRICK +dimensions and corresponding reporting names. +} +\author{ +Robin Hasse } diff --git a/man/reportAgg.Rd b/man/reportAgg.Rd index bb3f417..d639413 100644 --- a/man/reportAgg.Rd +++ b/man/reportAgg.Rd @@ -34,6 +34,11 @@ of set elements to report.} \description{ Report aggregated quantities } +\note{ +To consider specific combinations of dimensions in both \code{agg} or + \code{rprt}, the combination can be given just like one dimension + separated by \code{.}. +} \author{ Robin Hasse }