Merge branch 'fix_self_print_subset_attribute' into 'master'

change behaviour of self printing of subset attribute in LPJmLMetaData See merge request lpjml/lpjmlkit!82
PIK-LPJmL · Oct 9, 2023 · 48c995f · 48c995f
2 parents 0d0259f + e43f2b5
commit 48c995f
Show file tree

Hide file tree

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

diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml
@@ -1,5 +1,3 @@
-# Run CI for R using https://eddelbuettel.github.io/r-ci/
-
 name: check
 
 on:
@@ -8,92 +6,44 @@ on:
   pull_request:
     branches: [main, master]
 
-env:
-  USE_BSPM: "true"
-  _R_CHECK_FORCE_SUGGESTS_: "false"
-  NO_BINARY_INSTALL_R_PACKAGES: 'c("madrat", "magclass", "citation", "gms", "goxygen", "GDPuc", "roxygen2")'
-
 jobs:
   check:
     runs-on: ubuntu-latest
 
     steps:
       - uses: actions/checkout@v3
 
-      - name: Bootstrap
-        run: |
-          sudo chown runner -R .
-          sudo locale-gen en_US.UTF-8
-          sudo add-apt-repository -y ppa:ubuntugis/ppa
-          curl -OLs https://eddelbuettel.github.io/r-ci/run.sh
-          chmod 0755 run.sh
-          ./run.sh bootstrap
-          rm -f bspm_*.tar.gz
-
-      - name: Enable r-universe repo, modify bspm integration
-        run: |
-          # install packages from https://pik-piam.r-universe.dev and CRAN
-          echo '
-          options(repos = c(universe = "https://pik-piam.r-universe.dev",
-                            CRAN = "https://cloud.r-project.org"))
-          ' >> .Rprofile
-          cat .Rprofile
-          # modify bspm integration to never install binary builds of PIK CRAN packages
-          sudo sed -i '/bspm::enable()/d' /etc/R/Rprofile.site
-          # need double % because of printf, %s is replaced with "$NO_BINARY_INSTALL_R_PACKAGES" (see "env:" above)
-          printf '
-          local({
-            expr <- quote({
-              if (!is.null(repos)) {
-                noBinaryInstallRPackages <- %s
-                pkgs <- c(bspm::install_sys(pkgs[!pkgs %%in%% noBinaryInstallRPackages]),
-                          pkgs[pkgs %%in%% noBinaryInstallRPackages])
-              }
-              type <- "source"
-            })
-            trace(utils::install.packages, expr, print = FALSE)
-          })
-          ' "$NO_BINARY_INSTALL_R_PACKAGES" | sudo tee --append /etc/R/Rprofile.site >/dev/null
-          cat /etc/R/Rprofile.site
-
-      - name: Set up Pandoc
-        uses: r-lib/actions/setup-pandoc@v2
+      - uses: r-lib/actions/setup-pandoc@v2
 
-      - name: Set up Python 3.9
-        uses: actions/setup-python@v4
+      - uses: r-lib/actions/setup-r@v2
         with:
-          python-version: 3.9
+          use-public-rspm: true
+          extra-repositories: "https://rse.pik-potsdam.de/r/packages"
 
-      - name: Cache R libraries
-        if: ${{ !env.ACT }} # skip when running locally via nektos/act
-        uses: pat-s/always-upload-cache@v3
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: /usr/local/lib/R/
-          key: 3-${{ runner.os }}-usr-local-lib-R-${{ hashFiles('DESCRIPTION') }}
-          restore-keys: |
-            3-${{ runner.os }}-usr-local-lib-R-
-
-      - name: Restore R library permissions
-        run: |
-          sudo chmod 2777 /usr/local/lib/R /usr/local/lib/R/site-library
-
-      - name: Install dependencies
-        run: |
-          ./run.sh install_aptget libhdf5-dev libharfbuzz-dev libfribidi-dev
-          ./run.sh install_all
-          ./run.sh install_r_binary covr rstudioapi
-          ./run.sh install_r lucode2
+          extra-packages: |
+            any::lucode2
+            any::covr
+            any::madrat
+            any::magclass
+            any::citation
+            any::gms
+            any::goxygen
+            any::GDPuc
+          # piam packages also available on CRAN (madrat, magclass, citation,
+          # gms, goxygen, GDPuc) will usually have an outdated binary version
+          # available; by using extra-packages we get the newest version
+
+      - uses: actions/setup-python@v4
+        with:
+          python-version: 3.9
 
       - name: Install python dependencies if applicable
         run: |
           [ -f requirements.txt ] && python -m pip install --upgrade pip wheel || true
           [ -f requirements.txt ] && pip install -r requirements.txt || true
 
-      - name: Remove bspm integration # to get rid of error when running install.packages
-        run: |
-          sudo sed -i '/  trace(utils::install.packages, expr, print = FALSE)/d' /etc/R/Rprofile.site
-          cat /etc/R/Rprofile.site
-
       - name: Verify validation key
         shell: Rscript {0}
         run: lucode2:::validkey(stopIfInvalid = TRUE)

diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9013
+    rev: v0.3.2.9019
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

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.8
-date-released: '2023-07-18'
+version: 1.1.9
+date-released: '2023-10-06'
 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.8
+Version: 1.1.9
 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-07-18
+Date: 2023-10-06
diff --git a/R/LPJmLMetaData.R b/R/LPJmLMetaData.R
@@ -75,7 +75,7 @@ LPJmLMetaData <- R6::R6Class( # nolint
       cat(
         paste0(spaces,
                col_var(
-                paste0("$", print_fields)
+                 paste0("$", print_fields)
                ),
                " ",
                to_char1,
@@ -106,13 +106,14 @@ LPJmLMetaData <- R6::R6Class( # nolint
       )
       cat("\n")
 
+      # Print information about subset if subsetted
       cat(
         paste0(
           spaces,
           col_var("$subset"),
           " ",
           # Color red if subset.
-          ifelse(self$subset, col_warn(self$subset), ""),
+          ifelse(self$subset, col_warn(self$subset), self$subset),
           "\n"
         )
       )
@@ -170,7 +171,7 @@ LPJmLMetaData <- R6::R6Class( # nolint
       # Update cell fields - distinguish between character -> LPJmL C index
       #   starting from 0 and numeric/integer -> R index starting from 1 -> -1.
       if (!is.null(subset$cell) ||
-          !is.null(subset$lon) || !is.null(subset$lat)) {
+            !is.null(subset$lon) || !is.null(subset$lat)) {
 
         # Subset of subset$cell, subset$lon or subset$lat always have to be
         #   accompanied by cell_dimnames.
@@ -276,39 +277,39 @@ LPJmLMetaData <- R6::R6Class( # nolint
             "bigendian" = ifelse(x$endian == "big", TRUE, FALSE),
             # "descr" = tolower(x$name), # nolint
             "lastyear" = x$header[["firstyear"]] +
-                         x$header[["timestep"]] *
-                         (x$header[["nyear"]] - 1),
+              x$header[["timestep"]] *
+                (x$header[["nyear"]] - 1),
             "name" = ifelse(is.null(x$name), "LPJDUMMY", x$name)
           )) %>%
           `[[<-`("order",
-                switch(as.character(.$order),
-                       `1` = "cellyear",
-                       `2` = "yearcell",
-                       `3` = "cellindex",
-                       `4` = "cellseq",
-                       stop(
-                         paste(
-                           "Invalid order value", sQuote(.$order), "in header"
-                         )
-                       )
-                  )
-                ) %>%
+            switch(as.character(.$order),
+              `1` = "cellyear",
+              `2` = "yearcell",
+              `3` = "cellindex",
+              `4` = "cellseq",
+              stop(
+                paste(
+                  "Invalid order value", sQuote(.$order), "in header"
+                )
+              )
+            )
+          ) %>%
           `[[<-`("datatype",
-                switch(as.character(.$datatype),
-                       `0` = "byte",
-                       `1` = "short",
-                       `2` = "int",
-                       `3` = "float",
-                       `4` = "double",
-                       stop(
-                         paste(
-                           "Invalid datatype value", sQuote(.$datatype),
-                           "in header"
-                         )
-                       )
-                    )
+            switch(as.character(.$datatype),
+              `0` = "byte",
+              `1` = "short",
+              `2` = "int",
+              `3` = "float",
+              `4` = "double",
+              stop(
+                paste(
+                  "Invalid datatype value", sQuote(.$datatype),
+                  "in header"
                 )
-          private$init_list(header_to_meta, additional_attributes)
+              )
+            )
+          )
+        private$init_list(header_to_meta, additional_attributes)
 
       } else {
         private$init_list(x, additional_attributes)
@@ -574,19 +575,19 @@ LPJmLMetaData <- R6::R6Class( # nolint
         "filename"
       ) %>%
 
-      # Only append scalar if != 1
-      append(
-        ifelse(
-          !is.null(private$.scalar),
-          ifelse(private$.scalar == 1, "scalar", NA),
-          NA
-        )
-      ) %>%
+        # Only append scalar if != 1
+        append(
+          ifelse(
+            !is.null(private$.scalar),
+            ifelse(private$.scalar == 1, "scalar", NA),
+            NA
+          )
+        ) %>%
 
-      # Workaround to deal with NAs (NULL not possible in ifelse)
-      stats::na.omit() %>%
-      as.vector() %>%
-      return()
+        # Workaround to deal with NAs (NULL not possible in ifelse)
+        stats::na.omit() %>%
+        as.vector() %>%
+        return()
     },
 
     .sim_name = NULL,
@@ -681,8 +682,7 @@ LPJmLMetaData <- R6::R6Class( # nolint
                     "name",
                     "map",
                     "version",
-                    "offset"
-                   ),
+                    "offset"),
 
     .dimension_map = list(space_format = c("cell", "lon_lat"),
                           time_format = c("time", "year_month_day"),

diff --git a/R/read_io.R b/R/read_io.R
@@ -328,10 +328,10 @@ read_io <- function( # nolint:cyclocomp_linter.
   # Check file size
   expected_filesize <- unname(
     get_header_item(file_header, "ncell") *
-    get_header_item(file_header, "nbands") *
-    get_header_item(file_header, "nstep") *
-    get_header_item(file_header, "nyear") *
-    get_datatype(file_header)$size + start_offset
+      get_header_item(file_header, "nbands") *
+      get_header_item(file_header, "nstep") *
+      get_header_item(file_header, "nyear") *
+      get_datatype(file_header)$size + start_offset
   )
   if (file.size(filename) != expected_filesize) {
     stop(
@@ -345,9 +345,8 @@ read_io <- function( # nolint:cyclocomp_linter.
 
   # Check whether nbands may actually be nstep
   if (!silent && get_header_item(file_header, "version") < 4 &&
-    get_header_item(file_header, "nstep") == 1 &&
-    get_header_item(file_header, "nbands") %in% c(12, 365)
-  ) {
+        get_header_item(file_header, "nstep") == 1 &&
+        get_header_item(file_header, "nbands") %in% c(12, 365)) {
     message(
       "read_io: Detected \"nbands = ", get_header_item(file_header, "nbands"),
       "\" and \"nstep = 1\". If this is a ",
@@ -404,8 +403,7 @@ read_io_metadata_raw <- function(filename, file_type, band_names,
     firstyear = default(firstyear, 1901),
     nyear = default(nyear, 1),
     firstcell = default(firstcell, 0),
-    ncell = default(ncell, 67420), # Default: number of cells in global CRU
-                                   # grid
+    ncell = default(ncell, 67420), # Default: number of cells in global CRU grid
     nbands = default(nbands, 1),
     cellsize_lon = default(cellsize_lon, 0.5),
     # Default: resolution of global CRU grid
@@ -586,7 +584,7 @@ read_io_metadata_meta <- function(filename, file_type, band_names,
   }
 
   if (!"band_names" %in% set_args && is.null(meta_data$band_names) &&
-    !is.null(meta_data$map) && !is.null(nbands)
+      !is.null(meta_data$map) && !is.null(nbands)
   ) {
     if (length(meta_data$map) == nbands / 2) {
       # Create band_names from the map attribute that is included in meta data.
@@ -741,9 +739,7 @@ read_io_data <- function(
     )
 
     # Convert to read_band_order and apply subsetting along bands or cells
-    index <- which(!names(subset) %in%
-      c("day", "month", "year", "time")
-    )
+    index <- which(!names(subset) %in% c("day", "month", "year", "time"))
 
     year_data <- aperm(year_data, perm = read_band_order) %>%
       # Apply any subsetting along bands or cells
@@ -813,15 +809,15 @@ read_raw <- function(file_connection, data_offset, n_values, datatype, endian) {
 # Simple validity check for band_names
 check_band_names <- function(nbands, band_names) {
   if (!is.null(band_names) &&
-    length(band_names) != nbands
+      length(band_names) != nbands
   ) {
     stop(
       "Provided band_names ",
       toString(
         dQuote(
           if (length(band_names) > 6) {
-              c(utils::head(band_names, n = 4), "...",
-                utils::tail(band_names, n = 1))
+            c(utils::head(band_names, n = 4), "...",
+              utils::tail(band_names, n = 1))
           } else {
             band_names
           }
@@ -840,7 +836,7 @@ check_year_subset <- function(subset, meta_data, silent = FALSE) {
     if (is.numeric(subset[["year"]])) {
       outside_range <- which(
         as.integer(subset[["year"]]) < 1 |
-        as.integer(subset[["year"]]) > default(meta_data$nyear, 1)
+          as.integer(subset[["year"]]) > default(meta_data$nyear, 1)
       )
       if (length(outside_range) > 0) {
         stop(