Merge branch 'master' into JOSS

PIK-LPJmL · Jul 11, 2023 · 897eaa7 · 897eaa7
2 parents b9f4413 + db240bb
commit 897eaa7
Show file tree

Hide file tree

Showing 16 changed files with 133 additions and 271 deletions.
diff --git a/.buildlibrary b/.buildlibrary
@@ -1,4 +1,4 @@
-ValidationKey: '2247560'
+ValidationKey: '2287233'
 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.5
-date-released: '2023-07-06'
+version: 1.1.7
+date-released: '2023-07-11'
 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.5
+Version: 1.1.7
 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")),
@@ -40,15 +40,18 @@ Imports:
     abind,
     rlang,
     withr,
-    grDevices
+    grDevices,
+    cli,
+    stringi
 Suggests:
     rmarkdown,
     knitr,
     testthat (>= 3.0.0),
     terra,
     raster,
     reshape2,
-    maps
+    maps,
+    sf
 Config/testthat/edition: 3
 VignetteBuilder: knitr
-Date: 2023-07-06
+Date: 2023-07-11
diff --git a/R/LPJmLData.R b/R/LPJmLData.R
@@ -203,41 +203,26 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
     #' See also \link[base]{print}.
     print = function() {
 
-      # Set color higlighting
-      blue_col <- "\u001b[34m"
-      unset_col <- "\u001b[0m"
-
       # Print meta data
-      cat(paste0("\u001b[1m", blue_col, "$meta |>", unset_col, "\n"))
+      cat(paste0(bold_head(col_var("$meta |>"))[1], "\n"))
       private$.meta$print(all = FALSE, spaces = "  .")
 
       # Not all meta data are printed
-      cat(paste0("\u001b[33;3m",
-                 "Note: not printing all meta data, use $meta to get all.",
-                 unset_col,
-                 "\n"))
+      cat(
+        col_note("Note: not printing all meta data, use $meta to get all.\n")
+      )
 
       # Print grid only if available
       if (!is.null(private$.grid)) {
-        cat(paste0("\u001b[1m\u001b[31m",
-                   "$grid",
-                   unset_col,
-                   "\u001b[31m",
-                   " ...",
-                   unset_col,
-                   "\n"))
+        cat(col_var(paste0(bold_head("$grid")[1], " ...", "\n")))
       }
 
       # Print data attribute
-      cat(paste0("\u001b[1m",
-                 blue_col,
-                 "$data |>",
-                 unset_col,
-                 "\n"))
+      cat(bold_head("$data |>\n")[1])
 
       # Dimnames
       dim_names <- self$dimnames()
-      cat(paste0(blue_col, "  dimnames() |>", unset_col, "\n"))
+      cat(col_var("  dimnames() |>\n"))
 
       for (sub in seq_along(dim_names)) {
         to_char2 <- ifelse(is.character(dim_names[[sub]]), "\"", "")
@@ -255,23 +240,23 @@ LPJmLData <- R6::R6Class( # nolint:object_name_linter
           abbr_dim_names <- paste0(to_char2, dim_names[[sub]], to_char2)
         }
 
-        cat("  ",
-            blue_col,
-            paste0(".$", names(dim_names[sub])),
-            unset_col,
-            abbr_dim_names)
+        cat(
+          "  ",
+          col_var(
+            paste0(".$", names(dim_names[sub]))
+          ),
+          abbr_dim_names
+        )
         cat("\n")
       }
 
       # Summary
-      cat(paste0(blue_col, "$summary()", unset_col, "\n"))
+      cat(col_var("$summary()\n"))
       print(self$summary(cutoff = TRUE))
 
       if (class(self)[1] == "LPJmLData") {
-        cat(paste0("\u001b[33;3m",
-                   "Note: summary is not weighted by grid area.",
-                   unset_col,
-                   "\n")
+        cat(
+          col_note("Note: summary is not weighted by grid area.\n")
         )
       }
     },
@@ -442,12 +427,9 @@ aggregate_array <- function(x,
       dim_names <- names(dim(data))
 
       if (!idx_name %in% dim_names) {
-        warning(paste0("\u001b[0m",
-                       "Dimension ",
-                       "\u001b[34m",
-                       idx_name,
-                       "\u001b[0m",
-                       " does not exist."))
+        warning("Dimension ",
+                col_var(idx_name),
+                " does not exist.")
         next
 
       } else if (dims[idx_name] == 1) {

diff --git a/R/LPJmLData_plot.R b/R/LPJmLData_plot.R
@@ -109,23 +109,14 @@ LPJmLData$set("private", # nolint:cyclocomp_linter.
                                    time_dims,
                                    "band"))) {
     stop(
-      "\u001b[0m",
       "Undefined aggregation dimension ",
-      "\u001b[34m",
-      paste0(names(aggregate), collapse = ", "),
-      "\u001b[0m",
+      paste0(col_var(names(aggregate)), collapse = ", "),
       " supplied.\nMust be one of ",
-      "\u001b[34m",
-      paste0(space_dims, collapse = ", "),
-      "\u001b[0m",
+      paste0(col_var(space_dims), collapse = ", "),
       ", ",
-      "\u001b[34m",
-      paste0(time_dims, collapse = ", "),
-      "\u001b[0m",
+      paste0(col_var(time_dims), collapse = ", "),
       " or ",
-      "\u001b[34m",
-      "band",
-      "\u001b[0m",
+      col_var("band"),
       ".\n"
     )
   }
@@ -173,9 +164,9 @@ LPJmLData$set("private", # nolint:cyclocomp_linter.
                aggregate = aggregate,
                dots = dots)
     message(
-      "\u001b[33;3m",
-      "Note: spatial aggregation is not weighted by grid area.",
-      "\u001b[0m"
+      col_note(
+        "Note: spatial aggregation is not weighted by grid area."
+      )
     )
 
   # Plot map(s) for temporal aggregation or aggregation by band
@@ -242,20 +233,15 @@ plot_lines <- function(lpjml_data, # nolint:cyclocomp_linter.
 
   if (length(which(dim(raw_data) > 2)) > 2) {
     stop(
-      "\u001b[0m",
       "Too many dimensions for 2D time series plot. Please reduce ",
-      "\u001b[34m",
-      paste0(dim_names, collapse = ", "),
-      "\u001b[0m",
+      paste0(col_var(dim_names), collapse = ", "),
       " to 2.\nMust be at least one temporal dimension (x axis) of ",
-      "\u001b[34m",
-      paste0(time_dims, collapse = ", "),
-      "\u001b[0m",
+      paste0(col_var(time_dims), collapse = ", "),
       ", and could be ",
-      "\u001b[34m",
-      "band",
-      "\u001b[0m ",
-      "or a temporal dimension, e.g. \u001b[34mmonth\u001b[0m for the y axis",
+      col_var("band"),
+      " or a temporal dimension, e.g. ",
+      col_var("month"),
+      " for the y axis",
       ".\n"
     )
   } else if (length(dim(raw_data)) < 2) {
@@ -270,9 +256,7 @@ plot_lines <- function(lpjml_data, # nolint:cyclocomp_linter.
        any(space_dims %in% names(aggregate)))) {
     stop(
       "At least one temporal dimension of ",
-      "\u001b[34m",
-       paste0(time_dims, collapse = ", "),
-       "\u001b[0m",
+       paste0(col_var(time_dims), collapse = ", "),
        " has to be provided by the data."
       )
   }
@@ -340,37 +324,20 @@ plot_lines <- function(lpjml_data, # nolint:cyclocomp_linter.
   # Check if a supported plot type is supplied.
   if (dots$type %in% c("h", "S", "s")) {
     stop(
-      "\u001b[0m",
       "Unsupported plot type ",
-      "\u001b[34m",
-      dots$type,
-      "\u001b[0m",
+      col_var(dots$type),
       " supplied.\nMust be one of ",
-      "\u001b[34m",
-      "p",
-      "\u001b[0m",
-      ", ",
-      "\u001b[34m",
-      "l",
-      "\u001b[0m",
+      col_var("p"),
       ", ",
-      "\u001b[34m",
-      "b",
-      "\u001b[0m",
+      col_var("l"),
       ", ",
-      "\u001b[34m",
-      "c",
-      "\u001b[0m",
+      col_var("b"),
       ", ",
-      "\u001b[34m",
-      "o",
-      "\u001b[0m",
+      col_var("c"),
       ", ",
-      "\u001b[0m",
-      " or ",
-      "\u001b[34m",
-      "n",
-      "\u001b[0m",
+      col_var("o"),
+      ", or ",
+      col_var("n"),
       "."
     )
   }

diff --git a/R/LPJmLData_stats.R b/R/LPJmLData_stats.R
@@ -110,11 +110,13 @@ LPJmLData$set("private",
 
       if (dim(mat_sum)[2] > 16 && cutoff) {
         message(
-          "\u001b[33;3m",
-          "Note: not printing all ",
-          dimension,
-          "s summary, use $summary() or summary() to get all.",
-          "\u001b[0m"
+          col_note(
+            paste0(
+              "Note: not printing all ",
+              dimension,
+              "s summary, use $summary() or summary() to get all."
+            )
+          )
         )
 
         mat_sum[, seq_len(16)] %>%

diff --git a/R/LPJmLData_subset.R b/R/LPJmLData_subset.R
@@ -64,15 +64,9 @@ LPJmLData$set("private",
     # Function to throw error if subset dimension does not fit the format
     stop_format <- function(subset_dim, format) {
       stop(
-        "\u001b[34m",
-        paste0(subset_dim, collapse = ", "),
-        "\u001b[0m",
+        paste0(col_var(subset_dim), collapse = ", "),
         " is defined as subset, but x has the wrong format. Use ",
-        "\u001b[34m",
-        "transform(to = \"",
-        format,
-        "\")",
-        "\u001b[0m",
+        col_var(paste0("transform(to = \"", format, "\")")),
         " to convert into suitable format.",
         call. = FALSE
       )

diff --git a/R/LPJmLData_transform.R b/R/LPJmLData_transform.R
@@ -80,20 +80,19 @@ LPJmLData$set("private",
 
     if (length(to) > 0) {
       stop(
-        "\u001b[0m",
         ifelse(length(to) > 1, "Formats ", "Format "),
-        "\u001b[34m",
-        paste0(to, collapse = ", "),
-        "\u001b[0m",
+        paste0(col_var(to), collapse = ", "),
         ifelse(length(to) > 1, " are ", " is "),
         "not valid. Please choose from available space formats ",
-        "\u001b[34m",
-        paste0(private$.meta$._dimension_map_$space_format, collapse = ", "),
-        "\u001b[0m",
+        paste0(
+          col_var(private$.meta$._dimension_map_$space_format),
+          collapse = ", "
+        ),
         " and available time formats ",
-        "\u001b[34m",
-        paste0(private$.meta$._dimension_map_$time_format, collapse = ", "),
-        "\u001b[0m.",
+        paste0(
+          col_var(private$.meta$._dimension_map_$time_format),
+          collapse = ", "
+        ),
         call. = FALSE
       )
     }

diff --git a/R/LPJmLGridData.R b/R/LPJmLGridData.R
@@ -141,17 +141,18 @@ LPJmLGridData <- R6::R6Class( # nolint:object_name_linter
     #' See also \link[base]{print}
     print = function() {
 
-      unset_col <- "\u001b[0m"
-
       # Print LPJmLData class
       super$print()
 
-      cat(paste0("\u001b[33;3m",
-                 ifelse(private$.meta$._space_format_ == "cell",
-                        "Note: only min & max printed as equivalent to spatial extent.", # nolint
-                        "Note: inverted grid (cell as value)! Only min & max printed for sequence of cells."), # nolint
-                 unset_col,
-                 "\n"))
+      cat(
+        col_note(
+          ifelse(
+            private$.meta$._space_format_ == "cell",
+            "Note: only min & max printed as equivalent to spatial extent.\n", # nolint
+            "Note: inverted grid (cell as value)! Only min & max printed for sequence of cells.\n"
+          )
+        )
+      )
     }
   ),
   private = list(