From d27cb2465e12e018e2fd0950123a384c52b2e1ba Mon Sep 17 00:00:00 2001 From: Roberto Bilbao Date: Tue, 17 May 2022 13:30:40 +0200 Subject: [PATCH 1/4] Added xlonshft and xlabels parameters to modify labels --- R/PlotEquiMap.R | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 9981ed3..c725a10 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -261,7 +261,7 @@ PlotEquiMap <- 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, xlonshft = 0, xlabels = NULL, ...) { # 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") @@ -635,6 +635,12 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { intxlon <- round(intxlon) } + if (!is.numeric(xlonshft)) { + stop("Parameter 'xlonshft' must be numeric.") + } else { + xlonshft <- round(xlonshft) + } + # Check legend parameters if (!is.logical(drawleg)) { @@ -761,7 +767,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, spaceticklab <- 0 if (axelab) { ypos <- seq(latmin, latmax, intylat) - xpos <- seq(lonmin, lonmax, intxlon) + xpos <- seq(lonmin, lonmax, intxlon) + xlonshft letters <- array('', length(ypos)) if (degree_sym == FALSE) { letters[ypos < 0] <- 'S' @@ -771,6 +777,10 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, letters[ypos > 0] <- paste(intToUtf8(176), 'N') } ylabs <- paste(as.character(abs(ypos)), letters, sep = '') + + if (!is.null(xlabels)) { + xlabs = abind(xlabels,c('')) + } else { letters <- array('', length(xpos)) if (labW) { xpos2 <- xpos @@ -795,6 +805,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { xlabs <- paste(as.character(abs(xpos)), letters, sep = '') } + } + spaceticklab <- max(-cex_axes_ticks, 0) margins[1] <- margins[1] + 1.2 * cex_axes_labels + spaceticklab margins[2] <- margins[2] + 1.2 * cex_axes_labels + spaceticklab -- GitLab From 102232ed4f5301b2026c4ca2faf71a119168e1bc Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 17 May 2022 17:22:58 +0200 Subject: [PATCH 2/4] Add documentatiion to new parameters and add 'ylabels' and 'ylatshft' --- R/PlotEquiMap.R | 121 +++++++++++++++++++++++++++++--------------- man/PlotEquiMap.Rd | 23 ++++++++- man/ResidualCorr.Rd | 6 +-- 3 files changed, 105 insertions(+), 45 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index c725a10..9e1121a 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -134,11 +134,24 @@ #'@param lab_dist_y A numeric of the distance of the latitude labels to the #' box borders. The default value is NULL and is automatically adjusted by #' the function. -#'@param degree_sym A logical indicating whether to include degree symbol (30° N) or not (30N; default). +#'@param degree_sym A logical indicating whether to include degree symbol (30° N) +#' or not (30N; default). #'@param intylat Interval between latitude ticks on y-axis, in degrees. #' Defaults to 20. #'@param intxlon Interval between latitude ticks on x-axis, in degrees. #' Defaults to 20. +#'@param xlonshft A numeric of the degrees to shift the latitude ticks. The +#' default value is 0. +#'@param ylatshft A numeric of the degrees to shift the longitude ticks. The +#' default value is 0. +#'@param xlabels A vector of character string of the custumized x-axis labels. +#' The values should correspond to each tick, which is decided by the longitude +#' and parameter 'intxlon'. The default value is NULL and the labels will be +#' automatically generated. +#'@param ylabels A vector of character string of the custumized y-axis labels. +#' The values should correspond to each tick, which is decided by the latitude +#' and parameter 'intylat'. The default value is NULL and the labels will be +#' automatically generated. #'@param axes_tick_scale Scale factor for the tick lines along the longitude #' and latitude axes. #'@param axes_label_scale Scale factor for the labels along the longitude @@ -249,7 +262,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, arr_scale_shaft = 1, arr_scale_shaft_angle = 1, axelab = TRUE, labW = FALSE, lab_dist_x = NULL, lab_dist_y = NULL, degree_sym = FALSE, - intylat = 20, intxlon = 20, + intylat = 20, intxlon = 20, + xlonshft = 0, ylatshft = 0, xlabels = NULL, ylabels = NULL, axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, subsampleg = NULL, bar_extra_labels = NULL, draw_bar_ticks = TRUE, @@ -261,7 +275,7 @@ PlotEquiMap <- 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, xlonshft = 0, xlabels = NULL, ...) { + res = 100, ...) { # 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") @@ -635,12 +649,22 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { intxlon <- round(intxlon) } - if (!is.numeric(xlonshft)) { - stop("Parameter 'xlonshft' must be numeric.") - } else { - xlonshft <- round(xlonshft) + if (!is.numeric(xlonshft) | length(xlonshft) != 1) { + stop("Parameter 'xlonshft' must be a number.") + } + if (!is.numeric(ylatshft) | length(ylatshft) != 1) { + stop("Parameter 'ylatshft' must be a number.") + } + if (!is.null(xlabels)) { + if (!is.character(xlabels) | !is.vector(xlabels)) { + stop("Parameter 'xlabels' must be a vector of character string.") + } + } + if (!is.null(ylabels)) { + if (!is.character(ylabels) | !is.vector(ylabels)) { + stop("Parameter 'ylabels' must be a vector of character string.") + } } - # Check legend parameters if (!is.logical(drawleg)) { @@ -766,47 +790,62 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, cex_axes_ticks <- -0.5 * axes_tick_scale spaceticklab <- 0 if (axelab) { - ypos <- seq(latmin, latmax, intylat) - xpos <- seq(lonmin, lonmax, intxlon) + xlonshft - letters <- array('', length(ypos)) - if (degree_sym == FALSE) { - letters[ypos < 0] <- 'S' - letters[ypos > 0] <- 'N' + # Y axis label + if (!is.null(ylabels)) { + ypos <- seq(latmin, latmax, intylat) + ylatshft + if (length(ypos) != length(ylabels)) { + stop(paste0("Parameter 'ylabels' must have the same length as the latitude ", + "vector spaced by 'intylat'.")) + } + ylabs <- ylabels } else { - letters[ypos < 0] <- paste(intToUtf8(176), 'S') - letters[ypos > 0] <- paste(intToUtf8(176), 'N') + ypos <- seq(latmin, latmax, intylat) + ylatshft + letters <- array('', length(ypos)) + if (degree_sym == FALSE) { + letters[ypos < 0] <- 'S' + letters[ypos > 0] <- 'N' + } else { + letters[ypos < 0] <- paste(intToUtf8(176), 'S') + letters[ypos > 0] <- paste(intToUtf8(176), 'N') + } + ylabs <- paste(as.character(abs(ypos)), letters, sep = '') } - ylabs <- paste(as.character(abs(ypos)), letters, sep = '') + # X axis label if (!is.null(xlabels)) { - xlabs = abind(xlabels,c('')) - } else { - letters <- array('', length(xpos)) - if (labW) { - xpos2 <- xpos - xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180] - } - if (degree_sym == FALSE) { - letters[xpos < 0] <- 'W' - letters[xpos > 0] <- 'E' + xpos <- seq(lonmin, lonmax, intxlon) + xlonshft + if (length(xpos) != length(xlabels)) { + stop(paste0("Parameter 'xlabels' must have the same length as the longitude ", + "vector spaced by 'intxlon'.")) + } + xlabs <- xlabels } else { - letters[xpos < 0] <- paste(intToUtf8(176), 'W') - letters[xpos > 0] <- paste(intToUtf8(176), 'E') - } - if (labW) { - letters[xpos == 0] <- ' ' - letters[xpos == 180] <- ' ' + xpos <- seq(lonmin, lonmax, intxlon) + xlonshft + letters <- array('', length(xpos)) + if (labW) { + xpos2 <- xpos + xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180] + } if (degree_sym == FALSE) { - letters[xpos > 180] <- 'W' + letters[xpos < 0] <- 'W' + letters[xpos > 0] <- 'E' } else { - letters[xpos > 180] <- paste(intToUtf8(176), 'W') - } - xlabs <- paste(as.character(abs(xpos2)), letters, sep = '') - } else { - xlabs <- paste(as.character(abs(xpos)), letters, sep = '') - } + letters[xpos < 0] <- paste(intToUtf8(176), 'W') + letters[xpos > 0] <- paste(intToUtf8(176), 'E') + } + if (labW) { + letters[xpos == 0] <- ' ' + letters[xpos == 180] <- ' ' + if (degree_sym == FALSE) { + letters[xpos > 180] <- 'W' + } else { + letters[xpos > 180] <- paste(intToUtf8(176), 'W') + } + xlabs <- paste(as.character(abs(xpos2)), letters, sep = '') + } else { + xlabs <- paste(as.character(abs(xpos)), letters, sep = '') + } } - spaceticklab <- max(-cex_axes_ticks, 0) margins[1] <- margins[1] + 1.2 * cex_axes_labels + spaceticklab margins[2] <- margins[2] + 1.2 * cex_axes_labels + spaceticklab diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index 31fe4d8..47a0d98 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -54,6 +54,10 @@ PlotEquiMap( degree_sym = FALSE, intylat = 20, intxlon = 20, + xlonshft = 0, + ylatshft = 0, + xlabels = NULL, + ylabels = NULL, axes_tick_scale = 1, axes_label_scale = 1, drawleg = TRUE, @@ -247,7 +251,8 @@ the function.} box borders. The default value is NULL and is automatically adjusted by the function.} -\item{degree_sym}{A logical indicating whether to include degree symbol (30° N) or not (30N; default).} +\item{degree_sym}{A logical indicating whether to include degree symbol (30° N) +or not (30N; default).} \item{intylat}{Interval between latitude ticks on y-axis, in degrees. Defaults to 20.} @@ -255,6 +260,22 @@ Defaults to 20.} \item{intxlon}{Interval between latitude ticks on x-axis, in degrees. Defaults to 20.} +\item{xlonshft}{A numeric of the degrees to shift the latitude ticks. The +default value is 0.} + +\item{ylatshft}{A numeric of the degrees to shift the longitude ticks. The +default value is 0.} + +\item{xlabels}{A vector of character string of the custumized x-axis labels. +The values should correspond to each tick, which is decided by the longitude +and parameter 'intxlon'. The default value is NULL and the labels will be +automatically generated.} + +\item{ylabels}{A vector of character string of the custumized y-axis labels. +The values should correspond to each tick, which is decided by the latitude +and parameter 'intylat'. The default value is NULL and the labels will be +automatically generated.} + \item{axes_tick_scale}{Scale factor for the tick lines along the longitude and latitude axes.} diff --git a/man/ResidualCorr.Rd b/man/ResidualCorr.Rd index 1e0adad..e98ea7a 100644 --- a/man/ResidualCorr.Rd +++ b/man/ResidualCorr.Rd @@ -67,9 +67,9 @@ A list with: the input arrays except "time_dim" (and "memb_dim" if provided). } \item{$sign}{ - A logical array of the statistical significance of the residual correlation - with the same dimensions as the input arrays except "time_dim" (and - "memb_dim" if provided). Returned only if "alpha" is a numeric. + A logical array indicating whether the residual correlation is statistically + significant or not with the same dimensions as the input arrays except "time_dim" + (and "memb_dim" if provided). Returned only if "alpha" is a numeric. } \item{$p.val}{ A numeric array of the p-values with the same dimensions as the input arrays -- GitLab From 5001796129269f9ceb03ff5f03b460d2446ea695 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 1 Jun 2022 17:16:30 +0200 Subject: [PATCH 3/4] Map plotting are flexible with any longitude range --- R/PlotEquiMap.R | 30 ++++++++---------------------- 1 file changed, 8 insertions(+), 22 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 9e1121a..2aadda7 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -758,11 +758,6 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, latmax <- ceiling(max(lat) / 10) * 10 lonmin <- floor(min(lon) / 10) * 10 lonmax <- ceiling(max(lon) / 10) * 10 - if (min(lon) < 0) { - continents <- 'world' - } else { - continents <- 'world2' - } # # Plotting the map @@ -947,24 +942,15 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # Plotting continents # ~~~~~~~~~~~~~~~~~~~~~ # - # maps::map has the global map range [0, 360] or [-180, 180]. - # Set xlim so lon = 0 won't show a straight line when lon = [0, 359]. - # NOTE: It works except Antartic area. Don't know why. ylim is also set - # but it doesn't work. - if (continents == 'world') { # [-180, 180] - xlim_conti <- c(-179.99, 179.99) - } else { # [0, 360] - xlim_conti <- c(0.01, 359.99) - } + wrap_vec <- c(lon[1], lon[1] + 360) old_lwd <- par('lwd') par(lwd = coast_width) # If [0, 360], use GEOmap; if [-180, 180], use maps::map # UPDATE: Use maps::map for both cases. The difference between GEOmap and # maps is trivial. The only thing we can see for now is that # GEOmap has better lakes. - coast <- maps::map(continents, interior = country.borders, wrap = TRUE, - xlim = xlim_conti, ylim = c(-89.99, 89.99), - fill = filled.continents, add = TRUE, plot = FALSE) + coast <- maps::map(interior = country.borders, wrap = wrap_vec, + fill = filled.continents, add = TRUE, plot = FALSE) if (filled.continents) { polygon(coast, col = continent_color, border = coast_color, lwd = coast_width) @@ -972,7 +958,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, lines(coast, col = coast_color, lwd = coast_width) } if (!is.null(lake_color)) { - maps::map('lakes', add = TRUE, fill = filled.continents, col = lake_color) + maps::map('lakes', add = TRUE, wrap = wrap_vec, fill = filled.continents, col = lake_color) } par(lwd = old_lwd) @@ -981,8 +967,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, old_lwd <- par('lwd') par(lwd = coast_width) - outline <- maps::map(continents, fill = T, plot = FALSE) # must be fill = T - xbox <- xlim_conti + c(-2, 2) + outline <- maps::map(wrap = wrap_vec, fill = T, plot = FALSE) # must be fill = T + xbox <- wrap_vec + c(-2, 2) ybox <- c(-92, 92) outline$x <- c(outline$x, NA, c(xbox, rev(xbox), xbox[1])) outline$y <- c(outline$y, NA, rep(ybox, each = 2), ybox[1]) @@ -992,9 +978,9 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } # Plot shapefile + #NOTE: the longitude range cannot cut shapefile range, or not all the shapefile will be plotted. if (!is.null(shapefile)) { - maps::map(shape, interior = country.borders, #wrap = TRUE, - xlim = xlim_conti, ylim = c(-89.99, 89.99), + maps::map(shape, interior = country.borders, #wrap = wrap_vec, fill = filled.continents, add = TRUE, plot = TRUE, lwd = shapefile_lwd, col = shapefile_color) } -- GitLab From 4f878edcb99f1f23546624169a8b083e4a8c6002 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 10 Jun 2022 13:47:53 +0200 Subject: [PATCH 4/4] Improve error message to facilitate xlabels correction. --- R/PlotEquiMap.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 2aadda7..ee10ec3 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -790,7 +790,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, ypos <- seq(latmin, latmax, intylat) + ylatshft if (length(ypos) != length(ylabels)) { stop(paste0("Parameter 'ylabels' must have the same length as the latitude ", - "vector spaced by 'intylat'.")) + "vector spaced by 'intylat' (length = ", length(ypos), ").")) } ylabs <- ylabels } else { @@ -811,7 +811,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, xpos <- seq(lonmin, lonmax, intxlon) + xlonshft if (length(xpos) != length(xlabels)) { stop(paste0("Parameter 'xlabels' must have the same length as the longitude ", - "vector spaced by 'intxlon'.")) + "vector spaced by 'intxlon' (length = ", length(xpos), ").")) } xlabs <- xlabels } else { -- GitLab