- some more bugfixes in readGDX

- preparation of calcScaling inclusion (not yet ready)

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '318864'
+ValidationKey: '338810'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

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: 'gdx2: Interface package for GDX files in R'
-version: 0.1.6
-date-released: '2024-07-25'
+version: 0.1.7
+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
   of the readGDX function in the gdx package but now based on gamstransfer instead

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: gdx2
 Title: Interface package for GDX files in R
-Version: 0.1.6
-Date: 2024-07-25
+Version: 0.1.7
+Date: 2024-07-26
 Authors@R: c(
     person("Jan Philipp", "Dietrich", email = "[email protected]", 
     comment = c(affiliation = "Potsdam Institute for Climate Impact Research", ORCID = "0000-0002-4309-6431"), role = c("aut","cre")))

R/calcScaling.R

@@ -0,0 +1,44 @@
+#' calcScaling
+#'
+#' This function creates a GAMS file with scaling of variables. The scaling is
+#' calculated based on a gdx file containing all variables of a run.
+#'
+#' @param gdx path to a gdx file
+#' @param file A file name the scaling GAMS code should be written to. If NULL
+#' the code is returned by the function
+#' @param magnitude The order of magnitude for which variables should be
+#' scaled. All variables with average absolute values which are either below
+#' 10e(-magnitude) or above 10e(magnitude) will be scaled.
+#' @return A vector with the scaling GAMS code if file=NULL, otherwise nothing
+#' is returned.
+#' @author Jan Philipp Dietrich
+#' @seealso \code{\link{readGDX}}
+#' @examples
+#' \dontrun{
+#' calcScaling("fulldata.gdx")
+#' }
+calcScaling <- function(gdx, file = NULL, magnitude = 2) {
+  v <- readGDX(gdx, types = "variables", field = "l")
+  out <- NULL
+  for (x in names(v)) {
+    # calculate order of magnitude (oof)
+    oof <- round(log10(mean(abs(v[[x]]))))
+    if (is.nan(oof)) oof <- 0
+    cat("\n oof =", oof, "  ", x)
+    if (length(attr(v[[x]], "gdxdata")$domains) == 0) {
+      sets <- ""
+    } else {
+      sets <- paste("(", paste(attr(v[[x]], "gdxdata")$domains, collapse = ","), ")", sep = "")
+    }
+    if (oof != -Inf && (oof < -1 * magnitude || oof > 1 * magnitude)) {
+      out <- c(out, paste(x, ".scale", sets, " = 10e", oof, ";", sep = ""))
+    }
+  }
+  cat("\n\n")
+
+  if (!is.null(file)) {
+    writeLines(out, file)
+  } else {
+    return(out)
+  }
+}

R/readGDX.R

@@ -35,6 +35,8 @@
 #' in does not exist. Available options are "warning" (NULL is returned and a
 #' warning is send that the object is missing), "silent" (NULL is returned, but
 #' no warning is given) and "error" (The function throws out an error)
+#' @param followAlias bolean deciding whether the alias or its linked set should be
+#' returned.
 #' @param spatial argument to determine the spatial columns in the dataframe to
 #' be converted to a magclass object. Defaults to NULL.
 #' See \code{\link[magclass]{as.magpie}} for more information.
@@ -66,7 +68,7 @@
 #' @export
 
 readGDX <- function(gdx, ..., format = "simplest", react = "warning", # nolint: cyclocomp_linter
-                    spatial = NULL, temporal = NULL, magpieCells = TRUE,
+                    followAlias = FALSE, spatial = NULL, temporal = NULL, magpieCells = TRUE,
                     select = NULL, restoreZeros = TRUE, addAttributes = TRUE) {
 
   formats <- c(f = "first_found", first_found = "first_found",
@@ -118,31 +120,45 @@ readGDX <- function(gdx, ..., format = "simplest", react = "warning", # nolint:
     m <- x[[i]][!(names(x[[i]]) %in% c("records", "description"))]
     if (format != "raw") {
       if (m$class == "Set") {
-        x[[i]] <- x[[i]]$records
-        if (dim(x[[i]])[2] == 2) x[[i]] <- as.vector(x[[i]][[1]])
-      } else if (m$class != "Alias") {
+        if (is.null(x[[i]]$records)) {
+          x[[i]] <- character(0)
+        } else {
+          x[[i]] <- x[[i]]$records
+          if (dim(x[[i]])[2] == 2) x[[i]] <- as.vector(x[[i]][[1]])
+        }
+      } else if (m$class == "Alias") {
+        if (followAlias) x[[i]] <- readGDX(gdx, x[[i]]$aliasWith, followAlias = TRUE)
+      } else {
         if (m$class == "Variable") {
           # convert data.table into long format
           .long <- function(x) {
             n <- c("level", "marginal", "lower", "upper", "scale")
             cn <- colnames(x)[!(colnames(x) %in% n)]
-            out <- rbind(x[cn], x[cn], x[cn], x[cn], x[cn])
-            out$"_field" <- rep(n, each = nrow(x))
+            if (length(cn) == 0) {
+              out <- data.frame("_field" = n, check.names = FALSE)
+            } else {
+              out <- rbind(x[cn], x[cn], x[cn], x[cn], x[cn])
+              out$"_field" <- rep(n, each = nrow(x))
+            }
             out$value <- unlist(x[n])
             return(out)
           }
           x[[i]]$records <- .long(x[[i]]$records)
         }
         if (restoreZeros && length(x[[i]]$domain) > 0) {
-          dimnames <- readGDX(gdx, x[[i]]$domain, format = "simple", addAttributes = FALSE)
-          if ("_field" %in% colnames(x[[i]]$records)) {
-            dimnames$"_field" <- c("level", "marginal", "lower", "upper", "scale")
-          }
-          out <- array(0, vapply(dimnames, length, 1), dimnames)
-          if (!is.null(x[[i]]$records)) {
-            out[as.matrix(x[[i]]$records[names(dimnames(out))])] <- x[[i]]$records[, ncol(x[[i]]$records)]
+          if ("*" %in% x[[i]]$domain) {
+            warning("Cannot restore zeros for ", names(x)[i], " as set dependency is not defined!")
+          } else {
+            dimnames <- readGDX(gdx, x[[i]]$domain, format = "simple", addAttributes = FALSE, followAlias = TRUE)
+            if ("_field" %in% colnames(x[[i]]$records)) {
+              dimnames$"_field" <- c("level", "marginal", "lower", "upper", "scale")
+            }
+            out <- array(0, vapply(dimnames, length, 1), dimnames)
+            if (!is.null(x[[i]]$records)) {
+              out[as.matrix(x[[i]]$records[names(dimnames(out))])] <- x[[i]]$records[, ncol(x[[i]]$records)]
+            }
+            x[[i]]$records <- out
           }
-          x[[i]]$records <- out
         }
         x[[i]] <- magclass::as.magpie(x[[i]]$records, spatial = spatial,
                                       temporal = temporal, tidy = TRUE)

README.md

@@ -1,8 +1,8 @@
 # Interface package for GDX files in R
 
-R package **gdx2**, version **0.1.6**
+R package **gdx2**, version **0.1.7**
 
-[![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) 
+[![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)
 
 ## Purpose and Functionality
 
@@ -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.6, <URL: https://github.com/pik-piam/gdx2>.
+Dietrich J (2024). _gdx2: Interface package for GDX files in R_. R package version 0.1.7, <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.6},
+  note = {R package version 0.1.7},
   url = {https://github.com/pik-piam/gdx2},
 }
 ```