Merge pull request #224 from tscheypidi/master

Improved metadata handling in readSource + metadata helper function

.buildlibrary

@@ -1,8 +1,9 @@
-ValidationKey: '62859660'
+ValidationKey: '63066150'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'
 AcceptedNotes: unable to verify current time
 AutocreateReadme: yes
 allowLinterWarnings: no
 enforceVersionUpdate: no
+skipCoverage: no

.github/workflows/check.yaml

@@ -63,6 +63,6 @@ jobs:
         shell: Rscript {0}
         run: |
           nonDummyTests <- setdiff(list.files("./tests/testthat/"), c("test-dummy.R", "_snaps"))
-          if(length(nonDummyTests) > 0) covr::codecov(quiet = FALSE)
+          if(length(nonDummyTests) > 0 && !lucode2:::loadBuildLibraryConfig()[["skipCoverage"]]) covr::codecov(quiet = FALSE)
         env:
           NOT_CRAN: "true"

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: 'madrat: May All Data be Reproducible and Transparent (MADRaT) *'
-version: 3.14.0
-date-released: '2024-10-23'
+version: 3.15.0
+date-released: '2024-10-25'
 abstract: Provides a framework which should improve reproducibility and transparency
   in data processing. It provides functionality such as automatic meta data creation
   and management, rudimentary quality management, data caching, work-flow management

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 3.6.4
+Date: 2023-08-23 08:10:10 UTC
+SHA: d549de159878c4be432d706e3d676ab67de4c98b

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: madrat
 Title: May All Data be Reproducible and Transparent (MADRaT) *
-Version: 3.14.0
-Date: 2024-10-23
+Version: 3.15.0
+Date: 2024-10-25
 Authors@R: c(
     person("Jan Philipp", "Dietrich", , "[email protected]", role = c("aut", "cre"),
            comment = c(affiliation = "Potsdam Institute for Climate Impact Research", ORCID = "0000-0002-4309-6431")),

NAMESPACE

@@ -11,6 +11,7 @@ export(findBottlenecks)
 export(getCalculations)
 export(getConfig)
 export(getDependencies)
+export(getFromComment)
 export(getISOlist)
 export(getLinkFunction)
 export(getLocation)
@@ -61,7 +62,7 @@ importFrom(callr,r)
 importFrom(digest,digest)
 importFrom(igraph,"V<-")
 importFrom(igraph,V)
-importFrom(igraph,as.undirected)
+importFrom(igraph,as_undirected)
 importFrom(igraph,cluster_edge_betweenness)
 importFrom(igraph,components)
 importFrom(igraph,ego)

R/calcOutput.R

@@ -307,40 +307,7 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli
     if (!is.null(x$weight)) if (nyears(x$weight) > 1) x$weight <- x$weight[, years, ]
   }
 
-  .prepComment <- function(x, name, warning = NULL) {
-    if (!is.null(x)) {
-      x[1] <- paste0(" ", name, ": ", x[1])
-      if (length(x) > 1) {
-        x[2:length(x)] <- paste0(paste(rep(" ", 3 + nchar(name)), collapse = ""), x[2:length(x)])
-      }
-    } else {
-      if (!is.null(warning)) {
-        vcat(0, warning)
-        x <- paste0(" ", name, ": not provided")
-      }
-    }
-    return(x)
-  }
-
-  .cleanComment <- function(x, remove = c("unit", "description", "comment", "origin", "creation date", "note")) {
-    # remove old descriptors
-    x <- getComment(x)
-    out <- grep(paste0("^ *(", paste(remove, collapse = "|"), "):"), x, value = TRUE, invert = TRUE)
-    if (length(out) == 0) return(NULL)
-    return(out)
-  }
-
-  unit        <- .prepComment(x$unit, "unit", paste0('Missing unit information for data set "', type, '"!'))
-  description <- .prepComment(x$description, "description",
-                              paste0('Missing description for data set "', type,
-                                     '"! Please add a description in the corresponding calc function!'))
-  comment     <- .prepComment(.cleanComment(x$x), "comment")
-  origin      <- .prepComment(paste0(gsub("\\s{2,}", " ", paste(deparse(match.call()), collapse = "")),
-                                     " (madrat ", unname(getNamespaceVersion("madrat")), " | ", x$package, ")"),
-                              "origin")
-  date        <- .prepComment(date(), "creation date")
-  note        <- .prepComment(x$note, "note")
-
+  extendedComment <- prepExtendedComment(x, type)
 
   if (!isFALSE(aggregate)) {
 
@@ -393,12 +360,6 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli
     x$x <- signif(x$x, signif)
   }
 
-  extendedComment <- c(description,
-                       unit,
-                       note,
-                       comment,
-                       origin,
-                       date)
   if (x$class == "magpie") {
     getComment(x$x) <- extendedComment
     x$x <- clean_magpie(x$x)

R/cleanComment.R

@@ -0,0 +1,21 @@
+#' cleanComment
+#'
+#' Helper function to clean a comment from additional metadata information
+#'
+#' @md
+#' @param x magclass object the comment should be read from
+#' @param remove Vector of categories to be removed
+#' @author Jan Philipp Dietrich
+#' @examples
+#' x <- maxample("animal")
+#' getComment(x) <- c("unit: bla", "comment: hallo", "blub: ble")
+#' madrat:::cleanComment(x)
+
+
+cleanComment <- function(x, remove = c("unit", "description", "comment", "origin", "creation date", "note")) {
+  # remove old descriptors
+  x <- getComment(x)
+  out <- grep(paste0("^ *(", paste(remove, collapse = "|"), "):"), x, value = TRUE, invert = TRUE)
+  if (length(out) == 0) return(NULL)
+  return(out)
+}

R/getFromComment.R

@@ -0,0 +1,23 @@
+#' getFromComment
+#'
+#' Helper function extract a metadata comment
+#'
+#' @md
+#' @param x object the metadata should be extracted from
+#' @param name name of the metadata to be extracted (e.g. unit)
+#' @author Jan Philipp Dietrich
+#' @examples
+#' x <- as.magpie(1)
+#' getComment(x) <- c(" description: example description", " unit: kg")
+#' getFromComment(x, "unit")
+#' getFromComment(x, "description")
+#' @export
+
+getFromComment <- function(x, name) {
+  comment <- attr(x, "comment")
+  key <- paste0("^ ", name, ": ")
+  entry <- grep(key, comment)
+  if (length(entry) == 0) return(NULL)
+  if (length(entry) > 1) stop("duplicate metadata entries found!")
+  return(sub(key, "", comment[entry]))
+}

R/getMadratInfo.R

@@ -15,7 +15,7 @@
 #' @author Jan Philipp Dietrich
 #' @seealso \code{\link{getCalculations}}, \code{\link{getMadratGraph}}
 #' @importFrom igraph graph_from_data_frame components V
-#' cluster_edge_betweenness as.undirected membership
+#' cluster_edge_betweenness as_undirected membership
 #' @export
 
 getMadratInfo <- function(graph = NULL, cutoff = 5, extended = FALSE, ...) {
@@ -187,7 +187,7 @@ getMadratInfo <- function(graph = NULL, cutoff = 5, extended = FALSE, ...) {
 
   if (extended) {
     message("\n.:: Check for community structures (tools ignored) ::.")
-    ceb <- igraph::cluster_edge_betweenness(igraph::as.undirected(ggraphNoTools))
+    ceb <- igraph::cluster_edge_betweenness(igraph::as_undirected(ggraphNoTools))
     out$community_structrues <- writeCommunities(igraph::membership(ceb), # nolint
       what = "close communities",
       elem = "community", cutoff = cutoff

R/prepComment.R

@@ -0,0 +1,27 @@
+#' prepComment
+#'
+#' Helper function to properly format a metadata comment entry
+#'
+#' @md
+#' @param x content to be added as metadata comment
+#' @param name Name of the metadata entry
+#' @param warning Either NULL (no warning) or a warning text that should be
+#' returned if x is NULL
+#' @author Jan Philipp Dietrich
+#' @examples
+#'  madrat:::prepComment("example comment", "example")
+
+prepComment <- function(x, name, warning = NULL) {
+  if (!is.null(x)) {
+    x[1] <- paste0(" ", name, ": ", x[1])
+    if (length(x) > 1) {
+      x[2:length(x)] <- paste0(paste(rep(" ", 3 + nchar(name)), collapse = ""), x[2:length(x)])
+    }
+  } else {
+    if (!is.null(warning)) {
+      vcat(0, warning)
+      x <- paste0(" ", name, ": not provided")
+    }
+  }
+  return(x)
+}

R/prepExtendedComment.R

@@ -0,0 +1,52 @@
+#' prepExtendedComment
+#'
+#' Helper function condense metadata information into
+#' an extended comment entry
+#'
+#' @md
+#' @param x list containing the metadata to be condensed
+#' @param type output type, e.g. "TauTotal"
+#' @param warn boolean indicating whether warnings should be triggered
+#' if entries are missing, or not.
+#' @param n the number of functions to go back for the extraction of the call
+#' information
+#' @author Jan Philipp Dietrich
+#' @examples
+#' test <- function(a = 1) {
+#'    return(madrat:::prepExtendedComment(list(unit = "m", description = "example", package = "blub")))
+#'  }
+#'  test(a = 42)
+#'
+prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) {
+
+  # extract function call information for the parent call defined by n
+  cl <- sys.call(-n)
+  f <- get(as.character(cl[[1]]), mode = "function", sys.frame(-n - 1))
+  cl <- match.call(definition = f, call = cl)
+
+  if (isTRUE(warn)) {
+    unitWarning <- paste0('Missing unit information for data set "', type, '"!')
+    descriptionWarning <- paste0('Missing description for data set "', type,
+                                 '"! Please add a description in the corresponding calc function!')
+  } else {
+    unitWarning <- NULL
+    descriptionWarning <- NULL
+  }
+
+  unit        <- prepComment(x$unit, "unit", unitWarning)
+  description <- prepComment(x$description, "description", descriptionWarning)
+  comment     <- prepComment(cleanComment(x$x), "comment")
+  origin      <- prepComment(paste0(gsub("\\s{2,}", " ", paste(deparse(cl), collapse = "")),
+                                    " (madrat ", unname(getNamespaceVersion("madrat")), " | ", x$package, ")"),
+                             "origin")
+  date        <- prepComment(date(), "creation date")
+  note        <- prepComment(x$note, "note")
+
+  extendedComment <- c(description,
+                       unit,
+                       note,
+                       comment,
+                       origin,
+                       date)
+  return(extendedComment)
+}

R/readSource.R

@@ -153,6 +153,8 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_
     # set class to "magpie" if not set
     if (is.null(xList$class)) xList$class <- "magpie"
 
+    xList$package <- attr(functionname, "pkgcomment")
+
     # assert return list has the expected entries
     if (!all(c("class", "x") %in% names(xList))) {
       stop('Output of "', functionname,
@@ -171,6 +173,13 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_
       }
     }
 
+    extendedComment <- prepExtendedComment(xList, type, n = 2, warn = FALSE)
+    if (xList$class == "magpie") {
+      getComment(xList$x) <- extendedComment
+    } else {
+      attr(xList$x, "comment") <- extendedComment
+    }
+
     cachePut(xList, prefix = prefix, type = type, args = args)
     return(xList)
   }

README.md

@@ -1,6 +1,6 @@
 # May All Data be Reproducible and Transparent (MADRaT) *
 
-R package **madrat**, version **3.14.0**
+R package **madrat**, version **3.15.0**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/madrat)](https://cran.r-project.org/package=madrat) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1115490.svg)](https://doi.org/10.5281/zenodo.1115490) [![R build status](https://github.com/pik-piam/madrat/workflows/check/badge.svg)](https://github.com/pik-piam/madrat/actions) [![codecov](https://codecov.io/gh/pik-piam/madrat/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/madrat) [![r-universe](https://pik-piam.r-universe.dev/badges/madrat)](https://pik-piam.r-universe.dev/builds)
 
@@ -55,7 +55,7 @@ In case of questions / problems please contact Jan Philipp Dietrich <dietrich@pi
 
 To cite package **madrat** in publications use:
 
-Dietrich J, Baumstark L, Wirth S, Giannousakis A, Rodrigues R, Bodirsky B, Leip D, Kreidenweis U, Klein D, Sauer P (2024). _madrat: May All Data be Reproducible and Transparent (MADRaT)_. doi:10.5281/zenodo.1115490 <https://doi.org/10.5281/zenodo.1115490>, R package version 3.14.0, <https://github.com/pik-piam/madrat>.
+Dietrich J, Baumstark L, Wirth S, Giannousakis A, Rodrigues R, Bodirsky B, Leip D, Kreidenweis U, Klein D, Sauer P (2024). _madrat: May All Data be Reproducible and Transparent (MADRaT)_. doi:10.5281/zenodo.1115490 <https://doi.org/10.5281/zenodo.1115490>, R package version 3.15.0, <https://github.com/pik-piam/madrat>.
 
 A BibTeX entry for LaTeX users is
 
@@ -64,7 +64,7 @@ A BibTeX entry for LaTeX users is
   title = {madrat: May All Data be Reproducible and Transparent (MADRaT)},
   author = {Jan Philipp Dietrich and Lavinia Baumstark and Stephen Wirth and Anastasis Giannousakis and Renato Rodrigues and Benjamin Leon Bodirsky and Debbora Leip and Ulrich Kreidenweis and David Klein and Pascal Sauer},
   year = {2024},
-  note = {R package version 3.14.0},
+  note = {R package version 3.15.0},
   url = {https://github.com/pik-piam/madrat},
   doi = {10.5281/zenodo.1115490},
 }