diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index b7727ba05c7e197a1392f87c4eb25e40503f2bc3..3e64e24c2f8ae8cce42f7b56cb6b2869676a6f6f 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 @@ -109,6 +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 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 @@ -151,7 +155,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, + 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 ", @@ -188,6 +193,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(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(include_upper_boundary)) { + if (!is.logical(include_upper_boundary) || length(include_upper_boundary) != 1) { + stop("Parameter 'include_upper_boundary' must be a logical element.") + } + } # Check cols if (!is.null(cols)) { @@ -303,6 +320,19 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } + # 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[length(brks_boundaries)] <- brks_boundaries[length(brks_boundaries)] - tail(diff(brks_boundaries), 1)/10 + } + } + # Generate colours if needed if (is.null(cols)) { cols <- color_fun(length(brks) - 1 + sum(triangle_ends)) @@ -590,5 +620,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)) } diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 54f97c2459e91c203e26525974b64efe892e923c..f027603b679fed9bf15e12c2865552284a577e83 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,17 +1080,20 @@ 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, 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 { + # 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)) { @@ -1266,7 +1262,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