performance improvements

.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'

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

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 = "[email protected]", 

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)
+}

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@pi
 
 To cite package **gdx2** in publications use:
 
-Dietrich J (2024). _gdx2: Interface package for GDX files in R_. R package version 0.1.7, <URL: https://github.com/pik-piam/gdx2>.
+Dietrich J (2024). _gdx2: Interface package for GDX files in R_. R package version 0.2.0, <URL: https://github.com/pik-piam/gdx2>.
 
 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},
 }
 ```