From d3a5928cd63ed91dd3d4193af73f8fa56707ed89 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 16 Sep 2022 18:40:33 +0200 Subject: [PATCH 1/7] Development for PlotMostLikelyQuantileMap. Layout is designed for individual colorbar. --- R/PlotLayout.R | 54 +++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 51 insertions(+), 3 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 742478e..665daf8 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -545,7 +545,54 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, fsu <- figure_size_units <- 10 # unitless widths <- rep(fsu, ncol) heights <- rep(fsu, nrow) - n_figures <- nrow * ncol + # Useless +# n_figures <- nrow * ncol + + if (all(fun == 'PlotMostLikelyQuantileMap')) { + # Adjust layout + if (!'cat_dim' %in% names(list(...))) { + cat_dim <- 'bin' #default + } else { + cat_dim <- list(...)$cat_dim + } + nmap <- dim(var[[1]])[cat_dim] + + unit_layout <- matrix(c(rep(1, nmap),2:(nmap + 1)), 2, nmap, byrow = TRUE) + real_layout <- mat_layout[1, 1] + unit_layout - 1 + + if (layout_by_rows) { + if (ncol > 1) { + for (i_col in 2:ncol) { + real_layout <- cbind(real_layout, real_layout + nmap + 1) + } + } + if (nrow > 1) { + for (i_row in 2:nrow) { + real_layout <- rbind(real_layout, real_layout + ((nmap + 1) * ncol)) + } + } + } else { + if (nrow > 1) { + for (i_row in 2:nrow) { + real_layout <- rbind(real_layout, real_layout + nmap + 1) + } + } + if (ncol > 1) { + for (i_col in 2:ncol) { + real_layout <- cbind(real_layout, real_layout + ((nmap + 1) * nrow)) + } + } + } + mat_layout <- real_layout + + # Adjust widths and heights + ## The current widths and heights should be matrix(10, nrow, ncol) + ## unit_width is default 1 + widths <- rep(widths, nmap) + unit_height <- c(6, 1.5) / 7.5 * 10 # 6 for figure, 1.5 for colorbar in PlotMostLikelyQuantileMap + heights <- rep(unit_height, length(heights)) + } + if (length(row_titles) > 0) { mat_layout <- cbind(rep(0, dim(mat_layout)[1]), mat_layout) widths <- c(((subtitle_cex + subtitle_margin / 2) * cs / device_size[1]) * ncol * fsu, widths) @@ -568,7 +615,8 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, mat_layout <- cbind(mat_layout, rep(1, dim(mat_layout)[1])) widths <- c(widths, round(bar_scale * 3 * ncol)) } - n_figures <- n_figures + 1 + # Useless +# n_figures <- n_figures + 1 } if (toptitle != '') { mat_layout <- rbind(rep(0, dim(mat_layout)[2]), mat_layout) @@ -660,7 +708,7 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # Do the plot fun_args <- c(list(y, toptitle = titles[plot_number]), list(...), special_args[[array_number]]) - funct <- fun[[array_number]] +# funct <- fun[[array_number]] if (fun[[array_number]] %in% c('PlotEquiMap', 'PlotStereoMap', 'PlotSection')) { fun_args <- c(fun_args, list(brks = colorbar$brks, cols = colorbar$cols, col_inf = colorbar$col_inf, -- GitLab From 450df59b98edd314c37dfda315357d3dbcfc55d0 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Sep 2022 12:04:15 +0200 Subject: [PATCH 2/7] PlotMostLikelyQuantileMap works with PlotLayout (only drawleg = 'S'); colorbar is shared. --- R/PlotLayout.R | 133 +++++++++++++++++++++++++------------------------ 1 file changed, 67 insertions(+), 66 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 665daf8..e5ae980 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -540,7 +540,18 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, title_margin <- 0.5 * title_cex * title_margin_scale subtitle_cex <- 1.5 * subtitle_scale subtitle_margin <- 0.5 * sqrt(nrow * ncol) * subtitle_cex * subtitle_margin_scale - mat_layout <- 1:(nrow * ncol) + ifelse(drawleg != FALSE, 1, 0) + mat_layout <- 1:(nrow * ncol) + if (drawleg != FALSE) { + if (fun == 'PlotMostLikelyQuantileMap') { #multi_colorbar + multi_colorbar <- TRUE + cat_dim <- list(...)$cat_dim + nmap <- as.numeric(dim(var[[1]])[cat_dim]) + mat_layout <- mat_layout + nmap + } else { + multi_colorbar <- FALSE + mat_layout <- mat_layout + 1 + } + } mat_layout <- matrix(mat_layout, nrow, ncol, byrow = layout_by_rows) fsu <- figure_size_units <- 10 # unitless widths <- rep(fsu, ncol) @@ -548,65 +559,23 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # Useless # n_figures <- nrow * ncol - if (all(fun == 'PlotMostLikelyQuantileMap')) { - # Adjust layout - if (!'cat_dim' %in% names(list(...))) { - cat_dim <- 'bin' #default - } else { - cat_dim <- list(...)$cat_dim - } - nmap <- dim(var[[1]])[cat_dim] - - unit_layout <- matrix(c(rep(1, nmap),2:(nmap + 1)), 2, nmap, byrow = TRUE) - real_layout <- mat_layout[1, 1] + unit_layout - 1 - - if (layout_by_rows) { - if (ncol > 1) { - for (i_col in 2:ncol) { - real_layout <- cbind(real_layout, real_layout + nmap + 1) - } - } - if (nrow > 1) { - for (i_row in 2:nrow) { - real_layout <- rbind(real_layout, real_layout + ((nmap + 1) * ncol)) - } - } - } else { - if (nrow > 1) { - for (i_row in 2:nrow) { - real_layout <- rbind(real_layout, real_layout + nmap + 1) - } - } - if (ncol > 1) { - for (i_col in 2:ncol) { - real_layout <- cbind(real_layout, real_layout + ((nmap + 1) * nrow)) - } - } - } - mat_layout <- real_layout - - # Adjust widths and heights - ## The current widths and heights should be matrix(10, nrow, ncol) - ## unit_width is default 1 - widths <- rep(widths, nmap) - unit_height <- c(6, 1.5) / 7.5 * 10 # 6 for figure, 1.5 for colorbar in PlotMostLikelyQuantileMap - heights <- rep(unit_height, length(heights)) - } - - if (length(row_titles) > 0) { - mat_layout <- cbind(rep(0, dim(mat_layout)[1]), mat_layout) - widths <- c(((subtitle_cex + subtitle_margin / 2) * cs / device_size[1]) * ncol * fsu, widths) - } - if (length(col_titles) > 0) { - mat_layout <- rbind(rep(0, dim(mat_layout)[2]), mat_layout) - heights <- c(((subtitle_cex + subtitle_margin) * cs / device_size[2]) * nrow * fsu, heights) - } if (drawleg != FALSE) { if (drawleg == 'N') { mat_layout <- rbind(rep(1, dim(mat_layout)[2]), mat_layout) heights <- c(round(bar_scale * 2 * nrow), heights) } else if (drawleg == 'S') { - mat_layout <- rbind(mat_layout, rep(1, dim(mat_layout)[2])) + if (multi_colorbar) { + new_mat_layout <- c() + for (i_col in 1:ncol) { + new_mat_layout <- c(new_mat_layout, rep(mat_layout[, i_col], nmap)) + } + new_mat_layout <- matrix(new_mat_layout, nrow, nmap * ncol) + colorbar_row <- rep(1:nmap, each = ncol) + mat_layout <- rbind(new_mat_layout, as.numeric(colorbar_row)) + widths <- rep(widths, nmap) + } else { + mat_layout <- rbind(mat_layout, rep(1, dim(mat_layout)[2])) + } heights <- c(heights, round(bar_scale * 2 * nrow)) } else if (drawleg == 'W') { mat_layout <- cbind(rep(1, dim(mat_layout)[1]), mat_layout) @@ -618,6 +587,17 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # Useless # n_figures <- n_figures + 1 } + + # row and col titles + if (length(row_titles) > 0) { + mat_layout <- cbind(rep(0, dim(mat_layout)[1]), mat_layout) + widths <- c(((subtitle_cex + subtitle_margin / 2) * cs / device_size[1]) * ncol * fsu, widths) + } + if (length(col_titles) > 0) { + mat_layout <- rbind(rep(0, dim(mat_layout)[2]), mat_layout) + heights <- c(((subtitle_cex + subtitle_margin) * cs / device_size[2]) * nrow * fsu, heights) + } + # toptitle if (toptitle != '') { mat_layout <- rbind(rep(0, dim(mat_layout)[2]), mat_layout) heights <- c(((title_cex + title_margin) * cs / device_size[2]) * nrow * fsu, heights) @@ -630,13 +610,32 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, bar_extra_margin[2] <- bar_extra_margin[2] + (subtitle_cex + subtitle_margin / 2) * bar_left_shift_scale } - ColorBar(colorbar$brks, colorbar$cols, vertical, subsampleg, - bar_limits, var_limits, - triangle_ends = triangle_ends, col_inf = colorbar$col_inf, - col_sup = colorbar$col_sup, color_fun, plot = TRUE, draw_bar_ticks, - draw_separators, triangle_ends_scale, bar_extra_labels, - units, units_scale, bar_label_scale, bar_tick_scale, - bar_extra_margin, bar_label_digits) + + if (multi_colorbar) { # multiple colorbar + if (!is.null(list(...)$bar_titles)) { + bar_titles <- list(...)$bar_titles + } else { + bar_titles <- NULL + } + multi_ColorBar(nmap = nmap, + brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, + bar_limits = bar_limits, var_limits = var_limits, + triangle_ends = triangle_ends, plot = TRUE, + draw_separators = draw_separators, + bar_titles = bar_titles, title_scale = units_scale, + label_scale = bar_label_scale, extra_margin = bar_extra_margin) + + } else { # one colorbar + ColorBar(brks = colorbar$brks, cols = colorbar$cols, vertical = vertical, subsampleg = subsampleg, + bar_limits = bar_limits, var_limits = var_limits, + triangle_ends = triangle_ends, col_inf = colorbar$col_inf, + col_sup = colorbar$col_sup, color_fun = color_fun, plot = TRUE, draw_ticks = draw_bar_ticks, + draw_separators = draw_separators, triangle_ends_scale = triangle_ends_scale, + extra_labels = bar_extra_labels, + title = units, title_scale = units_scale, label_scale = bar_label_scale, tick_scale = bar_tick_scale, + extra_margin = bar_extra_margin, label_digits = bar_label_digits) + + } } # Draw titles @@ -705,15 +704,17 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # For each of the arrays provided in that array apply(x, (1:length(dim(x)))[-plot_dim_indices], function(y) { - # Do the plot - fun_args <- c(list(y, toptitle = titles[plot_number]), list(...), + # Do the plot. colorbar is not drew. + fun_args <- c(list(y, toptitle = titles[plot_number], drawleg = FALSE), list(...), special_args[[array_number]]) # funct <- fun[[array_number]] if (fun[[array_number]] %in% c('PlotEquiMap', 'PlotStereoMap', 'PlotSection')) { fun_args <- c(fun_args, list(brks = colorbar$brks, cols = colorbar$cols, col_inf = colorbar$col_inf, - col_sup = colorbar$col_sup, - drawleg = FALSE)) + col_sup = colorbar$col_sup)) + } else if (fun[[array_number]] %in% 'PlotMostLikelyQuantileMap') { + #TODO: pre-generate colorbar params? like above + fun_args <- c(fun_args, list(brks = brks, cols = cols)) } do.call(fun[[array_number]], fun_args) plot_number <<- plot_number + 1 -- GitLab From 6a11a9ae8bb42a81c53daf23ed95fdee7b9b821c Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 20 Sep 2022 14:51:05 +0200 Subject: [PATCH 3/7] Assign cat_dim default in PlotLayout --- R/PlotLayout.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index e5ae980..ee2c96b 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -545,6 +545,7 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, if (fun == 'PlotMostLikelyQuantileMap') { #multi_colorbar multi_colorbar <- TRUE cat_dim <- list(...)$cat_dim + if (is.null(cat_dim)) cat_dim <- 'bin' # default nmap <- as.numeric(dim(var[[1]])[cat_dim]) mat_layout <- mat_layout + nmap } else { -- GitLab From 233f2aa4a209afcb7c335b0a1d508b376a790aa5 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 11 Oct 2022 20:01:16 +0200 Subject: [PATCH 4/7] Modify ProbsColorBar --- R/PlotLayout.R | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 12df9f8..a5d2aed 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -550,11 +550,13 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, subtitle_margin <- 0.5 * sqrt(nrow * ncol) * subtitle_cex * subtitle_margin_scale mat_layout <- 1:(nrow * ncol) if (drawleg != FALSE) { - if (fun == 'PlotMostLikelyQuantileMap') { #multi_colorbar + if (all(fun %in% 'PlotMostLikelyQuantileMap')) { #multi_colorbar multi_colorbar <- TRUE cat_dim <- list(...)$cat_dim if (is.null(cat_dim)) cat_dim <- 'bin' # default nmap <- as.numeric(dim(var[[1]])[cat_dim]) + minimum_value <- ceiling(1 / nmap * 10 * 1.1) * 10 + display_range = c(minimum_value, 100) mat_layout <- mat_layout + nmap } else { multi_colorbar <- FALSE @@ -626,13 +628,13 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } else { bar_titles <- NULL } - multi_ColorBar(nmap = nmap, - brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, - bar_limits = bar_limits, var_limits = var_limits, - triangle_ends = triangle_ends, plot = TRUE, - draw_separators = draw_separators, - bar_titles = bar_titles, title_scale = units_scale, - label_scale = bar_label_scale, extra_margin = bar_extra_margin) + ProbsColorBar(nmap = nmap, display_range = display_range, + brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, + bar_limits = bar_limits, var_limits = var_limits, + triangle_ends = triangle_ends, plot = TRUE, + draw_separators = draw_separators, + bar_titles = bar_titles, title_scale = units_scale, + label_scale = bar_label_scale, extra_margin = bar_extra_margin) } else { # one colorbar ColorBar(brks = colorbar$brks, cols = colorbar$cols, vertical = vertical, subsampleg = subsampleg, -- GitLab From 1406c07f5a79c8b9ef0ae19af20382f0c8f13a5a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 11 Oct 2022 21:08:21 +0200 Subject: [PATCH 5/7] Change colorbar function name --- R/PlotLayout.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index a5d2aed..5a0ca9f 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -628,13 +628,13 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } else { bar_titles <- NULL } - ProbsColorBar(nmap = nmap, display_range = display_range, - brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, - bar_limits = bar_limits, var_limits = var_limits, - triangle_ends = triangle_ends, plot = TRUE, - draw_separators = draw_separators, - bar_titles = bar_titles, title_scale = units_scale, - label_scale = bar_label_scale, extra_margin = bar_extra_margin) + CatColorBar(nmap = nmap, + brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, + bar_limits = display_range, var_limits = var_limits, + triangle_ends = triangle_ends, plot = TRUE, + draw_separators = draw_separators, + bar_titles = bar_titles, title_scale = units_scale, + label_scale = bar_label_scale, extra_margin = bar_extra_margin) } else { # one colorbar ColorBar(brks = colorbar$brks, cols = colorbar$cols, vertical = vertical, subsampleg = subsampleg, -- GitLab From 56848b123069db5cc5af08d3ef75580b1caf63fa Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 13 Oct 2022 16:26:31 +0200 Subject: [PATCH 6/7] Put CatColorBar() in Utils.R (temporary) --- R/Utils.R | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) diff --git a/R/Utils.R b/R/Utils.R index c136914..756e994 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -1720,3 +1720,92 @@ return(anom) } + +#TODO: Remove from s2dv when PlotLayout can get colorbar info from plotting function directly. +# The function is temporarily here because PlotLayout() needs to draw the colorbars of +# PlotMostLikelyQuantileMap(). +#Draws Color Bars for Categories +#A wrapper of s2dv::ColorBar to generate multiple color bars for different +#categories, and each category has different color set. +CatColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, + bar_limits, var_limits = NULL, + triangle_ends = NULL, plot = TRUE, + draw_separators = FALSE, + bar_titles = NULL, title_scale = 1, label_scale = 1, extra_margin = rep(0, 4), + ...) { + # bar_limits + if (!is.numeric(bar_limits) || length(bar_limits) != 2) { + stop("Parameter 'bar_limits' must be a numeric vector of length 2.") + } + + # Check brks + if (is.null(brks) || (is.numeric(brks) && length(brks) == 1)) { + num_brks <- 5 + if (is.numeric(brks)) { + num_brks <- brks + } + brks <- seq(from = bar_limits[1], to = bar_limits[2], length.out = num_brks) + } + if (!is.numeric(brks)) { + stop("Parameter 'brks' must be a numeric vector.") + } + # Check cols + col_sets <- list(c("#A1D99B", "#74C476", "#41AB5D", "#238B45"), + c("#6BAED6FF", "#4292C6FF", "#2171B5FF", "#08519CFF"), + c("#FFEDA0FF", "#FED976FF", "#FEB24CFF", "#FD8D3CFF"), + c("#FC4E2AFF", "#E31A1CFF", "#BD0026FF", "#800026FF"), + c("#FCC5C0", "#FA9FB5", "#F768A1", "#DD3497")) + if (is.null(cols)) { + if (length(col_sets) >= nmap) { + chosen_sets <- 1:nmap + chosen_sets <- chosen_sets + floor((length(col_sets) - length(chosen_sets)) / 2) + } else { + chosen_sets <- array(1:length(col_sets), nmap) + } + cols <- col_sets[chosen_sets] + } else { + if (!is.list(cols)) { + stop("Parameter 'cols' must be a list of character vectors.") + } + if (!all(sapply(cols, is.character))) { + stop("Parameter 'cols' must be a list of character vectors.") + } + if (length(cols) != nmap) { + stop("Parameter 'cols' must be a list of the same length as the number of ", + "maps in 'maps'.") + } + } + for (i in 1:length(cols)) { + if (length(cols[[i]]) != (length(brks) - 1)) { + cols[[i]] <- grDevices::colorRampPalette(cols[[i]])(length(brks) - 1) + } + } + + # Check bar_titles + if (is.null(bar_titles)) { + if (nmap == 3) { + bar_titles <- c("Below normal (%)", "Normal (%)", "Above normal (%)") + } else if (nmap == 5) { + bar_titles <- c("Low (%)", "Below normal (%)", + "Normal (%)", "Above normal (%)", "High (%)") + } else { + bar_titles <- paste0("Cat. ", 1:nmap, " (%)") + } + } + + if (plot) { + for (k in 1:nmap) { + s2dv::ColorBar(brks = brks, cols = cols[[k]], vertical = FALSE, subsampleg = subsampleg, +# bar_limits = bar_limits, var_limits = var_limits, + triangle_ends = triangle_ends, plot = TRUE, + draw_separators = draw_separators, + title = bar_titles[[k]], title_scale = title_scale, + label_scale = label_scale, extra_margin = extra_margin) + } + } else { + #TODO: col_inf and col_sup + return(list(brks = brks, cols = cols)) + } + +} + -- GitLab From 800d4bdc0d505655615115fbaf29314e05260d93 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 14 Oct 2022 12:21:28 +0200 Subject: [PATCH 7/7] Change function name to GradientCatsColorBar --- R/PlotLayout.R | 14 +++++++------- R/Utils.R | 12 ++++++------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/R/PlotLayout.R b/R/PlotLayout.R index 5a0ca9f..c442bf7 100644 --- a/R/PlotLayout.R +++ b/R/PlotLayout.R @@ -628,13 +628,13 @@ PlotLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } else { bar_titles <- NULL } - CatColorBar(nmap = nmap, - brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, - bar_limits = display_range, var_limits = var_limits, - triangle_ends = triangle_ends, plot = TRUE, - draw_separators = draw_separators, - bar_titles = bar_titles, title_scale = units_scale, - label_scale = bar_label_scale, extra_margin = bar_extra_margin) + GradientCatsColorBar(nmap = nmap, + brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, + bar_limits = display_range, var_limits = var_limits, + triangle_ends = triangle_ends, plot = TRUE, + draw_separators = draw_separators, + bar_titles = bar_titles, title_scale = units_scale, + label_scale = bar_label_scale, extra_margin = bar_extra_margin) } else { # one colorbar ColorBar(brks = colorbar$brks, cols = colorbar$cols, vertical = vertical, subsampleg = subsampleg, diff --git a/R/Utils.R b/R/Utils.R index 756e994..c2c17eb 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -1727,12 +1727,12 @@ #Draws Color Bars for Categories #A wrapper of s2dv::ColorBar to generate multiple color bars for different #categories, and each category has different color set. -CatColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, - bar_limits, var_limits = NULL, - triangle_ends = NULL, plot = TRUE, - draw_separators = FALSE, - bar_titles = NULL, title_scale = 1, label_scale = 1, extra_margin = rep(0, 4), - ...) { +GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, + bar_limits, var_limits = NULL, + triangle_ends = NULL, plot = TRUE, + draw_separators = FALSE, + bar_titles = NULL, title_scale = 1, label_scale = 1, extra_margin = rep(0, 4), + ...) { # bar_limits if (!is.numeric(bar_limits) || length(bar_limits) != 2) { stop("Parameter 'bar_limits' must be a numeric vector of length 2.") -- GitLab