fix compare object, fix band plots, removed band name abbreviation

R/LPJmLMetaDataCalc.R

@@ -54,8 +54,6 @@ LPJmLMetaDataCalc <- R6::R6Class( # nolint
       private$.time_aggregation <- agg_method
     },
 
-
-
     #' @description
     #' Wrapper for [`LPJmLMetaData`] print method.
     #' @param spaces string of spaces to be printed as prefix
@@ -133,7 +131,6 @@ LPJmLMetaDataCalc <- R6::R6Class( # nolint
     .__set_pos_in_var_grp__ = function(pos_in_var_grp) {
       private$.pos_in_var_grp <- pos_in_var_grp
     }
-
   ),
 
   active = list(
@@ -189,60 +186,3 @@ LPJmLMetaDataCalc <- R6::R6Class( # nolint
     .pos_in_var_grp = list("undefined position in var_grp")
   )
 )
-
-
-# NTODO: needs refactoring
-shorten_names <- function(names, trunc = 9) {
-
-  # find index until which all strings are equal
-  stop <- FALSE
-  i <- 0
-  while (stop == FALSE) {
-    i <- i + 1
-    if (length(unique(substr(
-      x = names,
-      start = 1,
-      stop = i
-    ))) > 1) {
-
-      stop <- TRUE
-    }
-
-    if (i > max(stringr::str_length(names))) {
-      stop <- TRUE
-    }
-  }
-  i <- i - 1
-
-  if (i > trunc + 9) {
-    front_parts <- names %>% stringr::str_sub(1, 4)
-    back_parts <- names %>% stringr::str_sub(max(i - 3, 6))
-    short_colnames <- paste0(front_parts, "[..]", back_parts)
-  } else {
-    short_colnames <- names
-  }
-
-  # find index from which all remaining truncated strings are unique
-  stop <- FALSE
-  i <- 0
-  while (stop == FALSE) {
-    i <- i + 1
-    if (length(unique(substr(
-      x = short_colnames,
-      start = 1,
-      stop = i
-    ))) == length(unique(short_colnames
-    ))) {
-
-      stop <- TRUE
-    }
-  }
-
-  trunc <- max(i + 6, trunc + 6)
-
-  short_colnames <- stringr::str_trunc(short_colnames, trunc, ellipsis = "[..]")
-
-  names(short_colnames) <- names
-
-  return(short_colnames)
-}

R/MetricVarGrp.R

@@ -313,6 +313,7 @@ VarGrp <- # nolint:object_linter_name
           self$under_test[[i]] <- fun_skip_null(self$under_test[[i]], fun, ...)
         }
         for (i in seq_along(self$compare)) {
+          compare <- self$compare[[i]]
           for (j in seq_along(compare)) {
             self$compare[[i]][[j]] <-
               fun_skip_null(self$compare[[i]][[j]], fun, ...)

R/Metric_subclasses.R

@@ -163,7 +163,7 @@ GlobSumTimeseries <- R6::R6Class( # nolint: object_name_linter.
     #' of years that the metric considers. Integer indices can be between 1
     #' and `nyear`. Character vector is used to subset by actual calendar
     #' years (starting at `firstyear`).
-    m_options = list(font_size = 7,
+    m_options = list(font_size = 6,
                      name_trunc = 1,
                      year_range = NULL),
 
@@ -304,7 +304,7 @@ CellSubsetAnnAvgTimeseries <- # nolint: object_name_linter.
       #' years (starting at `firstyear`).
       #' - `cell` cells to be subsetted
       m_options = list(
-        font_size = 7,
+        font_size = 6,
         name_trunc = 1,
         year_range = NULL,
         cell = 10000
@@ -353,7 +353,7 @@ CellSubsetTimeseries <- # nolint: object_name_linter.
       #' years (starting at `firstyear`).
       #' - `cell` cells to be subsetted
       m_options = list(
-        font_size = 7,
+        font_size = 6,
         name_trunc = 1,
         year_range = NULL,
         cell = 10000
@@ -441,7 +441,7 @@ TimeAvgMap <- # nolint: object_name_linter.
       #' and `nyear`. Character vector is used to subset by actual calendar
       #' years (starting at `firstyear`).
       m_options = list(
-        font_size = 7,
+        font_size = 6,
         name_trunc = 1,
         highlight = NULL,
         quantiles = c(0.05, 0.95),

R/plot_functions.R

@@ -4,6 +4,7 @@
 #' @importFrom rlang :=
 #' @importFrom tidyselect matches
 
+
 # ----- table plot -----
 
 create_table_plot <- function(var_grp_list, m_options) {
@@ -85,7 +86,6 @@ lpjml_calc_to_table <- function(lpjml_calc) {
 }
 
 
-
 # ----- map plot -----
 
 create_map_plots <- function(var_grp_list,
@@ -121,8 +121,9 @@ lpjml_calc_to_map <- function(lpjml_calc,
   plot_title <- paste(
     lpjml_calc$meta$var_and_band_disp,
     lpjml_calc$meta$sim_ident,
-    pos_in_var_grp$compare_item,
-    prettify_units(lpjml_calc$meta$unit)
+    ifelse(!is.null(pos_in_var_grp$compare_item), pos_in_var_grp$compare_item, " - "),
+    prettify_units(lpjml_calc$meta$unit),
+    sep = "; "
   )
   tibble <- lpjml_calc_to_map_tibble(lpjml_calc)
   plot <- map_tibble_to_ggplot(
@@ -241,7 +242,9 @@ lpjml_calc_to_map_tibble <- function(lpjml_calc) {
   return(tibble)
 }
 
+
 # ----- time series plot -----
+
 create_time_series_plots <- function(var_grp_list, m_options) {
   plot_list <- list()
   for (var_grp in var_grp_list) {
@@ -264,8 +267,9 @@ create_time_series_plots <- function(var_grp_list, m_options) {
           var_grp_band$apply_to_any_lpjml_calc(function(x) {
             x$meta$var_and_band_disp
           }),
-          ifelse(length(spatial_units) > 1, spatial_unit, ""),
-          prettify_units(var_grp_band$baseline$meta$unit)
+          ifelse(length(spatial_units) > 1, spatial_unit, " - "),
+          prettify_units(var_grp_band$baseline$meta$unit),
+          sep = "; "
         )
         tibble_list <-
           var_grp_band$apply_to_lpjml_calcs(lpjml_calc_to_timeseries_tibble)
@@ -337,6 +341,7 @@ lpjml_calc_to_timeseries_tibble <- function(lpjml_calc) {
   return(tibble)
 }
 
+
 # ------ utility functions ------
 
 # can be used if text is too long to fit on single line