diff --git a/.buildlibrary b/.buildlibrary index d1aad52..8fc6ec6 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '338810' +ValidationKey: '398600' 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 a07249c..c1321dd 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'gdx2: Interface package for GDX files in R' -version: 0.1.7 +version: 0.2.0 date-released: '2024-07-26' abstract: A wrapper package for the gamstransfer package extending its functionality and allowing to read GDX files directly in R. It is emulating the basic features diff --git a/DESCRIPTION b/DESCRIPTION index 91878d9..163c232 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: gdx2 Title: Interface package for GDX files in R -Version: 0.1.7 +Version: 0.2.0 Date: 2024-07-26 Authors@R: c( person("Jan Philipp", "Dietrich", email = "dietrich@pik-potsdam.de", diff --git a/R/readGDX.R b/R/readGDX.R index 0cc74fd..ad2c78c 100644 --- a/R/readGDX.R +++ b/R/readGDX.R @@ -71,50 +71,37 @@ readGDX <- function(gdx, ..., format = "simplest", react = "warning", # nolint: followAlias = FALSE, spatial = NULL, temporal = NULL, magpieCells = TRUE, select = NULL, restoreZeros = TRUE, addAttributes = TRUE) { - formats <- c(f = "first_found", first_found = "first_found", - s = "simple", simple = "simple", - st = "simplest", simplest = "simplest", - r = "raw", raw = "raw", - n = "name", name = "name") - if (!is.character(format)) stop("format setting is not a character!") - if (is.na(formats[format])) stop("unknown format \"", format, "\"") - format <- formats[format] - - allPatterns <- c(...) - if (length(allPatterns) == 0) { - if (format == "first_found") { - stop("For format \"first_found\" you have to explicitly give all possible ", - "names of the object you would like to read in!") - } - allPatterns <- "*" - } - # translate name patterns in standard regular expression syntax - allPatterns <- paste("^", gsub("*", ".*", allPatterns, fixed = TRUE), "$", sep = "") + format <- .formatFormat(format) - items <- names(gamstransfer::readGDX(gdx, records = FALSE)) + selectedItems <- .expandPattern(c(...), gdx, format, react) - selectedItems <- NULL - for (p in allPatterns) { - selectedItems <- c(selectedItems, grep(p, items, value = TRUE)) - if (format == "first_found" && length(selectedItems) > 0) break - } - - if (length(selectedItems) == 0) { - if (react == "warning") warning("No element of ", paste(c(...), collapse = ", "), " found in GDX! NULL returned") - if (react == "error") stop("No element of ", paste(c(...), collapse = ", "), " found in GDX!") - return(NULL) - } + if (!is.null(selectedItems) && selectedItems == "###NOMATCH###") return(NULL) if (anyDuplicated(selectedItems)) { warning("Item(s) selected more than once, but will only be read once!") selectedItems <- unique(selectedItems) } - if (format == "name") return(selectedItems) - x <- gamstransfer::readGDX(gdx, selectedItems) - x <- x[selectedItems] + if (is.null(selectedItems)) { + x <- gamstransfer::readGDX(gdx) + } else { + x <- NULL + for (s in selectedItems) { + tmp <- try(gamstransfer::readGDX(gdx, s), silent = TRUE) + if (inherits(tmp, "try-error")) { + if (react == "warning" && format != "first_found") warning(tmp) + if (react == "error" && format != "first_found") stop(tmp) + } else if (format == "first_found") { + x <- tmp + break + } else { + x <- c(x, tmp) + } + } + } + for (i in seq_along(x)) { d <- x[[i]]$description m <- x[[i]][!(names(x[[i]]) %in% c("records", "description"))] @@ -183,3 +170,45 @@ readGDX <- function(gdx, ..., format = "simplest", react = "warning", # nolint: return(x) } + +.formatFormat <- function(format) { + formats <- c(f = "first_found", first_found = "first_found", + s = "simple", simple = "simple", + st = "simplest", simplest = "simplest", + r = "raw", raw = "raw", + n = "name", name = "name") + if (!is.character(format)) stop("format setting is not a character!") + if (is.na(formats[format])) stop("unknown format \"", format, "\"") + return(formats[format]) +} + +.expandPattern <- function(allPatterns, gdx, format, react) { + if (length(allPatterns) == 0) { + if (format == "first_found") { + stop("For format \"first_found\" you have to explicitly give all possible ", + "names of the object you would like to read in!") + } + return(NULL) + } + if (!all(grepl("*", allPatterns, fixed = TRUE))) return(allPatterns) + + # translate name patterns in standard regular expression syntax + patterns <- paste("^", gsub("*", ".*", allPatterns, fixed = TRUE), "$", sep = "") + + items <- names(gamstransfer::readGDX(gdx, records = FALSE)) + + selectedItems <- NULL + for (p in patterns) { + selectedItems <- c(selectedItems, grep(p, items, value = TRUE)) + if (format == "first_found" && length(selectedItems) > 0) break + } + + if (length(selectedItems) == 0) { + if (react == "warning") warning("No element of ", paste(allPatterns, collapse = ", "), + " found in GDX! NULL returned") + if (react == "error") stop("No element of ", paste(allPatterns, collapse = ", "), + " found in GDX!") + return("###NOMATCH###") + } + return(selectedItems) +} diff --git a/README.md b/README.md index a248443..1227c18 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Interface package for GDX files in R -R package **gdx2**, version **0.1.7** +R package **gdx2**, version **0.2.0** [![CRAN status](https://www.r-pkg.org/badges/version/gdx2)](https://cran.r-project.org/package=gdx2) [![R build status](https://github.com/pik-piam/gdx2/workflows/check/badge.svg)](https://github.com/pik-piam/gdx2/actions) [![codecov](https://codecov.io/gh/pik-piam/gdx2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/gdx2) [![r-universe](https://pik-piam.r-universe.dev/badges/gdx2)](https://pik-piam.r-universe.dev/builds) @@ -40,7 +40,7 @@ In case of questions / problems please contact Jan Philipp Dietrich . +Dietrich J (2024). _gdx2: Interface package for GDX files in R_. R package version 0.2.0, . A BibTeX entry for LaTeX users is @@ -49,7 +49,7 @@ A BibTeX entry for LaTeX users is title = {gdx2: Interface package for GDX files in R}, author = {Jan Philipp Dietrich}, year = {2024}, - note = {R package version 0.1.7}, + note = {R package version 0.2.0}, url = {https://github.com/pik-piam/gdx2}, } ```