From 0eec37b051077bc35a1fc6f6ce53b5415b92828b Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Mon, 11 Nov 2024 14:06:27 +0100 Subject: [PATCH 1/8] fix prepExtendedComment called from package::fun --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/prepExtendedComment.R | 19 +++++++++++++++---- README.md | 6 +++--- man/prepExtendedComment.Rd | 6 +++--- tests/testthat/test-prepExtendedComment.R | 5 +++++ 7 files changed, 31 insertions(+), 15 deletions(-) create mode 100644 tests/testthat/test-prepExtendedComment.R diff --git a/.buildlibrary b/.buildlibrary index 8179ea8..dc17937 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '63144016' +ValidationKey: '63179814' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 077e109..c8c903c 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: 'madrat: May All Data be Reproducible and Transparent (MADRaT) *' -version: 3.15.2 -date-released: '2024-11-06' +version: 3.15.3 +date-released: '2024-11-11' 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 diff --git a/DESCRIPTION b/DESCRIPTION index 9e90104..282a433 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: madrat Title: May All Data be Reproducible and Transparent (MADRaT) * -Version: 3.15.2 -Date: 2024-11-06 +Version: 3.15.3 +Date: 2024-11-11 Authors@R: c( person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = c("aut", "cre"), comment = c(affiliation = "Potsdam Institute for Climate Impact Research", ORCID = "0000-0002-4309-6431")), diff --git a/R/prepExtendedComment.R b/R/prepExtendedComment.R index 6c382dd..29d7006 100644 --- a/R/prepExtendedComment.R +++ b/R/prepExtendedComment.R @@ -13,15 +13,22 @@ #' @author Jan Philipp Dietrich #' @examples #' test <- function(a = 1) { -#' return(madrat:::prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) -#' } -#' test(a = 42) +#' 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)) + functionName <- as.character(cl[[1]]) + + # if readSource is called as madrat::readSource functionName will + # be in this unintuitive order c("::", "madrat", "readSource") + if (length(functionName) == 3 && grepl("^:::?$", functionName[[1]])) { + functionName <- functionName[[3]] + } + f <- get(functionName, mode = "function", sys.frame(-n - 1)) cl <- match.call(definition = f, call = cl) if (isTRUE(warn)) { @@ -50,3 +57,7 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { date) return(extendedComment) } + +testPrepExtendedComment <- function() { + return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) +} diff --git a/README.md b/README.md index b9a1af6..d2056cb 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # May All Data be Reproducible and Transparent (MADRaT) * -R package **madrat**, version **3.15.2** +R package **madrat**, version **3.15.3** [![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 , R package version 3.15.2, . +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 , R package version 3.15.3, . 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.15.2}, + note = {R package version 3.15.3}, url = {https://github.com/pik-piam/madrat}, doi = {10.5281/zenodo.1115490}, } diff --git a/man/prepExtendedComment.Rd b/man/prepExtendedComment.Rd index da41a11..4b6cd12 100644 --- a/man/prepExtendedComment.Rd +++ b/man/prepExtendedComment.Rd @@ -23,9 +23,9 @@ an extended comment entry } \examples{ test <- function(a = 1) { - return(madrat:::prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) - } - test(a = 42) + return(madrat:::prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) +} +test(a = 42) } \author{ diff --git a/tests/testthat/test-prepExtendedComment.R b/tests/testthat/test-prepExtendedComment.R new file mode 100644 index 0000000..2f6a416 --- /dev/null +++ b/tests/testthat/test-prepExtendedComment.R @@ -0,0 +1,5 @@ +test_that("prepExtendedComment works in functions called via package::fun", { + expect_identical(madrat:::testPrepExtendedComment()[1:2], + c(" description: example", + " unit: m")) +}) From 77483e5a1283065a6057543f3855e9751c3e18e4 Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Mon, 11 Nov 2024 15:47:18 +0100 Subject: [PATCH 2/8] fix --- R/prepExtendedComment.R | 11 +++++++---- tests/testthat/test-prepExtendedComment.R | 3 ++- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/R/prepExtendedComment.R b/R/prepExtendedComment.R index 29d7006..7357760 100644 --- a/R/prepExtendedComment.R +++ b/R/prepExtendedComment.R @@ -21,14 +21,16 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { # extract function call information for the parent call defined by n cl <- sys.call(-n) - functionName <- as.character(cl[[1]]) + functionCall <- as.character(cl[[1]]) # if readSource is called as madrat::readSource functionName will # be in this unintuitive order c("::", "madrat", "readSource") - if (length(functionName) == 3 && grepl("^:::?$", functionName[[1]])) { - functionName <- functionName[[3]] + if (length(functionCall) == 3 && functionCall[[1]] %in% c("::", ":::")) { + f <- get(functionCall[[3]], envir = loadNamespace(functionCall[[2]]), mode = "function", sys.frame(-n - 1)) + } else { + f <- get(functionCall, mode = "function", sys.frame(-n - 1)) } - f <- get(functionName, mode = "function", sys.frame(-n - 1)) + cl <- match.call(definition = f, call = cl) if (isTRUE(warn)) { @@ -58,6 +60,7 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { return(extendedComment) } +# this exists only for testing purposes testPrepExtendedComment <- function() { return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) } diff --git a/tests/testthat/test-prepExtendedComment.R b/tests/testthat/test-prepExtendedComment.R index 2f6a416..761e260 100644 --- a/tests/testthat/test-prepExtendedComment.R +++ b/tests/testthat/test-prepExtendedComment.R @@ -1,5 +1,6 @@ test_that("prepExtendedComment works in functions called via package::fun", { - expect_identical(madrat:::testPrepExtendedComment()[1:2], + # need to run in separate R session to make sure madrat is not attached / loaded via load_all + expect_identical(callr::r(function() madrat:::testPrepExtendedComment()[1:2]), c(" description: example", " unit: m")) }) From 7b1ebc5fe5b91ca5c9dbf5ea2bcc2b0f1aa723af Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Mon, 11 Nov 2024 16:01:16 +0100 Subject: [PATCH 3/8] only support ::, not ::: --- NAMESPACE | 1 + R/prepExtendedComment.R | 10 +++++++--- man/dot-testPrepExtendedComment.Rd | 11 +++++++++++ tests/testthat/test-prepExtendedComment.R | 2 +- 4 files changed, 20 insertions(+), 4 deletions(-) create mode 100644 man/dot-testPrepExtendedComment.Rd diff --git a/NAMESPACE b/NAMESPACE index 949b8da..e8b2fd4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(.testPrepExtendedComment) export(addMapping) export(cacheCleanup) export(cacheCopy) diff --git a/R/prepExtendedComment.R b/R/prepExtendedComment.R index 7357760..a0f111c 100644 --- a/R/prepExtendedComment.R +++ b/R/prepExtendedComment.R @@ -25,7 +25,7 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { # if readSource is called as madrat::readSource functionName will # be in this unintuitive order c("::", "madrat", "readSource") - if (length(functionCall) == 3 && functionCall[[1]] %in% c("::", ":::")) { + if (length(functionCall) == 3 && functionCall[[1]] == "::") { f <- get(functionCall[[3]], envir = loadNamespace(functionCall[[2]]), mode = "function", sys.frame(-n - 1)) } else { f <- get(functionCall, mode = "function", sys.frame(-n - 1)) @@ -60,7 +60,11 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { return(extendedComment) } -# this exists only for testing purposes -testPrepExtendedComment <- function() { +#' .testPrepExtendedComment +#' +#' This function exists only for testing purposes. +#' +#' @export +.testPrepExtendedComment <- function() { return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) } diff --git a/man/dot-testPrepExtendedComment.Rd b/man/dot-testPrepExtendedComment.Rd new file mode 100644 index 0000000..e42a12f --- /dev/null +++ b/man/dot-testPrepExtendedComment.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prepExtendedComment.R +\name{.testPrepExtendedComment} +\alias{.testPrepExtendedComment} +\title{.testPrepExtendedComment} +\usage{ +.testPrepExtendedComment() +} +\description{ +This function exists only for testing purposes. +} diff --git a/tests/testthat/test-prepExtendedComment.R b/tests/testthat/test-prepExtendedComment.R index 761e260..e378dc6 100644 --- a/tests/testthat/test-prepExtendedComment.R +++ b/tests/testthat/test-prepExtendedComment.R @@ -1,6 +1,6 @@ test_that("prepExtendedComment works in functions called via package::fun", { # need to run in separate R session to make sure madrat is not attached / loaded via load_all - expect_identical(callr::r(function() madrat:::testPrepExtendedComment()[1:2]), + expect_identical(callr::r(function() madrat::.testPrepExtendedComment()[1:2]), c(" description: example", " unit: m")) }) From 4fbb6426f0ccbf796173ae7ffa9139b44e78619b Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Tue, 12 Nov 2024 10:04:56 +0100 Subject: [PATCH 4/8] Revert "only support ::, not :::" This reverts commit 7b1ebc5fe5b91ca5c9dbf5ea2bcc2b0f1aa723af. --- NAMESPACE | 1 - R/prepExtendedComment.R | 10 +++------- man/dot-testPrepExtendedComment.Rd | 11 ----------- tests/testthat/test-prepExtendedComment.R | 2 +- 4 files changed, 4 insertions(+), 20 deletions(-) delete mode 100644 man/dot-testPrepExtendedComment.Rd diff --git a/NAMESPACE b/NAMESPACE index e8b2fd4..949b8da 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(.testPrepExtendedComment) export(addMapping) export(cacheCleanup) export(cacheCopy) diff --git a/R/prepExtendedComment.R b/R/prepExtendedComment.R index a0f111c..7357760 100644 --- a/R/prepExtendedComment.R +++ b/R/prepExtendedComment.R @@ -25,7 +25,7 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { # if readSource is called as madrat::readSource functionName will # be in this unintuitive order c("::", "madrat", "readSource") - if (length(functionCall) == 3 && functionCall[[1]] == "::") { + if (length(functionCall) == 3 && functionCall[[1]] %in% c("::", ":::")) { f <- get(functionCall[[3]], envir = loadNamespace(functionCall[[2]]), mode = "function", sys.frame(-n - 1)) } else { f <- get(functionCall, mode = "function", sys.frame(-n - 1)) @@ -60,11 +60,7 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { return(extendedComment) } -#' .testPrepExtendedComment -#' -#' This function exists only for testing purposes. -#' -#' @export -.testPrepExtendedComment <- function() { +# this exists only for testing purposes +testPrepExtendedComment <- function() { return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) } diff --git a/man/dot-testPrepExtendedComment.Rd b/man/dot-testPrepExtendedComment.Rd deleted file mode 100644 index e42a12f..0000000 --- a/man/dot-testPrepExtendedComment.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/prepExtendedComment.R -\name{.testPrepExtendedComment} -\alias{.testPrepExtendedComment} -\title{.testPrepExtendedComment} -\usage{ -.testPrepExtendedComment() -} -\description{ -This function exists only for testing purposes. -} diff --git a/tests/testthat/test-prepExtendedComment.R b/tests/testthat/test-prepExtendedComment.R index e378dc6..761e260 100644 --- a/tests/testthat/test-prepExtendedComment.R +++ b/tests/testthat/test-prepExtendedComment.R @@ -1,6 +1,6 @@ test_that("prepExtendedComment works in functions called via package::fun", { # need to run in separate R session to make sure madrat is not attached / loaded via load_all - expect_identical(callr::r(function() madrat::.testPrepExtendedComment()[1:2]), + expect_identical(callr::r(function() madrat:::testPrepExtendedComment()[1:2]), c(" description: example", " unit: m")) }) From 047270e9b90a5b85d71bf5d25144ab9d715d21c7 Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Tue, 12 Nov 2024 10:57:18 +0100 Subject: [PATCH 5/8] use functionCallString in toolstartmessage and prepExtendedComment --- R/calcOutput.R | 10 ++++--- R/prepExtendedComment.R | 34 +++++------------------ R/readSource.R | 10 ++++--- R/toolstartmessage.R | 15 +++++----- tests/testthat/test-prepExtendedComment.R | 6 ---- 5 files changed, 27 insertions(+), 48 deletions(-) delete mode 100644 tests/testthat/test-prepExtendedComment.R diff --git a/R/calcOutput.R b/R/calcOutput.R index f9a7b86..addb5ab 100644 --- a/R/calcOutput.R +++ b/R/calcOutput.R @@ -114,6 +114,8 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli saveCache <- isWrapperActive("saveCache") setWrapperInactive("saveCache") + callString <- functionCallString("calcOutput", argumentValues) + if (!is.null(na_warning)) { warning('Argument "na_warning" is deprecated. Please use "warnNA" instead!') warnNA <- na_warning @@ -129,7 +131,7 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli if (!is.character(type)) stop("Invalid type (must be a character)!") if (length(type) != 1) stop("Invalid type (must be a single character string)!") - .checkData <- function(x, functionname) { + .checkData <- function(x, functionname, callString) { if (!is.list(x)) { stop("Output of function \"", functionname, "\" is not list of two MAgPIE objects containing the values and corresponding weights!") @@ -262,7 +264,7 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli x <- cacheGet(prefix = "calc", type = type, args = args) if (!is.null(x)) { - x <- try(.checkData(x, functionname), silent = TRUE) + x <- try(.checkData(x, functionname, callString), silent = TRUE) if ("try-error" %in% class(x)) { vcat(2, " - cache file corrupt for ", functionname, show_prefix = FALSE) x <- NULL @@ -282,7 +284,7 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli x <- withMadratLogging(eval(parse(text = functionname))) } setWrapperInactive("wrapperChecks") - x <- .checkData(x, functionname) + x <- .checkData(x, functionname, callString) cachePut(x, prefix = "calc", type = type, args = args) } @@ -307,7 +309,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, ] } - extendedComment <- prepExtendedComment(x, type) + extendedComment <- prepExtendedComment(x, type, callString) if (!isFALSE(aggregate)) { diff --git a/R/prepExtendedComment.R b/R/prepExtendedComment.R index 7357760..9615cc1 100644 --- a/R/prepExtendedComment.R +++ b/R/prepExtendedComment.R @@ -6,33 +6,12 @@ #' @md #' @param x list containing the metadata to be condensed #' @param type output type, e.g. "TauTotal" +#' @param functionCallString A string representation of the function call +#' that created the object this comment is attached to #' @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) - functionCall <- as.character(cl[[1]]) - - # if readSource is called as madrat::readSource functionName will - # be in this unintuitive order c("::", "madrat", "readSource") - if (length(functionCall) == 3 && functionCall[[1]] %in% c("::", ":::")) { - f <- get(functionCall[[3]], envir = loadNamespace(functionCall[[2]]), mode = "function", sys.frame(-n - 1)) - } else { - f <- get(functionCall, mode = "function", sys.frame(-n - 1)) - } - - cl <- match.call(definition = f, call = cl) - +#' @author Jan Philipp Dietrich, Pascal Sauer +prepExtendedComment <- function(x, type, functionCallString, warn = TRUE) { if (isTRUE(warn)) { unitWarning <- paste0('Missing unit information for data set "', type, '"!') descriptionWarning <- paste0('Missing description for data set "', type, @@ -45,7 +24,7 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { 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 = "")), + origin <- prepComment(paste0(gsub("\\s{2,}", " ", functionCallString), " (madrat ", unname(getNamespaceVersion("madrat")), " | ", x$package, ")"), "origin") date <- prepComment(date(), "creation date") @@ -62,5 +41,6 @@ prepExtendedComment <- function(x, type = "#undefined", warn = TRUE, n = 1) { # this exists only for testing purposes testPrepExtendedComment <- function() { - return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) + return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"), + "someType", "madrat:::testPrepExtendedComment()")) } diff --git a/R/readSource.R b/R/readSource.R index 5042552..64cd304 100644 --- a/R/readSource.R +++ b/R/readSource.R @@ -56,6 +56,8 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_ setWrapperActive("readSource") setWrapperInactive("wrapperChecks") + callString <- functionCallString("readSource", argumentValues) + withr::local_dir(getConfig("mainfolder")) startinfo <- toolstartmessage("readSource", argumentValues, "+") withr::defer({ @@ -113,7 +115,7 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_ } # get data either from cache or by calculating it from source - .getData <- function(type, subtype, subset, args, prefix) { + .getData <- function(type, subtype, subset, args, prefix, callString) { sourcefolder <- getSourceFolder(type, subtype) xList <- .getFromCache(prefix, type, args, subtype, subset) @@ -129,7 +131,7 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_ } else { upstreamPrefix <- "read" } - xList <- .getData(type, subtype, subset, args, upstreamPrefix) + xList <- .getData(type, subtype, subset, args, upstreamPrefix, callString) # this x is passed to correct or convert function x <- xList$x } @@ -173,7 +175,7 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_ } } - extendedComment <- prepExtendedComment(xList, type, n = 2, warn = FALSE) + extendedComment <- prepExtendedComment(xList, type, callString, warn = FALSE) if (xList$class == "magpie") { getComment(xList$x) <- extendedComment } else { @@ -254,7 +256,7 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_ stop('Unknown convert setting "', convert, '" (allowed: TRUE, FALSE and "onlycorrect")') } - xList <- .getData(type, subtype, subset, args, prefix) + xList <- .getData(type, subtype, subset, args, prefix, callString) if (magclass::is.magpie(xList$x)) { xList$x <- clean_magpie(xList$x) } diff --git a/R/toolstartmessage.R b/R/toolstartmessage.R index 6d0cfb8..4f398d9 100644 --- a/R/toolstartmessage.R +++ b/R/toolstartmessage.R @@ -27,9 +27,15 @@ #' } #' outerFunction() toolstartmessage <- function(functionName, argumentValues, level = NULL) { - setWrapperInactive("wrapperChecks") + functionCallString <- functionCallString(functionName, argumentValues) + + vcat(1, "Run ", functionCallString, level = level, fill = 300, show_prefix = FALSE) + return(list(time1 = proc.time(), functionCallString = functionCallString)) +} + +functionCallString <- function(functionName, argumentValues) { nonDefaultArguments <- getNonDefaultArguments(functionName, argumentValues) argsString <- paste0(list(nonDefaultArguments)) # wrap everything in list for nicer string output argsString <- substr(argsString, 6, nchar(argsString) - 1) # remove superfluous list from string @@ -37,17 +43,12 @@ toolstartmessage <- function(functionName, argumentValues, level = NULL) { callWithEvaluatedArgs <- paste0(functionName, "(", argsString, ")") if (nchar(callWithEvaluatedArgs) <= getConfig("maxLengthLogMessage")) { functionCallString <- callWithEvaluatedArgs - hint <- "" } else { functionCallString <- paste0(deparse(sys.call(-1)), collapse = "") if (nchar(functionCallString) > getConfig("maxLengthLogMessage")) { functionCallString <- paste0(substr(callWithEvaluatedArgs, 1, getConfig("maxLengthLogMessage") - 3), "...") } - hint <- paste0(" -- to print all evaluated arguments: setConfig(maxLengthLogMessage = ", - nchar(callWithEvaluatedArgs), ")") } - - vcat(1, "Run ", functionCallString, hint, level = level, fill = 300, show_prefix = FALSE) - return(list(time1 = proc.time(), functionCallString = functionCallString)) + return(functionCallString) } diff --git a/tests/testthat/test-prepExtendedComment.R b/tests/testthat/test-prepExtendedComment.R deleted file mode 100644 index 761e260..0000000 --- a/tests/testthat/test-prepExtendedComment.R +++ /dev/null @@ -1,6 +0,0 @@ -test_that("prepExtendedComment works in functions called via package::fun", { - # need to run in separate R session to make sure madrat is not attached / loaded via load_all - expect_identical(callr::r(function() madrat:::testPrepExtendedComment()[1:2]), - c(" description: example", - " unit: m")) -}) From 296b9a91164b1692ba3e1688edc156e271685031 Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Tue, 12 Nov 2024 11:01:06 +0100 Subject: [PATCH 6/8] test comment origin --- tests/testthat/test-readSource.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-readSource.R b/tests/testthat/test-readSource.R index da0ec5d..9799dc6 100644 --- a/tests/testthat/test-readSource.R +++ b/tests/testthat/test-readSource.R @@ -124,7 +124,9 @@ test_that("read functions can handle metadata", { expect_identical(getFromComment(x, "description"), "Metadata Test 2") expect_identical(getFromComment(x, "unit"), "ton") expect_null(getFromComment(x, "NonExisting")) - + expect_true(startsWith(getFromComment(x, "origin"), + "readSource(type = \"MetadataTest\", convert = \"onlycorrect\") (madrat ")) + expect_true(endsWith(getFromComment(x, "origin"), " | .GlobalEnv)")) }) From 31fc6c10c5ab93144dcc9bb60db8038eda3ed85d Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Tue, 12 Nov 2024 11:53:57 +0100 Subject: [PATCH 7/8] callstring arg for toolstartmessage --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- R/calcOutput.R | 2 +- R/downloadSource.R | 2 +- R/functionCallString.R | 29 +++++++++++++++++++++++++++++ R/prepExtendedComment.R | 6 ------ R/pucAggregate.R | 2 +- R/readSource.R | 2 +- R/retrieveData.R | 6 ++++-- R/toolstartmessage.R | 29 ++++------------------------- man/functionCallString.Rd | 25 +++++++++++++++++++++++++ man/prepExtendedComment.Rd | 17 +++++------------ man/toolstartmessage.Rd | 10 ++++------ 14 files changed, 78 insertions(+), 58 deletions(-) create mode 100644 R/functionCallString.R create mode 100644 man/functionCallString.Rd diff --git a/.buildlibrary b/.buildlibrary index dc17937..408a1db 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '63179814' +ValidationKey: '63182967' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index c8c903c..5ffc546 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -3,7 +3,7 @@ message: If you use this software, please cite it using the metadata from this f type: software title: 'madrat: May All Data be Reproducible and Transparent (MADRaT) *' version: 3.15.3 -date-released: '2024-11-11' +date-released: '2024-11-12' 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 diff --git a/DESCRIPTION b/DESCRIPTION index 282a433..3e5ab2c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: madrat Title: May All Data be Reproducible and Transparent (MADRaT) * Version: 3.15.3 -Date: 2024-11-11 +Date: 2024-11-12 Authors@R: c( person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = c("aut", "cre"), comment = c(affiliation = "Potsdam Institute for Climate Impact Research", ORCID = "0000-0002-4309-6431")), diff --git a/R/calcOutput.R b/R/calcOutput.R index addb5ab..2196b8d 100644 --- a/R/calcOutput.R +++ b/R/calcOutput.R @@ -249,7 +249,7 @@ calcOutput <- function(type, aggregate = TRUE, file = NULL, years = NULL, # noli vcat(-2, "") } - startinfo <- toolstartmessage("calcOutput", argumentValues, "+") + startinfo <- toolstartmessage(callString, "+") defer({ toolendmessage(startinfo, "-") }) diff --git a/R/downloadSource.R b/R/downloadSource.R index d88f68b..caaeb4d 100644 --- a/R/downloadSource.R +++ b/R/downloadSource.R @@ -50,7 +50,7 @@ downloadSource <- function(type, subtype = NULL, overwrite = FALSE, numberOfTrie setWrapperActive("downloadSource") setWrapperInactive("wrapperChecks") - startinfo <- toolstartmessage("downloadSource", argumentValues, "+") + startinfo <- toolstartmessage(functionCallString("downloadSource", argumentValues), "+") defer({ toolendmessage(startinfo, "-") }) diff --git a/R/functionCallString.R b/R/functionCallString.R new file mode 100644 index 0000000..0c640e9 --- /dev/null +++ b/R/functionCallString.R @@ -0,0 +1,29 @@ +#' functionCallString +#' +#' Create a string representation for a function call. If the resulting string +#' is longer than getConfig("maxLengthLogMessage") arguments are printed as +#' passed (e.g. as variable name instead of the evaluated content of that +#' variable), if that is still too long it is cropped. +#' +#' @param functionName name of the called function +#' @param argumentValues the list of arguments passed +#' @return A string representing the given function call +#' +#' @author Pascal Sauer +functionCallString <- function(functionName, argumentValues) { + nonDefaultArguments <- getNonDefaultArguments(functionName, argumentValues) + argsString <- paste0(list(nonDefaultArguments)) # wrap everything in list for nicer string output + argsString <- substr(argsString, 6, nchar(argsString) - 1) # remove superfluous list from string + + callWithEvaluatedArgs <- paste0(functionName, "(", argsString, ")") + if (nchar(callWithEvaluatedArgs) <= getConfig("maxLengthLogMessage")) { + functionCallString <- callWithEvaluatedArgs + } else { + functionCallString <- paste0(deparse(sys.call(-1)), collapse = "") + if (nchar(functionCallString) > getConfig("maxLengthLogMessage")) { + functionCallString <- paste0(substr(callWithEvaluatedArgs, 1, + getConfig("maxLengthLogMessage") - 3), "...") + } + } + return(functionCallString) +} diff --git a/R/prepExtendedComment.R b/R/prepExtendedComment.R index 9615cc1..9f327e9 100644 --- a/R/prepExtendedComment.R +++ b/R/prepExtendedComment.R @@ -38,9 +38,3 @@ prepExtendedComment <- function(x, type, functionCallString, warn = TRUE) { date) return(extendedComment) } - -# this exists only for testing purposes -testPrepExtendedComment <- function() { - return(prepExtendedComment(list(unit = "m", description = "example", package = "blub"), - "someType", "madrat:::testPrepExtendedComment()")) -} diff --git a/R/pucAggregate.R b/R/pucAggregate.R index 4ba387f..6a73dcc 100644 --- a/R/pucAggregate.R +++ b/R/pucAggregate.R @@ -38,7 +38,7 @@ pucAggregate <- function(puc, regionmapping = getConfig("regionmapping"), ..., r setWrapperActive("pucAggregate") extraArgs <- list(...) - startinfo <- toolstartmessage("pucAggregate", argumentValues, "+") + startinfo <- toolstartmessage(functionCallString("pucAggregate", argumentValues), "+") puc <- normalizePath(puc) if (file.exists(regionmapping)) regionmapping <- normalizePath(regionmapping) diff --git a/R/readSource.R b/R/readSource.R index 64cd304..ea6d1f6 100644 --- a/R/readSource.R +++ b/R/readSource.R @@ -59,7 +59,7 @@ readSource <- function(type, subtype = NULL, subset = NULL, # nolint: cyclocomp_ callString <- functionCallString("readSource", argumentValues) withr::local_dir(getConfig("mainfolder")) - startinfo <- toolstartmessage("readSource", argumentValues, "+") + startinfo <- toolstartmessage(callString, "+") withr::defer({ toolendmessage(startinfo, "-") }) diff --git a/R/retrieveData.R b/R/retrieveData.R index efbb2f8..7c95450 100644 --- a/R/retrieveData.R +++ b/R/retrieveData.R @@ -63,6 +63,8 @@ retrieveData <- function(model, rev = 0, dev = "", cachetype = "def", puc = iden setWrapperActive("saveCache") setWrapperInactive("wrapperChecks") + callString <- functionCallString("retrieveData", argumentValues) + local_options(madratWarningsCounter = 0) if (!(cachetype %in% c("rev", "def"))) { @@ -81,7 +83,7 @@ retrieveData <- function(model, rev = 0, dev = "", cachetype = "def", puc = iden matchingCollections <- .match(getConfig("outputfolder"), "tgz", cfg$collectionName) if (length(matchingCollections) > 0) { - startinfo <- toolstartmessage("retrieveData", argumentValues, 0) + startinfo <- toolstartmessage(callString, 0) vcat(-2, " - data is already available and not calculated again.", fill = 300) toolendmessage(startinfo) return(invisible(file.path(getConfig("outputfolder"), matchingCollections))) @@ -133,7 +135,7 @@ retrieveData <- function(model, rev = 0, dev = "", cachetype = "def", puc = iden vcat(3, paste(c("sessionInfo:", capture.output(sessionInfo()), "\n"), collapse = "\n")) # run full* functions - startinfo <- toolstartmessage("retrieveData", argumentValues, 0) + startinfo <- toolstartmessage(callString, 0) vcat(2, " - execute function ", cfg$functionName, fill = 300, show_prefix = FALSE) diff --git a/R/toolstartmessage.R b/R/toolstartmessage.R index 4f398d9..133a3c6 100644 --- a/R/toolstartmessage.R +++ b/R/toolstartmessage.R @@ -3,8 +3,7 @@ #' This function writes a process start message (what function was called with which arguments) and stores the current #' time, so the corresponding call to \code{\link{toolendmessage}} can calculate the elapsed time. #' -#' @param functionName The name of the calling function as a string. -#' @param argumentValues A list of the evaluated arguments of the calling function. +#' @param functionCallString A string representing the function call that should be logged #' @param level This argument allows to establish a hierarchy of print statements. The hierarchy is preserved for the #' next vcat executions. Currently this setting can have 4 states: NULL (nothing will be changed), 0 (reset #' hierarchies), "+" (increase hierarchy level by 1) and "-" (decrease hierarchy level by 1). @@ -15,40 +14,20 @@ #' @examples #' #' innerFunction <- function() { -#' startinfo <- madrat:::toolstartmessage("innerFunction", list(argumentsToPrint = 123), "+") +#' startinfo <- madrat:::toolstartmessage("innerFunction(argumentsToPrint = 123)", "+") #' vcat(1, "inner") #' madrat:::toolendmessage(startinfo, "-") #' } #' outerFunction <- function() { -#' startinfo <- madrat:::toolstartmessage("outerFunction", list(), "+") +#' startinfo <- madrat:::toolstartmessage("outerFunction()", "+") #' vcat(1, "outer") #' innerFunction() #' madrat:::toolendmessage(startinfo, "-") #' } #' outerFunction() -toolstartmessage <- function(functionName, argumentValues, level = NULL) { +toolstartmessage <- function(functionCallString, level = NULL) { setWrapperInactive("wrapperChecks") - functionCallString <- functionCallString(functionName, argumentValues) - vcat(1, "Run ", functionCallString, level = level, fill = 300, show_prefix = FALSE) return(list(time1 = proc.time(), functionCallString = functionCallString)) } - -functionCallString <- function(functionName, argumentValues) { - nonDefaultArguments <- getNonDefaultArguments(functionName, argumentValues) - argsString <- paste0(list(nonDefaultArguments)) # wrap everything in list for nicer string output - argsString <- substr(argsString, 6, nchar(argsString) - 1) # remove superfluous list from string - - callWithEvaluatedArgs <- paste0(functionName, "(", argsString, ")") - if (nchar(callWithEvaluatedArgs) <= getConfig("maxLengthLogMessage")) { - functionCallString <- callWithEvaluatedArgs - } else { - functionCallString <- paste0(deparse(sys.call(-1)), collapse = "") - if (nchar(functionCallString) > getConfig("maxLengthLogMessage")) { - functionCallString <- paste0(substr(callWithEvaluatedArgs, 1, - getConfig("maxLengthLogMessage") - 3), "...") - } - } - return(functionCallString) -} diff --git a/man/functionCallString.Rd b/man/functionCallString.Rd new file mode 100644 index 0000000..e298670 --- /dev/null +++ b/man/functionCallString.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/functionCallString.R +\name{functionCallString} +\alias{functionCallString} +\title{functionCallString} +\usage{ +functionCallString(functionName, argumentValues) +} +\arguments{ +\item{functionName}{name of the called function} + +\item{argumentValues}{the list of arguments passed} +} +\value{ +A string representing the given function call +} +\description{ +Create a string representation for a function call. If the resulting string +is longer than getConfig("maxLengthLogMessage") arguments are printed as +passed (e.g. as variable name instead of the evaluated content of that +variable), if that is still too long it is cropped. +} +\author{ +Pascal Sauer +} diff --git a/man/prepExtendedComment.Rd b/man/prepExtendedComment.Rd index 4b6cd12..650d860 100644 --- a/man/prepExtendedComment.Rd +++ b/man/prepExtendedComment.Rd @@ -4,30 +4,23 @@ \alias{prepExtendedComment} \title{prepExtendedComment} \usage{ -prepExtendedComment(x, type = "#undefined", warn = TRUE, n = 1) +prepExtendedComment(x, type, functionCallString, warn = TRUE) } \arguments{ \item{x}{list containing the metadata to be condensed} \item{type}{output type, e.g. "TauTotal"} +\item{functionCallString}{A string representation of the function call +that created the object this comment is attached to} + \item{warn}{boolean indicating whether warnings should be triggered if entries are missing, or not.} - -\item{n}{the number of functions to go back for the extraction of the call -information} } \description{ Helper function condense metadata information into an extended comment entry -} -\examples{ -test <- function(a = 1) { - return(madrat:::prepExtendedComment(list(unit = "m", description = "example", package = "blub"))) -} -test(a = 42) - } \author{ -Jan Philipp Dietrich +Jan Philipp Dietrich, Pascal Sauer } diff --git a/man/toolstartmessage.Rd b/man/toolstartmessage.Rd index bba8e6c..73f1995 100644 --- a/man/toolstartmessage.Rd +++ b/man/toolstartmessage.Rd @@ -4,12 +4,10 @@ \alias{toolstartmessage} \title{Tool: Start message} \usage{ -toolstartmessage(functionName, argumentValues, level = NULL) +toolstartmessage(functionCallString, level = NULL) } \arguments{ -\item{functionName}{The name of the calling function as a string.} - -\item{argumentValues}{A list of the evaluated arguments of the calling function.} +\item{functionCallString}{A string representing the function call that should be logged} \item{level}{This argument allows to establish a hierarchy of print statements. The hierarchy is preserved for the next vcat executions. Currently this setting can have 4 states: NULL (nothing will be changed), 0 (reset @@ -25,12 +23,12 @@ time, so the corresponding call to \code{\link{toolendmessage}} can calculate th \examples{ innerFunction <- function() { - startinfo <- madrat:::toolstartmessage("innerFunction", list(argumentsToPrint = 123), "+") + startinfo <- madrat:::toolstartmessage("innerFunction(argumentsToPrint = 123)", "+") vcat(1, "inner") madrat:::toolendmessage(startinfo, "-") } outerFunction <- function() { - startinfo <- madrat:::toolstartmessage("outerFunction", list(), "+") + startinfo <- madrat:::toolstartmessage("outerFunction()", "+") vcat(1, "outer") innerFunction() madrat:::toolendmessage(startinfo, "-") From 83bda514bdcbfcbec5ab54515a09c44e3491a418 Mon Sep 17 00:00:00 2001 From: Pascal Sauer <156898545+pascal-sauer@users.noreply.github.com> Date: Wed, 13 Nov 2024 09:49:55 +0100 Subject: [PATCH 8/8] dev version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3e5ab2c..6da517e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: madrat Title: May All Data be Reproducible and Transparent (MADRaT) * -Version: 3.15.3 +Version: 3.15.2.9001 Date: 2024-11-12 Authors@R: c( person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = c("aut", "cre"),