diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index cf6c51cf7a30fdffce3b820a8b815c98d2d3baec..0da10a6066c195b5b2fba4e4cde03b15960b660f 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -108,7 +108,11 @@ #'@param label_digits Number of significant digits to be displayed in the #' 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. +#' 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,9 @@ 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 ", @@ -189,6 +195,14 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } + # Check include_lower_boundary and include_upper_boundary + if (!is.null(include_lower_boundary) && (!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) && (!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)) { if (!is.character(cols)) { @@ -225,7 +239,7 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, var_limits <- bar_limits half_width <- 0.5 * (var_limits[2] - var_limits[1]) / (brks - 1) brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) - var_limits[1] <- var_limits[1] + half_width / 50 + var_limits[1] <- var_limits[1] + half_width / 50 ## only for inferior boundary? (bar_limits defined and var_limits null) } else { # both bar_limits and var_limits are defined brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) @@ -236,7 +250,7 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, bar_limits <- c(head(brks, 1), tail(brks, 1)) var_limits <- bar_limits half_width <- 0.5 * (var_limits[2] - var_limits[1]) / (length(brks) - 1) - var_limits[1] <- var_limits[1] + half_width / 50 + var_limits[1] <- var_limits[1] + half_width / 50 ## only for inferior boundary? (if only brks defined) } else { # brks and var_limits are defined bar_limits <- c(head(brks, 1), tail(brks, 1)) @@ -248,8 +262,8 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, if (head(brks, 1) != bar_limits[1] || tail(brks, 1) != bar_limits[2]) { stop("Parameters 'brks' and 'bar_limits' are inconsistent.") } - } - + } + # Check col_inf if (!is.null(col_inf)) { if (!.IsColor(col_inf)) { @@ -271,10 +285,10 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, teflc <- triangle_ends_from_limit_cols <- c(!is.null(col_inf), !is.null(col_sup)) if (is.null(triangle_ends) && is.null(col_inf) && is.null(col_sup)) { triangle_ends <- c(FALSE, FALSE) - if (bar_limits[1] >= var_limits[1]) { + if (bar_limits[1] >= var_limits[1]) { ## >= triangle_ends[1] <- TRUE } - if (bar_limits[2] < var_limits[2]) { + if (bar_limits[2] < var_limits[2]) { ## < triangle_ends[2] <- TRUE } } else if (!is.null(triangle_ends) && is.null(col_inf) && is.null(col_sup)) { @@ -291,12 +305,18 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } if (plot && !is.null(var_limits)) { - if ((bar_limits[1] >= var_limits[1]) && !triangle_ends[1]) { - warning("There are variable values smaller or equal to the lower limit ", + if ((bar_limits[1] > var_limits[1]) && !triangle_ends[1]) { + warning("There are variable values smaller than the lower limit ", "of the colour bar and the lower triangle end has been ", "disabled. These will be painted in the colour for NA values.") } - if ((bar_limits[2] < var_limits[2]) && !triangle_ends[2]) { + if ((bar_limits[1] == var_limits[1]) && !triangle_ends[1] && !include_lower_boundary) { + warning("There are variable values equal to the lower limit ", + "of the colour bar, the lower triangle end has been ", + "disabled and 'include_lower_boundary = FALSE.' ", + "These will be painted in the colour for NA values.") + } + if ((bar_limits[2] < var_limits[2]) && !triangle_ends[2]) { warning("There are variable values greater than the higher limit ", "of the colour bar and the higher triangle end has been ", "disabled. These will be painted in the colour for NA values.") diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 9a49cbc8419042bf16238689504cc3199361944b..6a793a3bcbe001e317c97aab6d43ee24c7b4244b 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -199,6 +199,10 @@ #' the corresponding device. #'@param res Resolution of the device (file or window) to plot in. See #' ?Devices and the creator function of the corresponding device. +#'@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 \dots Arguments to be passed to the method. Only accepts the following #' graphical parameters:\cr #' adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt @@ -272,7 +276,8 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, fileout = NULL, width = 8, height = 5, size_units = 'in', - res = 100, ...) { + res = 100, include_lower_boundary = TRUE, + include_upper_boundary = TRUE, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "din", "fig", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "oma", "ps", "tck") @@ -513,6 +518,14 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, title_scale <- sizetit } + # Check include_lower_boundary and include_upper_boundary + if (!is.null(include_lower_boundary) && (!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) && (!is.logical(include_upper_boundary) || length(include_upper_boundary) != 1)) { + stop("Parameter 'include_upper_boundary' must be a logical element.") + } + tmp <- .create_var_limits(data = var, brks = brks, bar_limits = bar_limits, drawleg = drawleg) var_limits <- tmp$var_limits @@ -529,13 +542,25 @@ 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 + } + # Check colNA if (is.null(colNA)) { if ('na_color' %in% names(attributes(cols))) { @@ -1243,7 +1268,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