Merge branch 'speedup_read_io' into 'master'

Speedup read io See merge request lpjml/lpjmlkit!84
PIK-LPJmL · Nov 27, 2023 · 13e6353 · 13e6353
2 parents cfad25c + ed85400
commit 13e6353
Show file tree

Hide file tree

Showing 13 changed files with 155 additions and 112 deletions.
diff --git a/.buildlibrary b/.buildlibrary
@@ -1,4 +1,4 @@
-ValidationKey: '2336684'
+ValidationKey: '2362200'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'

diff --git 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: 'lpjmlkit: Toolkit for Basic LPJmL Handling'
-version: 1.1.9
-date-released: '2023-10-06'
+version: 1.2.0
+date-released: '2023-11-24'
 abstract: A collection of basic functions to facilitate the work with the Dynamic
   Global Vegetation Model (DGVM) Lund-Potsdam-Jena managed Land (LPJmL) hosted at
   the Potsdam Institute for Climate Impact Research (PIK). It provides functions for

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: lpjmlkit
 Type: Package
 Title: Toolkit for Basic LPJmL Handling
-Version: 1.1.9
+Version: 1.2.0
 Authors@R: c(
     person("Jannes", "Breier", , "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9055-6904")),
     person("Sebastian","Ostberg", , "[email protected]", role = "aut", comment = c(ORCID = "0000-0002-2368-7015")),
@@ -54,4 +54,4 @@ Suggests:
     sf
 Config/testthat/edition: 3
 VignetteBuilder: knitr
-Date: 2023-10-06
+Date: 2023-11-24
diff --git a/R/LPJmLData.R b/R/LPJmLData.R
@@ -28,7 +28,6 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
     #'
     #' @param ... See [`add_grid()`].
     add_grid = function(...) {
-
       # Skip if grid is already attached
       if (!is.null(private$.grid)) {
         return(invisible(self))
@@ -52,15 +51,14 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
         #   does not say if cell is subsetted - but ok for now.
         if (private$.meta$._subset_space_) {
           lpjml_data <- read_io(
-              filename = filename,
-              subset = list(cell = self$dimnames()[["cell"]]),
-              silent = TRUE
-            )
+            filename = filename,
+            subset = list(cell = self$dimnames()[["cell"]]),
+            silent = TRUE
+          )
         } else {
           lpjml_data <- read_io(filename = filename, silent = TRUE)
         }
       } else {
-
         # All arguments have to be provided manually to read_io.
         #   Ellipsis (...) does that.
 
@@ -202,7 +200,6 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
     #' Method to print the `LPJmLData` object. \cr
     #' See also \link[base]{print}.
     print = function() {
-
       # Print meta data
       cat(paste0(bold_head(col_var("$meta |>"))[1], "\n"))
       private$.meta$print(all = FALSE, spaces = "  .")
@@ -228,13 +225,15 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
         to_char2 <- ifelse(is.character(dim_names[[sub]]), "\"", "")
 
         if (length(dim_names[[sub]]) > 6) {
-          abbr_dim_names <- paste0(c(paste0(to_char2,
-                                            dim_names[[sub]][1:4],
-                                            to_char2),
-                                   "...",
-                                   paste0(to_char2,
-                                          utils::tail(dim_names[[sub]], n = 1),
-                                          to_char2)))
+          abbr_dim_names <- paste0(c(
+            paste0(to_char2,
+                   dim_names[[sub]][1:4],
+                   to_char2),
+            "...",
+            paste0(to_char2,
+                   utils::tail(dim_names[[sub]], n = 1),
+                   to_char2)
+          ))
 
         } else {
           abbr_dim_names <- paste0(to_char2, dim_names[[sub]], to_char2)
@@ -300,7 +299,7 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
     initialize = function(data, meta_data = NULL) {
 
       if (methods::is(meta_data, "LPJmLMetaData") |
-          methods::is(meta_data, "NULL")) {
+          methods::is(meta_data, "NULL")) { #nolint:indentation_linter
         private$.meta <- meta_data
       } else {
         stop("Provide an LPJmLMetaData object for meta data.")
@@ -315,22 +314,24 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
   active = list(
 
     #' @field meta [`LPJmLMetaData`] object to store corresponding meta data.
-    meta = function() {
+    meta = function(...) {
+      check_change(self, "meta", ...)
       # Clone meta object so that if meta is changed outside of the LPJmLData
       #   instance it will not change this instance
       return(private$.meta$clone())
     },
 
     #' @field data \link[base]{array} containing the underlying data.
-    data = function() {
+    data = function(...) {
+      check_change(self, "data", ...)
       return(private$.data)
     },
 
     #' @field grid Optional `LPJmLData` object containing the underlying grid.
-    grid = function() {
+    grid = function(...) {
+      check_change(self, "grid", ...)
 
       if (!is.null(private$.grid)) {
-
         # Clone grid object so that if grid is changed outside of the LPJmLData
         #   instance it will not change this instance. `deep = TRUE` because
         #   grid includes another R6 class object (meta) which is another
@@ -397,7 +398,6 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
 #'
 #' # Add grid as attribute (via grid file in output directory)
 #' vegc_with_grid <- add_grid(vegc)
-#'
 #' }
 #'
 #' @md

diff --git a/R/LPJmLGridData.R b/R/LPJmLGridData.R
@@ -99,7 +99,8 @@ LPJmLGridData <- R6::R6Class( # nolint:object_name_linter
     #' @description
     #' !Internal method only to be used for package development!
     #'
-    #' @param lpjml_data LPJmLData object with variable `"grid"` or `"LPJGRID"`
+    #' @param lpjml_data LPJmLData object with variable `"grid"`, `"cellid"`
+    #'   or `"LPJGRID"`
     initialize = function(lpjml_data) {
 
       x <- lpjml_data$clone(deep = TRUE)
@@ -113,7 +114,7 @@ LPJmLGridData <- R6::R6Class( # nolint:object_name_linter
 
       if (!is.null(private$.meta$variable)) {
 
-        if (private$.meta$variable == "grid") {
+        if (private$.meta$variable %in% c("grid", "cellid")) {
           private$init_grid()
 
         } else if (private$.meta$variable == "LPJGRID") {