From 2471176bd264ad421fa3a162c30a446b31c957f8 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 23 Nov 2023 17:30:34 +0100 Subject: [PATCH 1/2] Avoid Inf values when all data are NAs --- R/VizRobinson.R | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) diff --git a/R/VizRobinson.R b/R/VizRobinson.R index c1a0cbb..48420c6 100644 --- a/R/VizRobinson.R +++ b/R/VizRobinson.R @@ -258,7 +258,26 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, # Color bar ## Check: brks, cols, bar_limits, color_fun, bar_extra_margin, units ## Build: brks, cols, bar_limits, col_inf, col_sup - var_limits <- c(min(data, na.rm = TRUE), max(data, na.rm = TRUE)) + if (!all(is.na(data))) { + var_limits <- c(min(data[!is.infinite(data)], na.rm = TRUE), + max(data[!is.infinite(data)], na.rm = TRUE)) + } else { + warning("All the data are NAs. The map will be filled with colNA.") + if (!is.null(brks) && length(brks) > 1) { + #NOTE: var_limits be like this to avoid warnings from ColorBar + var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], + max(brks, na.rm = TRUE)) + } else if (!is.null(bar_limits)) { + var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) + } else { + var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted + if (!is.null(legend)) { + legend <- NULL + warning("All data are NAs. Color bar won't be drawn. If you want to have ", + "color bar still, define parameter 'brks' or 'bar_limits'.") + } + } + } colorbar <- ColorBarContinuous(brks = brks, cols = cols, vertical = vertical, subsampleg = NULL, bar_limits = bar_limits, var_limits = var_limits, triangle_ends = triangle_ends, col_inf = col_inf, col_sup = col_sup, color_fun = color_fun, @@ -324,12 +343,12 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, # Add triangles to brks brks_ggplot <- brks - if (max(data, na.rm = T) > tail(brks, 1)) { + if (var_limits[2] > tail(brks, 1)) { brks_ggplot <- c(brks_ggplot, max(data, na.rm = T)) } else { brks_ggplot <- c(brks_ggplot, tail(brks, 1) + diff(tail(brks, 2))) } - if (min(data, na.rm = T) < brks[1]) { + if (var_limits[1] < brks[1]) { brks_ggplot <- c(min(data, na.rm = T), brks_ggplot) } else { brks_ggplot <- c(brks[1] - diff(brks[1:2]), brks_ggplot) @@ -347,6 +366,7 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, dplyr::mutate(dat = as.vector(data)) lonlat_df_ori <- NULL + # Remove the points where mask = FALSE if (!is.null(mask)) { # Save original lonlat_df to plot with expected region @@ -388,7 +408,7 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, lat = st_coordinates(dots_df)[, 2]) dots_df <- dplyr::filter(dots_df, .data$dot == FALSE) } - + # coastlines coastlines <- rnaturalearth::ne_coastline(scale = "medium", returnclass = "sf") ## crop the coastlines to the desired range -- GitLab From acba0ff5f9dfff7bfa431be6988b53a2ca67dac7 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 24 Nov 2023 15:05:22 +0100 Subject: [PATCH 2/2] Add internal function deciding var_limits --- R/VizEquiMap.R | 24 ++++------------------ R/VizLayout.R | 23 ++++----------------- R/VizRobinson.R | 51 ++++++++++++++++------------------------------ R/VizStereoMap.R | 6 +++++- R/zzz.R | 25 +++++++++++++++++++++++ man/VizRobinson.Rd | 12 +++++------ 6 files changed, 62 insertions(+), 79 deletions(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 84e8ae0..9a49cbc 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -513,26 +513,10 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, title_scale <- sizetit } - if (!all(is.na(var))) { - var_limits <- c(min(var[!is.infinite(var)], na.rm = TRUE), - max(var[!is.infinite(var)], na.rm = TRUE)) - } else { - warning("All the data are NAs. The map will be filled with colNA.") - if (!is.null(brks) && length(brks) > 1) { - #NOTE: var_limits be like this to avoid warnings from ColorBar - var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], - max(brks, na.rm = TRUE)) - } else if (!is.null(bar_limits)) { - var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) - } else { - var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted - if (drawleg) { - drawleg <- FALSE - warning("All data are NAs. Color bar won't be drawn. If you want to have ", - "color bar still, define parameter 'brks' or 'bar_limits'.") - } - } - } + tmp <- .create_var_limits(data = var, brks = brks, + bar_limits = bar_limits, drawleg = drawleg) + var_limits <- tmp$var_limits + drawleg <- tmp$drawleg # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, diff --git a/R/VizLayout.R b/R/VizLayout.R index 25e6bbd..a115879 100644 --- a/R/VizLayout.R +++ b/R/VizLayout.R @@ -331,25 +331,10 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # Check the rest of parameters (unless the user simply wants to build an empty layout) if (!all(sapply(var, is_single_na))) { - if (!all(is.na(unlist(var)))) { - tmp <- !is.infinite(unlist(var)) - var_limits <- c(min(unlist(var)[tmp], na.rm = TRUE), - max(unlist(var)[tmp], na.rm = TRUE)) - } else { - if (!is.null(brks)) { - #NOTE: var_limits be like this to avoid warnings from ColorBar - var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], - max(brks, na.rm = TRUE)) - } else if (!is.null(bar_limits)) { - var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) - } else { - var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted - if (!isFALSE(drawleg)) { - drawleg <- FALSE - warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks' or 'bar_limits'.") - } - } - } + tmp <- .create_var_limits(data = unlist(var), brks = brks, + bar_limits = bar_limits, drawleg = drawleg) + var_limits <- tmp$var_limits + drawleg <- tmp$drawleg } colorbar <- ColorBarContinuous(brks, cols, FALSE, subsampleg, bar_limits, diff --git a/R/VizRobinson.R b/R/VizRobinson.R index 48420c6..f3f0ff1 100644 --- a/R/VizRobinson.R +++ b/R/VizRobinson.R @@ -29,9 +29,9 @@ #' should be a valid crs string. The default projection is Robinson #' (ESRI:54030). Note that the character string may work differently depending #' on PROJ and GDAL module version. -#'@param legend A character string indicating the legend style. It can be 'bar' -#' (color bar by \code{ColorBarContinuous()}), 'ggplot2' (discrete legend by -#' ggplot2), or NULL (no legend), +#'@param drawleg A character string indicating the legend style. It can be +#' 'bar' (color bar by \code{ColorBarContinuous()}), 'ggplot2' (discrete legend +#' by ggplot2), or FALSE (no legend). The default value is 'bar'. #'@param style A character string indicating the plotting style. It can be #' 'point' or 'polygon'. The default value is 'point'. Note that 'polygon' may #' be time- and memory-consuming for global or high-resolution data. @@ -61,7 +61,7 @@ #' parameters to control the visual aspect of the drawn colour bar #' (1/3). See ?ColorBarContinuous for a full explanation. #'@param vertical A logical value indicating the direction of colorbar if -#' parameter 'legend' is 'bar'. The default value is TRUE. +#' parameter 'drawleg' is 'bar'. The default value is TRUE. #'@param toptitle A character string of the top title of the figure, scalable #' with parameter 'title_size'. #'@param caption A character string of the caption located at left-bottom of the @@ -107,7 +107,7 @@ #' toptitle = 'synthetic example', vertical = FALSE, #' caption = 'Robinson Projection', #' bar_extra_margin = c(0, 1, 0, 1), width = 8, height = 6) -#'VizRobinson(data, lon = 0:359, lat = -90:90, mask = dots, legend = 'ggplot2', +#'VizRobinson(data, lon = 0:359, lat = -90:90, mask = dots, drawleg = 'ggplot2', #' target_proj = "+proj=moll", brks = seq(-10, 10, length.out = 11), #' color_fun = ClimPalette("purpleorange"), colNA = 'green', #' toptitle = 'synthetic example', caption = 'Mollweide Projection', @@ -119,7 +119,7 @@ #' @importFrom rlang .data #'@export VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, - target_proj = "ESRI:54030", legend = 'bar', style = 'point', + target_proj = "ESRI:54030", drawleg = 'bar', style = 'point', dots = NULL, mask = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, colNA = NULL, color_fun = ClimPalette(), bar_extra_margin = rep(0, 4), vertical = TRUE, @@ -189,9 +189,9 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, } } - # legend - if (!is.null(legend) && (!legend %in% c('bar', 'ggplot2'))) { - stop("Parameter 'legend' must be NULL, ggplot2 or bar.") + # drawleg + if (!drawleg %in% c('bar', 'ggplot2', FALSE)) { + stop("Parameter 'drawleg' must be FALSE, 'ggplot2' or 'bar'.") } # style if (!style %in% c('point', 'polygon') || length(style) != 1) { @@ -255,29 +255,14 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, } } + tmp <- .create_var_limits(data = data, brks = brks, + bar_limits = bar_limits, drawleg = drawleg) + var_limits <- tmp$var_limits + drawleg <- tmp$drawleg + # Color bar ## Check: brks, cols, bar_limits, color_fun, bar_extra_margin, units ## Build: brks, cols, bar_limits, col_inf, col_sup - if (!all(is.na(data))) { - var_limits <- c(min(data[!is.infinite(data)], na.rm = TRUE), - max(data[!is.infinite(data)], na.rm = TRUE)) - } else { - warning("All the data are NAs. The map will be filled with colNA.") - if (!is.null(brks) && length(brks) > 1) { - #NOTE: var_limits be like this to avoid warnings from ColorBar - var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], - max(brks, na.rm = TRUE)) - } else if (!is.null(bar_limits)) { - var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) - } else { - var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted - if (!is.null(legend)) { - legend <- NULL - warning("All data are NAs. Color bar won't be drawn. If you want to have ", - "color bar still, define parameter 'brks' or 'bar_limits'.") - } - } - } colorbar <- ColorBarContinuous(brks = brks, cols = cols, vertical = vertical, subsampleg = NULL, bar_limits = bar_limits, var_limits = var_limits, triangle_ends = triangle_ends, col_inf = col_inf, col_sup = col_sup, color_fun = color_fun, @@ -334,8 +319,8 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, #================================================================= # Adapt ColorBarContinuous parameters to ggplot plot - # If legend is NULL, still tune with bar legend way - if (is.null(legend) || legend == 'bar') { + # If drawleg is FALSE, still tune with bar legend way + if (isFALSE(drawleg) || drawleg == 'bar') { # the colorbar triangle color. If it is NULL (no triangle plotted), use colNA col_inf_image <- ifelse(is.null(col_inf), colNA, col_inf) col_sup_image <- ifelse(is.null(col_sup), colNA, col_sup) @@ -502,7 +487,7 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, #size = dots_size / (dots_df$lat / min(dots_df$lat))) } - if (identical(legend, 'ggplot2')) { + if (identical(drawleg, 'ggplot2')) { if (style == 'polygon') { res_p <- res_p + scale_colour_manual(values = cols_ggplot, aesthetics = c("colour", "fill"), @@ -538,7 +523,7 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, } # bar legend fun to put in cowplot::plot_grid - if (identical(legend, 'bar')) { + if (identical(drawleg, 'bar')) { fun_legend <- function() { if (vertical) { par(mar = c(7.1, 2.2, 7.1, 3.1), mgp = c(3, 1, 0)) diff --git a/R/VizStereoMap.R b/R/VizStereoMap.R index 37ff864..047c545 100644 --- a/R/VizStereoMap.R +++ b/R/VizStereoMap.R @@ -331,11 +331,15 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 title_scale <- sizetit } + tmp <- .create_var_limits(data = var, brks = brks, + bar_limits = bar_limits, drawleg = drawleg) + var_limits <- tmp$var_limits + drawleg <- tmp$drawleg + # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) colorbar <- ColorBarContinuous(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, diff --git a/R/zzz.R b/R/zzz.R index a4840af..cf2eb1c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -243,3 +243,28 @@ GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE } } + +# Decide var_limits for ColorBarContinuous() +.create_var_limits <- function(data, brks, bar_limits, drawleg) { + if (!all(is.na(data))) { + var_limits <- c(min(data[!is.infinite(data)], na.rm = TRUE), + max(data[!is.infinite(data)], na.rm = TRUE)) + } else { + warning("All the data are NAs. The map will be filled with colNA.") + if (!is.null(brks) && length(brks) > 1) { + #NOTE: var_limits be like this to avoid warnings from ColorBar + var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], + max(brks, na.rm = TRUE)) + } else if (!is.null(bar_limits)) { + var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) + } else { + var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted + if (!isFALSE(drawleg)) { + drawleg <- FALSE + warning("All data are NAs. Color bar won't be drawn. If you want to have ", + "color bar still, define parameter 'brks' or 'bar_limits'.") + } + } + } + return(list(var_limits = var_limits, drawleg = drawleg)) +} \ No newline at end of file diff --git a/man/VizRobinson.Rd b/man/VizRobinson.Rd index 6320744..48687f1 100644 --- a/man/VizRobinson.Rd +++ b/man/VizRobinson.Rd @@ -11,7 +11,7 @@ VizRobinson( lon_dim = NULL, lat_dim = NULL, target_proj = "ESRI:54030", - legend = "bar", + drawleg = "bar", style = "point", dots = NULL, mask = NULL, @@ -66,9 +66,9 @@ should be a valid crs string. The default projection is Robinson (ESRI:54030). Note that the character string may work differently depending on PROJ and GDAL module version.} -\item{legend}{A character string indicating the legend style. It can be 'bar' -(color bar by \code{ColorBarContinuous()}), 'ggplot2' (discrete legend by -ggplot2), or NULL (no legend),} +\item{drawleg}{A character string indicating the legend style. It can be +'bar' (color bar by \code{ColorBarContinuous()}), 'ggplot2' (discrete legend +by ggplot2), or FALSE (no legend). The default value is 'bar'.} \item{style}{A character string indicating the plotting style. It can be 'point' or 'polygon'. The default value is 'point'. Note that 'polygon' may @@ -105,7 +105,7 @@ parameters to control the visual aspect of the drawn colour bar (1/3). See ?ColorBarContinuous for a full explanation.} \item{vertical}{A logical value indicating the direction of colorbar if -parameter 'legend' is 'bar'. The default value is TRUE.} +parameter 'drawleg' is 'bar'. The default value is TRUE.} \item{toptitle}{A character string of the top title of the figure, scalable with parameter 'title_size'.} @@ -178,7 +178,7 @@ VizRobinson(data, lon = 0:359, lat = -90:90, dots = dots, toptitle = 'synthetic example', vertical = FALSE, caption = 'Robinson Projection', bar_extra_margin = c(0, 1, 0, 1), width = 8, height = 6) -VizRobinson(data, lon = 0:359, lat = -90:90, mask = dots, legend = 'ggplot2', +VizRobinson(data, lon = 0:359, lat = -90:90, mask = dots, drawleg = 'ggplot2', target_proj = "+proj=moll", brks = seq(-10, 10, length.out = 11), color_fun = ClimPalette("purpleorange"), colNA = 'green', toptitle = 'synthetic example', caption = 'Mollweide Projection', -- GitLab