fix match dimnames check; subset read cftfrac

PIK-LPJmL · Jul 18, 2024 · db6d84f · db6d84f
1 parent 8600667
commit db6d84f
Show file tree

Hide file tree

Showing 7 changed files with 18 additions and 17 deletions.
diff --git a/.buildlibrary b/.buildlibrary
@@ -1,4 +1,4 @@
-ValidationKey: '796840'
+ValidationKey: '796880'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'

diff --git a/CITATION.cff b/CITATION.cff
@@ -3,7 +3,7 @@ message: If you use this software, please cite it using the metadata from this f
 type: software
 title: 'lpjmlstats: Statistical tools for LPJmL data analysis'
 version: 0.4.0
-date-released: '2024-07-17'
+date-released: '2024-07-18'
 abstract: This package provides statistical tools for LPJmL data analysis to be used
   for benchmarking LPJmL outputs.
 authors:

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -44,4 +44,4 @@ Config/testthat/edition: 3
 VignetteBuilder: knitr
 Depends:
     R (>= 3.5.0)
-Date: 2024-07-17
+Date: 2024-07-18
diff --git a/R/LPJmLDataCalc.R b/R/LPJmLDataCalc.R
@@ -331,8 +331,8 @@ LPJmLDataCalc$set(
     # check for matching bandnames
     dimnames_to_match <- which(dim(sec_operand) > 1)
     if (length(dimnames_to_match) > 0)
-      if (!identical(dimnames(sec_operand)[[dimnames_to_match]],
-                     dimnames(self$data)[[dimnames_to_match]]))
+      if (!identical(dimnames(sec_operand)[dimnames_to_match],
+                     dimnames(self$data)[dimnames_to_match]))
         stop("Dimnames of second operand do not match first operator.")
 
     # the dimensions of "self" should stay

diff --git a/R/LPJmLDataCalc_aggregate.R b/R/LPJmLDataCalc_aggregate.R
@@ -429,7 +429,7 @@ LPJmLDataCalc$set(
   }
 )
 
-read_file <- function(searchdir, name, add_grid = TRUE) {
+read_file <- function(searchdir, name, add_grid = TRUE, ...) {
   # find path of file
   filename <- find_varfile(searchdir, name)
 
@@ -439,7 +439,7 @@ read_file <- function(searchdir, name, add_grid = TRUE) {
     " read from ",
     sQuote(basename(filename))
   ))
-  lpjml_calc <- read_io(filename)
+  lpjml_calc <- read_io(filename, ...)
 
   if (add_grid)
     lpjml_calc$add_grid()

diff --git a/R/Metric_subclasses.R b/R/Metric_subclasses.R
@@ -169,7 +169,7 @@ GlobSumTimeseries <- R6::R6Class( # nolint: object_name_linter.
                      num_cols = 2,
                      var_seperator = NULL,
                      band_seperator = NULL,
-                     year_subset = as.character(1901:2011)),
+                     year_subset = as.character(1901:2019)),
 
     #' @field title
     #' Section header used in the report
@@ -313,7 +313,7 @@ CellSubsetAnnAvgTimeseries <- # nolint: object_name_linter.
       m_options = list(
         font_size = 6,
         name_trunc = 1,
-        year_subset = as.character(1901:2011),
+        year_subset = as.character(1901:2019),
         num_cols = 2,
         var_seperator = NULL,
         band_seperator = NULL,
@@ -392,12 +392,12 @@ TimeAvgMap <- # nolint: object_name_linter.
       compare = function(var_grp) {
 
         var_grp$compare <-
-          list(diff_to_baseline = lapply(var_grp$under_test, function(x) {
+          list(diff2base = lapply(var_grp$under_test, function(x) {
             x - var_grp$baseline
           }))
 
-        # add grids for to all diff_to_baselines
-        lapply(var_grp$compare$diff_to_baseline, function(x) x$add_grid())
+        # add grids for to all diff2bases
+        lapply(var_grp$compare$diff2base, function(x) x$add_grid())
 
         var_grp$baseline <- NULL
         var_grp$under_test <- NULL
@@ -477,12 +477,12 @@ TimeAvgMapWithAbs <- # nolint: object_name_linter.
       compare = function(var_grp) {
 
         var_grp$compare <-
-          list(diff_to_baseline = lapply(var_grp$under_test, function(x) {
+          list(diff2base = lapply(var_grp$under_test, function(x) {
             x - var_grp$baseline
           }))
 
-        # add grids for to all diff_to_baselines
-        lapply(var_grp$compare$diff_to_baseline, function(x) x$add_grid())
+        # add grids for to all diff2bases
+        lapply(var_grp$compare$diff2base, function(x) x$add_grid())
       },
 
       #' @description
@@ -559,7 +559,8 @@ GlobSumTimeAvgTablePFT_harvest <- # nolint: object_name_linter.
       #' @param data LPJmLDataCalc object to be summarized
       summarize = function(data) {
         cft_frac <- read_file(data$meta$.__enclos_env__$private$.data_dir,
-                              "cftfrac")
+                              "cftfrac",
+                              subset = list(year = as.character(data$meta$firstyear:data$meta$lastyear)))
         cft_frac <- subset(cft_frac,
                            band = data$meta$band_names,
                            time = dimnames(data$data)[[2]])

diff --git a/R/plot_functions.R b/R/plot_functions.R
@@ -267,7 +267,7 @@ create_time_series_plots <- function(var_grp_list, m_options) {
         var_name <- var_grp_band$apply_to_any_lpjml_calc(function(x) x$meta$variable)
         plot_title <- paste_custom(
           ifelse(is.null(m_options$var_seperator), var_name, ""),
-          ifelse(is.null(m_options$band_seperator) & length(band_names), band, ""),
+          ifelse(is.null(m_options$band_seperator) && length(band_names) > 1, band, ""),
           ifelse(length(spatial_units) > 1, spatial_unit, ""),
           prettify_units(var_grp_band$baseline$meta$unit),
           sep = "; "