From 5aa0dc1ed6999ec993907d04bebb0dc6a48d1581 Mon Sep 17 00:00:00 2001 From: David Hoetten Date: Tue, 9 Jul 2024 14:19:33 +0200 Subject: [PATCH] fix compare object, fix band plots, removed band name abbreviation --- R/LPJmLMetaDataCalc.R | 60 ------------------------------------------- R/MetricVarGrp.R | 1 + R/Metric_subclasses.R | 8 +++--- R/plot_functions.R | 15 +++++++---- 4 files changed, 15 insertions(+), 69 deletions(-) diff --git a/R/LPJmLMetaDataCalc.R b/R/LPJmLMetaDataCalc.R index 181979a..0ce3f35 100644 --- a/R/LPJmLMetaDataCalc.R +++ b/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) -} diff --git a/R/MetricVarGrp.R b/R/MetricVarGrp.R index 36ccd42..f179c43 100644 --- a/R/MetricVarGrp.R +++ b/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, ...) diff --git a/R/Metric_subclasses.R b/R/Metric_subclasses.R index a5704d7..0c87dc1 100644 --- a/R/Metric_subclasses.R +++ b/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), diff --git a/R/plot_functions.R b/R/plot_functions.R index e0c42aa..ddbad7e 100644 --- a/R/plot_functions.R +++ b/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