From df418bfbc9b2d6947539410b31e19cf10a9b8fc9 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 21 Oct 2024 17:39:25 +0200 Subject: [PATCH 1/8] Add parameters for including boundaries in ColorBarContinuous.R --- R/ColorBarContinuous.R | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index b7727ba..1bbaf27 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -109,6 +109,8 @@ #' labels of the colour bar, usually to avoid too many decimal digits #' overflowing the figure region. This does not have effect over the labels #' provided in 'extra_labels'. Takes 4 by default. +#'@param lower_boundary +#'@param upper_boundary #'@param ... Arguments to be passed to the method. Only accepts the following #' graphical parameters:\cr adj ann ask bg bty cex.lab cex.main cex.sub cin #' col.axis col.lab col.main col.sub cra crt csi cxy err family fg fig fin @@ -151,7 +153,8 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, triangle_ends_scale = 1, extra_labels = NULL, title = NULL, title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) { + extra_margin = rep(0, 4), label_digits = 4, + lower_boundary = TRUE, upper_boundary = TRUE, ...) { # Required checks if ((is.null(brks) || length(brks) < 2) && is.null(bar_limits) && is.null(var_limits)) { stop("At least one of 'brks' with the desired breaks, 'bar_limits' or ", @@ -188,6 +191,18 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'var_limits' must not contain infinite values.") } } + + # Check include_lower_boundary and include_upper_boundary + if (!is.null(lower_boundary)) { + if (!is.logical(lower_boundary) || length(lower_boundary) != 1) { + stop("Parameter 'lower_boundary' must be a logical element.") + } + } + if (!is.null(upper_boundary)) { + if (!is.logical(upper_boundary) || length(upper_boundary) != 1) { + stop("Parameter 'upper_boundary' must be a logical element.") + } + } # Check cols if (!is.null(cols)) { @@ -302,6 +317,16 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, "disabled. These will be painted in the colour for NA values.") } } + browser() + # Adjust var_limits based on lower_boundary and upper_boundary + if (!is.null(brks) && !is.null(var_limits)) { + if (lower_boundary) { + var_limits[1] <- var_limits[1] + head(diff(brks), 1)/10 + } + if (!upper_boundary) { + var_limits[2] <- var_limits[2] + head(diff(brks), 1)/10 + } + } # Generate colours if needed if (is.null(cols)) { -- GitLab From 906d1cc2c5ff6b15550641848208cca2b5276df9 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Thu, 31 Oct 2024 14:29:14 +0100 Subject: [PATCH 2/8] Grammar fix in description and adjusting brks instead of var_limits in ColorBarContinuous.R --- R/ColorBarContinuous.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index 1bbaf27..33bbeee 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -47,7 +47,7 @@ #' lower, no labels are drawn. See the code of the function for details or #' use 'extra_labels' for customized tick arrangements. #'@param bar_limits Vector of two numeric values with the extremes of the -#' range of values represented in the colour bar. If 'var_limits' go beyond +#' range of values represented in the colour bar. If 'var_limits' goes beyond #' this interval, the drawing of triangle extremes is triggered at the #' corresponding sides, painted in 'col_inf' and 'col_sup'. Either of them #' can be set as NA and will then take as value the corresponding extreme in @@ -57,7 +57,7 @@ #'@param var_limits Vector of two numeric values with the minimum and maximum #' values of the field to represent. These are used to know whether to draw #' triangle ends at the extremes of the colour bar and what colour to fill -#' them in with. If not specified, take the same value as the extremes of +#' them in with. If not specified, takes the same value as the extremes of #' 'brks'. Hence the parameter 'brks' is mandatory if 'var_limits' is not #' specified. #'@param triangle_ends Vector of two logical elements, indicating whether to @@ -317,14 +317,14 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, "disabled. These will be painted in the colour for NA values.") } } - browser() - # Adjust var_limits based on lower_boundary and upper_boundary - if (!is.null(brks) && !is.null(var_limits)) { + + # Adjust brks based on lower_boundary and upper_boundary (adjusting var_limits does not work) + if (!is.null(brks)) { if (lower_boundary) { - var_limits[1] <- var_limits[1] + head(diff(brks), 1)/10 + brks[1] <- brks[1] - head(diff(brks), 1)/10 } if (!upper_boundary) { - var_limits[2] <- var_limits[2] + head(diff(brks), 1)/10 + brks[2] <- brks[length(brks)] + tail(diff(brks), 1)/10 } } -- GitLab From 0b841c8f9c9cdb46b5682d6c548a21dc6d363696 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Thu, 31 Oct 2024 14:35:58 +0100 Subject: [PATCH 3/8] Draft: duplicating brks and modifying the lower value --- R/ColorBarContinuous.R | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index 33bbeee..cf7da73 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -318,13 +318,22 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } - # Adjust brks based on lower_boundary and upper_boundary (adjusting var_limits does not work) + ## Adjust brks based on lower_boundary and upper_boundary (adjusting var_limits does not work) + # if (!is.null(brks) { + # if (lower_boundary) { + # brks[1] <- brks[1] - head(diff(brks), 1)/10 + # } + # if (!upper_boundary) { + # brks[2] <- brks[length(brks)] + tail(diff(brks), 1)/10 + # } + # } if (!is.null(brks)) { + brks_boundaries <- brks if (lower_boundary) { - brks[1] <- brks[1] - head(diff(brks), 1)/10 + brks_boundaries[1] <- brks_boundaries[1] - head(diff(brks_boundaries), 1)/10 } if (!upper_boundary) { - brks[2] <- brks[length(brks)] + tail(diff(brks), 1)/10 + brks_boundaries[2] <- brks_boundaries[length(brks_boundaries)] + tail(diff(brks_boundaries), 1)/10 } } -- GitLab From 58441c8ad29a3436ca258231d6ebc664c8c55254 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 4 Nov 2024 15:58:56 +0100 Subject: [PATCH 4/8] Add 'brks_boundaries' to list returned by ColorBarContinuous --- R/ColorBarContinuous.R | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index cf7da73..12a8665 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -109,8 +109,8 @@ #' labels of the colour bar, usually to avoid too many decimal digits #' overflowing the figure region. This does not have effect over the labels #' provided in 'extra_labels'. Takes 4 by default. -#'@param lower_boundary -#'@param upper_boundary +#'@param include_lower_boundary +#'@param include_upper_boundary #'@param ... Arguments to be passed to the method. Only accepts the following #' graphical parameters:\cr adj ann ask bg bty cex.lab cex.main cex.sub cin #' col.axis col.lab col.main col.sub cra crt csi cxy err family fg fig fin @@ -154,7 +154,7 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, title = NULL, title_scale = 1, label_scale = 1, tick_scale = 1, extra_margin = rep(0, 4), label_digits = 4, - lower_boundary = TRUE, upper_boundary = TRUE, ...) { + include_lower_boundary = TRUE, include_upper_boundary = TRUE, ...) { # Required checks if ((is.null(brks) || length(brks) < 2) && is.null(bar_limits) && is.null(var_limits)) { stop("At least one of 'brks' with the desired breaks, 'bar_limits' or ", @@ -195,12 +195,12 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, # Check include_lower_boundary and include_upper_boundary if (!is.null(lower_boundary)) { if (!is.logical(lower_boundary) || length(lower_boundary) != 1) { - stop("Parameter 'lower_boundary' must be a logical element.") + stop("Parameter 'include_lower_boundary' must be a logical element.") } } if (!is.null(upper_boundary)) { if (!is.logical(upper_boundary) || length(upper_boundary) != 1) { - stop("Parameter 'upper_boundary' must be a logical element.") + stop("Parameter 'include_upper_boundary' must be a logical element.") } } @@ -318,21 +318,13 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } - ## Adjust brks based on lower_boundary and upper_boundary (adjusting var_limits does not work) - # if (!is.null(brks) { - # if (lower_boundary) { - # brks[1] <- brks[1] - head(diff(brks), 1)/10 - # } - # if (!upper_boundary) { - # brks[2] <- brks[length(brks)] + tail(diff(brks), 1)/10 - # } - # } + # Adjust brks based on include_lower_boundary and upper_boundary (adjusting var_limits does not work) if (!is.null(brks)) { brks_boundaries <- brks - if (lower_boundary) { + if (include_lower_boundary) { brks_boundaries[1] <- brks_boundaries[1] - head(diff(brks_boundaries), 1)/10 } - if (!upper_boundary) { + if (!include_upper_boundary) { brks_boundaries[2] <- brks_boundaries[length(brks_boundaries)] + tail(diff(brks_boundaries), 1)/10 } } @@ -624,5 +616,9 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, axis(d, at = at, tick = draw_ticks, labels = labels, cex.axis = cex_labels, tcl = cex_ticks) par(saved_pars) } - invisible(list(brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup)) + invisible(list(brks = brks, + cols = cols, + col_inf = col_inf, + col_sup = col_sup, + brks_boundaries = brks_boundaries)) } -- GitLab From 6c6b6061d0d47de8050838d0c5b904081076d787 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 4 Nov 2024 16:00:51 +0100 Subject: [PATCH 5/8] Add parameter documentation in ColorBarContinuous.R --- R/ColorBarContinuous.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index 12a8665..685efa5 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -109,8 +109,10 @@ #' labels of the colour bar, usually to avoid too many decimal digits #' overflowing the figure region. This does not have effect over the labels #' provided in 'extra_labels'. Takes 4 by default. -#'@param include_lower_boundary -#'@param include_upper_boundary +#'@param include_lower_boundary Logical value indicating whether to include +#' the minimum value of the field. Takes TRUE by default. +#'@param include_upper_boundary Logical value indicating whether to include +#' the maximum value of the field. Takes TRUE by default. #'@param ... Arguments to be passed to the method. Only accepts the following #' graphical parameters:\cr adj ann ask bg bty cex.lab cex.main cex.sub cin #' col.axis col.lab col.main col.sub cra crt csi cxy err family fg fig fin -- GitLab From 735d705f31d9f62e6ee796795f30118659f05fd5 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 4 Nov 2024 17:21:55 +0100 Subject: [PATCH 6/8] Use brks_boundaries to regulate inclusion of values at the color bar limits. --- R/ColorBarContinuous.R | 14 ++++++++------ R/VizEquiMap.R | 23 ++++++++++------------- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index 685efa5..3e64e24 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -195,13 +195,13 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } # Check include_lower_boundary and include_upper_boundary - if (!is.null(lower_boundary)) { - if (!is.logical(lower_boundary) || length(lower_boundary) != 1) { + if (!is.null(include_lower_boundary)) { + if (!is.logical(include_lower_boundary) || length(include_lower_boundary) != 1) { stop("Parameter 'include_lower_boundary' must be a logical element.") } } - if (!is.null(upper_boundary)) { - if (!is.logical(upper_boundary) || length(upper_boundary) != 1) { + if (!is.null(include_upper_boundary)) { + if (!is.logical(include_upper_boundary) || length(include_upper_boundary) != 1) { stop("Parameter 'include_upper_boundary' must be a logical element.") } } @@ -320,14 +320,16 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } - # Adjust brks based on include_lower_boundary and upper_boundary (adjusting var_limits does not work) + # Define brks_boundaries based on 'include_lower_boundary' and 'include_upper_boundary' + # By default both values at the limit of the color bars are included + # (addresses issue #15 in the esviz GitLab) if (!is.null(brks)) { brks_boundaries <- brks if (include_lower_boundary) { brks_boundaries[1] <- brks_boundaries[1] - head(diff(brks_boundaries), 1)/10 } if (!include_upper_boundary) { - brks_boundaries[2] <- brks_boundaries[length(brks_boundaries)] + tail(diff(brks_boundaries), 1)/10 + brks_boundaries[length(brks_boundaries)] <- brks_boundaries[length(brks_boundaries)] - tail(diff(brks_boundaries), 1)/10 } } diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 54f97c2..9b3b2be 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -542,22 +542,15 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, triangle_ends_scale = triangle_ends_scale, label_scale = bar_label_scale, title = units, title_scale = units_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits) + extra_margin = bar_extra_margin, label_digits = bar_label_digits, + include_lower_boundary = include_lower_boundary, + include_upper_boundary = include_upper_boundary) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf col_sup <- colorbar$col_sup bar_limits <- c(head(brks, 1), tail(brks, 1)) - - # Adjust 'var' values according to 'include_lower_boundary' and 'include_upper_boundary'. - # This adjustment ensures that, by default, values at the lower limit of the color bars ('brks[1]') are included. - # Refer to issue #15 in the esviz GitLab for more details. - if (include_lower_boundary) { - var[var == head(brks, 1)] <- head(brks, 1) + head(diff(brks), 1)/10 - } - if (!include_upper_boundary) { - var[var == tail(brks, 1)] <- tail(brks, 1) + tail(diff(brks), 1)/10 - } + brks_boundaries <- colorbar$brks_boundaries # Check colNA if (is.null(colNA)) { @@ -1087,7 +1080,9 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, tryCatch({ image(lonb$x, latb$x, var[lonb$ix, latb$ix], col = c(col_inf_image, cols, col_sup_image), - breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax), + breaks = c(-.Machine$double.xmax, + if (include_lower_boundary || include_upper_boundary) brks_boundaries else brks, + .Machine$double.xmax), axes = FALSE, xlab = "", ylab = "", add = TRUE, useRaster = TRUE) }, error = function(x) { image(lonb$x, latb$x, var[lonb$ix, latb$ix], @@ -1266,7 +1261,9 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, draw_separators = draw_separators, title = units, title_scale = units_scale, triangle_ends_scale = triangle_ends_scale, label_scale = bar_label_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits) + extra_margin = bar_extra_margin, label_digits = bar_label_digits, + include_lower_boundary = include_lower_boundary, + include_upper_boundary = include_upper_boundary) } # If the graphic was saved to file, close the connection with the device -- GitLab From 322d3e3a474ec22473e0b1e0abe2737afdc00680 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 4 Nov 2024 17:34:56 +0100 Subject: [PATCH 7/8] Also use 'brks_boundaries' when useRaster = FALSE --- R/VizEquiMap.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 9b3b2be..f91b61d 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -1080,14 +1080,12 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, tryCatch({ image(lonb$x, latb$x, var[lonb$ix, latb$ix], col = c(col_inf_image, cols, col_sup_image), - breaks = c(-.Machine$double.xmax, - if (include_lower_boundary || include_upper_boundary) brks_boundaries else brks, - .Machine$double.xmax), + breaks = c(-.Machine$double.xmax, brks_boundaries, .Machine$double.xmax), axes = FALSE, xlab = "", ylab = "", add = TRUE, useRaster = TRUE) }, error = function(x) { image(lonb$x, latb$x, var[lonb$ix, latb$ix], col = c(col_inf_image, cols, col_sup_image), - breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax), + breaks = c(-.Machine$double.xmax, brks_boundaries, .Machine$double.xmax), axes = FALSE, xlab = "", ylab = "", add = TRUE) }) } else { -- GitLab From 6203a4b26656d5bc133028245f4b0e67a1e307f3 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 11 Nov 2024 13:47:57 +0100 Subject: [PATCH 8/8] Testing boundary inclusion when square = FALSE --- R/VizEquiMap.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index f91b61d..f027603 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -1089,8 +1089,11 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, axes = FALSE, xlab = "", ylab = "", add = TRUE) }) } else { + # var[var == head(brks, 1)] <- head(brks, 1) + head(diff(brks), 1)/10 + # var[var == tail(brks, 1)] <- tail(brks, 1) - tail(diff(brks), 1)/10 .filled.contour(lonb$x, latb$x, var[lonb$ix, latb$ix], - levels = c(.Machine$double.xmin, brks, .Machine$double.xmax), + # levels = sort(c(0, .Machine$double.xmin, brks_boundaries, .Machine$double.xmax)) + levels = sort(c(.Machine$double.xmin, brks, .Machine$double.xmax)), col = c(col_inf_image, cols, col_sup_image)) } if (!is.null(contours)) { -- GitLab