diff --git a/DESCRIPTION b/DESCRIPTION index e4d4332e1d33dd4ddc5aa99afac6a5166cbc457a..f90e50225e26c68feda74d1e1a75abc2e8f837bc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,12 +3,17 @@ Title: Plotting Functions for Climate Science and Services Version: 0.0.1 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), - person("An-Chi", "Ho", , "an.ho@bsc.es", role = c("aut", "cre")), - person("Eva", "Rifà", , "eva.rifarovira@bsc.es", role = "ctb")) -Description: This package is an R plotting package for climate science and services. - It includes several functions to plot different kinds of maps, time series, - scorecards, etc. Some functions are origined from packages "s2dv" and "CSTools" - but with more consistent and integrated functinalities. + person("An-Chi", "Ho", , "an.ho@bsc.es", role = "aut"), + person("Eva", "Rifà", , "eva.rifarovira@bsc.es", role = "ctb"), + person("Victòria", "Agudetse", , "victoria.agudetse@bsc.es", role = "ctb"), + person("Ariadna", "Batalla", , "ariadna.batalla@bsc.es", role = c("ctb", "cre")), + person("Núria", "Pérez-Zanón", , "nuria.perez@bsc.es", role = "ctb"), + person("Nadia", "Milders", , "nadia.milders@bsc.es", role = "ctb"), + person("Verónica", "Torralba", , "veronica.torralba@bsc.es", role = "ctb")) +Description: An R plotting package for climate science and services. Provides a + set of functions for visualizing climate data, including maps, time series, + scorecards and other diagnostics. Some functions are adapted from the "s2dv" + and "CSTools" packages, with more consistent and integrated functinalities. Depends: R (>= 3.6.0) Imports: @@ -43,6 +48,6 @@ URL: https://earth.bsc.es/gitlab/es/esviz/ BugReports: https://earth.bsc.es/gitlab/es/esviz/-/issues SystemRequirements: GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>= 4.8.0) Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Config/testthat/edition: 3 LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 254964cb4ab9e9a01c42ee49cf532f53d7bce3e3..b821438e897f135b3141542adea71f0599e1757f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(ClimColors) export(ClimPalette) export(ColorBarContinuous) export(ColorBarDiscrete) +export(Hatching) export(ShapeToMask) export(VizCombinedMap) export(VizEquiMap) diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index b7727ba05c7e197a1392f87c4eb25e40503f2bc3..f7e02adda4327559f0d016d9a4519f768f093287 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -45,7 +45,7 @@ #' colorbar. Takes by default an approximation of a value that yields a #' readable tick arrangement (extreme breaks always ticked). If set to 0 or #' lower, no labels are drawn. See the code of the function for details or -#' use 'extra_labels' for customized tick arrangements. +#' use 'bar_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 #' this interval, the drawing of triangle extremes is triggered at the @@ -82,7 +82,7 @@ #' parameter is set by default to ClimPalette(). #'@param plot Logical value indicating whether to only compute its breaks and #' colours (FALSE) or to also draw it on the current device (TRUE). -#'@param draw_ticks Whether to draw ticks for the labels along the colour bar +#'@param draw_bar_ticks Whether to draw ticks for the labels along the colour bar #' (TRUE) or not (FALSE). TRUE by default. Disregarded if 'plot = FALSE'. #'@param draw_separators Whether to draw black lines in the borders of each of #' the colour rectancles of the colour bar (TRUE) or not (FALSE). FALSE by @@ -91,24 +91,29 @@ #' colour bar, if drawn at all. Takes 1 by default (rectangle triangle #' proportional to the thickness of the colour bar). Disregarded if #' 'plot = FALSE'. -#'@param extra_labels Numeric vector of extra labels to draw along axis of +#'@param bar_extra_labels Numeric vector of extra labels to draw along axis of #' the colour bar. The number of provided decimals will be conserved. #' Disregarded if 'plot = FALSE'. +#'@param extra_labels Deprecated. Use 'bar_extra_labels' instead. #'@param title Title to draw on top of the colour bar, most commonly with the #' units of the represented field in the neighbour figures. Empty by default. #'@param title_scale Scale factor for the 'title' of the colour bar. #' Takes 1 by default. -#'@param label_scale Scale factor for the labels of the colour bar. +#'@param bar_label_scale Scale factor for the labels of the colour bar. #' Takes 1 by default. -#'@param tick_scale Scale factor for the length of the ticks of the labels +#'@param label_scale Deprecated. Use 'bar_label_scale' instead. +#'@param bar_tick_scale Scale factor for the length of the ticks of the labels #' along the colour bar. Takes 1 by default. -#'@param extra_margin Extra margins to be added around the colour bar, +#'@param tick_scale Deprecated. Use 'bar_tick_scale' instead. +#'@param bar_extra_margin Extra margins to be added around the colour bar, #' in the format c(y1, x1, y2, x2). The units are margin lines. Takes #' rep(0, 4) by default. -#'@param label_digits Number of significant digits to be displayed in the +#'@param extra_margin Deprecated. Use 'bar_extra_margin' instead. +#'@param bar_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 'bar_extra_labels'. Takes 4 by default. +#'@param label_digits Deprecated. Use 'bar_label_digits' instead. #'@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 @@ -147,11 +152,13 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, color_fun = ClimPalette(), plot = TRUE, - draw_ticks = TRUE, draw_separators = FALSE, - 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, ...) { + draw_bar_ticks = TRUE, draw_separators = FALSE, + triangle_ends_scale = 1, bar_extra_labels = NULL, + extra_labels = NULL, title = NULL, title_scale = 1, + bar_label_scale = 1, label_scale = NULL, + bar_tick_scale = 1, tick_scale = NULL, + bar_extra_margin = rep(0, 4), extra_margin = NULL, + bar_label_digits = 4, label_digits = NULL, ...) { # 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 ", @@ -325,18 +332,22 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'vertical' must be TRUE or FALSE.") } - # Check extra_labels - if (is.null(extra_labels)) { - extra_labels <- numeric(0) + # Check bar_extra_labels + if (missing(bar_extra_labels) && !missing(extra_labels)) { + warning("The parameter 'extra_labels' is deprecated. Use 'bar_extra_labels' instead.") + bar_extra_labels <- extra_labels } - if (!is.numeric(extra_labels)) { - stop("Parameter 'extra_labels' must be numeric.") + if (is.null(bar_extra_labels)) { + bar_extra_labels <- numeric(0) + } + if (!is.numeric(bar_extra_labels)) { + stop("Parameter 'bar_extra_labels' must be numeric.") } else { - if (any(extra_labels > bar_limits[2]) || any(extra_labels < bar_limits[1])) { - stop("Parameter 'extra_labels' must not contain ticks beyond the color bar limits.") + if (any(bar_extra_labels > bar_limits[2]) || any(bar_extra_labels < bar_limits[1])) { + stop("Parameter 'bar_extra_labels' must not contain ticks beyond the color bar limits.") } } - extra_labels <- sort(extra_labels) + bar_extra_labels <- sort(bar_extra_labels) # Check subsampleg primes <- function(x) { @@ -358,7 +369,7 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } if (subsampleg > (length(brks) - 1) / 4) { subsampleg <- max(1, round(length(brks) / 4)) - extra_labels <- c(extra_labels, bar_limits[2]) + bar_extra_labels <- c(bar_extra_labels, bar_limits[2]) added_final_tick <- TRUE if ((length(brks) - 1) %% subsampleg < (length(brks) - 1) / 4 / 2) { remove_final_tick <- TRUE @@ -388,9 +399,9 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'triangle_ends_scale' must be numeric.") } - # Check draw_ticks - if (!is.logical(draw_ticks)) { - stop("Parameter 'draw_ticks' must be logical.") + # Check draw_bar_ticks + if (!is.logical(draw_bar_ticks)) { + stop("Parameter 'draw_bar_ticks' must be logical.") } # Check title @@ -406,26 +417,42 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'title_scale' must be numeric.") } - # Check label_scale - if (!is.numeric(label_scale)) { - stop("Parameter 'label_scale' must be numeric.") + # Check bar_label_scale + if (missing(bar_label_scale) && !missing(label_scale)) { + warning("The parameter 'label_scale' is deprecated. Use 'bar_label_scale' instead.") + bar_label_scale <- label_scale + } + if (!is.numeric(bar_label_scale)) { + stop("Parameter 'bar_label_scale' must be numeric.") } - # Check tick_scale - if (!is.numeric(tick_scale)) { - stop("Parameter 'tick_scale' must be numeric.") + # Check bar_tick_scale + if (missing(bar_tick_scale) && !missing(tick_scale)) { + warning("The parameter 'tick_scale' is deprecated. Use 'bar_tick_scale' instead.") + bar_tick_scale <- tick_scale + } + if (!is.numeric(bar_tick_scale)) { + stop("Parameter 'bar_tick_scale' must be numeric.") } - # Check extra_margin - if (!is.numeric(extra_margin) || length(extra_margin) != 4) { - stop("Parameter 'extra_margin' must be a numeric vector of length 4.") + # Check bar_extra_margin + if (missing(bar_extra_margin) && !missing(extra_margin)) { + warning("The parameter 'extra_margin' is deprecated. Use 'bar_extra_margin' instead.") + bar_extra_margin <- extra_margin + } + if (!is.numeric(bar_extra_margin) || length(bar_extra_margin) != 4) { + stop("Parameter 'bar_extra_margin' must be a numeric vector of length 4.") } - # Check label_digits - if (!is.numeric(label_digits)) { - stop("Parameter 'label_digits' must be numeric.") + # Check bar_label_digits + if (missing(bar_label_digits) && !missing(label_digits)) { + warning("The parameter 'label_digits' is deprecated. Use 'bar_label_digits' instead.") + bar_label_digits <- label_digits + } + if (!is.numeric(bar_label_digits)) { + stop("Parameter 'bar_label_digits' must be numeric.") } - label_digits <- round(label_digits) + bar_label_digits <- round(bar_label_digits) # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude @@ -456,15 +483,15 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, # Set up color bar plot region margins <- c(0.0, 0, 0.0, 0) cex_title <- 1 * title_scale - cex_labels <- 0.9 * label_scale - cex_ticks <- -0.3 * tick_scale + cex_labels <- 0.9 * bar_label_scale + cex_ticks <- -0.3 * bar_tick_scale spaceticklab <- max(-cex_ticks, 0) if (vertical) { margins[1] <- margins[1] + (1.2 * cex_labels * 3 + spaceticklab) * cs - margins <- margins + extra_margin[c(4, 1:3)] * cs + margins <- margins + bar_extra_margin[c(4, 1:3)] * cs } else { margins[1] <- margins[1] + (1.2 * cex_labels * 1 + spaceticklab) * cs - margins <- margins + extra_margin * cs + margins <- margins + bar_extra_margin * cs } if (title != '') { margins[3] <- margins[3] + (1.0 * cex_title) * cs @@ -565,7 +592,7 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, # Put the ticks plot_range <- length(brks) - 1 var_range <- tail(brks, 1) - head(brks, 1) - extra_labels_at <- ((extra_labels - head(brks, 1)) / var_range) * plot_range + 0.5 + bar_extra_labels_at <- ((bar_extra_labels - head(brks, 1)) / var_range) * plot_range + 0.5 at <- seq(1, length(brks), subsampleg) labels <- brks[at] # Getting rid of next-to-last tick if too close to last one @@ -573,13 +600,13 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, at <- at[-length(at)] labels <- labels[-length(labels)] } - labels <- signif(labels, label_digits) + labels <- signif(labels, bar_label_digits) if (added_final_tick) { - extra_labels[length(extra_labels)] <- signif(tail(extra_labels, 1), label_digits) + bar_extra_labels[length(bar_extra_labels)] <- signif(tail(bar_extra_labels, 1), bar_label_digits) } at <- at - 0.5 - at <- c(at, extra_labels_at) - labels <- c(labels, extra_labels) + at <- c(at, bar_extra_labels_at) + labels <- c(labels, bar_extra_labels) tick_reorder <- sort(at, index.return = TRUE) at <- tick_reorder$x if (draw_labels) { @@ -587,7 +614,7 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } else { labels <- FALSE } - axis(d, at = at, tick = draw_ticks, labels = labels, cex.axis = cex_labels, tcl = cex_ticks) + axis(d, at = at, tick = draw_bar_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)) diff --git a/R/ColorBarDiscrete.R b/R/ColorBarDiscrete.R index 0f4d85405854522d7006841d221ae0983f6ef3f2..3d7b572329e14d457367680b3d0cb7bc75e8a6e1 100644 --- a/R/ColorBarDiscrete.R +++ b/R/ColorBarDiscrete.R @@ -42,7 +42,7 @@ #' colorbar. Takes by default an approximation of a value that yields a #' readable tick arrangement (extreme breaks always ticked). If set to 0 or #' lower, no labels are drawn. See the code of the function for details or -#' use 'extra_labels' for customized tick arrangements. +#' use 'bar_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 #' this interval, the drawing of triangle extremes is triggered at the @@ -63,31 +63,36 @@ #' parameter is set by default to ClimPalette(). #'@param plot Logical value indicating whether to only compute its breaks and #' colours (FALSE) or to also draw it on the current device (TRUE). -#'@param draw_ticks Whether to draw ticks for the labels along the colour bar +#'@param draw_bar_ticks Whether to draw ticks for the labels along the colour bar #' (TRUE) or not (FALSE). TRUE by default. Disregarded if 'plot = FALSE'. #'@param draw_separators Whether to draw black lines in the borders of each of #' the colour rectancles of the colour bar (TRUE) or not (FALSE). FALSE by #' default. Disregarded if 'plot = FALSE'. #'@param labels A charater string vector of the names of colors. Must be the #' same length as 'cols'. -#'@param extra_labels Numeric vector of extra labels to draw along axis of +#'@param bar_extra_labels Numeric vector of extra labels to draw along axis of #' the colour bar. The number of provided decimals will be conserved. #' Disregarded if 'plot = FALSE'. +#'@param extra_labels Deprecated. Use 'bar_extra_labels' instead. #'@param title Title to draw on top of the colour bar, most commonly with the #' units of the represented field in the neighbour figures. Empty by default. #'@param title_scale Scale factor for the 'title' of the colour bar. #' Takes 1 by default. -#'@param label_scale Scale factor for the labels of the colour bar. +#'@param bar_label_scale Scale factor for the labels of the colour bar. #' Takes 1 by default. -#'@param tick_scale Scale factor for the length of the ticks of the labels +#'@param label_scale Deprecated. Use 'bar_label_scale' instead. +#'@param bar_tick_scale Scale factor for the length of the ticks of the labels #' along the colour bar. Takes 1 by default. -#'@param extra_margin Extra margins to be added around the colour bar, +#'@param tick_scale Deprecated. Use 'bar_tick_scale' instead. +#'@param bar_extra_margin Extra margins to be added around the colour bar, #' in the format c(y1, x1, y2, x2). The units are margin lines. Takes #' rep(0, 4) by default. -#'@param label_digits Number of significant digits to be displayed in the +#'@param extra_margin Deprecated. Use 'bar_extra_margin' instead. +#'@param bar_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 'bar_extra_labels'. Takes 4 by default. +#'@param label_digits Deprecated. Use 'bar_label_digits' instead. #'@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 @@ -108,8 +113,8 @@ #'@examples #'cb <- ColorBarDiscrete( #' brks = 0:4, cols = c("green1", "green2", "green3", "green4"), -#' vertical = FALSE, labels = paste0('lev ', 1:4), label_scale = 1.5, -#' extra_margin = c(0.5, 2, 0.5, 2), plot = FALSE) +#' vertical = FALSE, labels = paste0('lev ', 1:4), bar_label_scale = 1.5, +#' bar_extra_margin = c(0.5, 2, 0.5, 2), plot = FALSE) #' #'@import utils #'@importFrom grDevices col2rgb rgb @@ -117,11 +122,13 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, bar_limits = NULL, var_limits = NULL, color_fun = ClimPalette(), plot = TRUE, - draw_ticks = FALSE, draw_separators = TRUE, labels = NULL, - extra_labels = NULL, - title = NULL, title_scale = 1, - label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) { + draw_bar_ticks = FALSE, draw_separators = TRUE, + labels = NULL, bar_extra_labels = NULL, + extra_labels = NULL, title = NULL, title_scale = 1, + bar_label_scale = 1, label_scale = NULL, + bar_tick_scale = 1, tick_scale = NULL, + bar_extra_margin = rep(0, 4), extra_margin = NULL, + bar_label_digits = 4, label_digits = NULL, ...) { # Sanity 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 ", @@ -234,23 +241,37 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'vertical' must be TRUE or FALSE.") } - ## extra_labels - if (is.null(extra_labels)) { - extra_labels <- numeric(0) + ## bar_extra_labels + if (missing(bar_extra_labels) && !missing(extra_labels)) { + warning("The parameter 'extra_labels' is deprecated. Use 'bar_extra_labels' instead.") + bar_extra_labels <- extra_labels } - if (!is.numeric(extra_labels)) { - stop("Parameter 'extra_labels' must be numeric.") + if (is.null(bar_extra_labels)) { + bar_extra_labels <- numeric(0) + } + if (!is.numeric(bar_extra_labels)) { + stop("Parameter 'bar_extra_labels' must be numeric.") } else { - if (any(extra_labels > bar_limits[2]) || any(extra_labels < bar_limits[1])) { - stop("Parameter 'extra_labels' must not contain ticks beyond the color bar limits.") + if (any(bar_extra_labels > bar_limits[2]) || any(bar_extra_labels < bar_limits[1])) { + stop("Parameter 'bar_extra_labels' must not contain ticks beyond the color bar limits.") } } - extra_labels <- sort(extra_labels) + bar_extra_labels <- sort(bar_extra_labels) + + ## bar_label_digits + if (missing(bar_label_digits) && !missing(label_digits)) { + warning("The parameter 'label_digits' is deprecated. Use 'bar_label_digits' instead.") + bar_label_digits <- label_digits + } + if (!is.numeric(bar_label_digits)) { + stop("Parameter 'bar_label_digits' must be numeric.") + } + bar_label_digits <- round(bar_label_digits) ## labels if (is.null(labels)) { labels <- rep(NA, length(cols)) - tmp <- signif(brks, label_digits) + tmp <- signif(brks, bar_label_digits) for (i_brks in 1:length(cols)) { labels[i_brks] <- paste0("(", tmp[i_brks], ", ", tmp[i_brks + 1], "]") } @@ -278,7 +299,7 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, } if (subsampleg > (length(brks) - 1) / 4) { subsampleg <- max(1, round(length(brks) / 4)) - extra_labels <- c(extra_labels, bar_limits[2]) + bar_extra_labels <- c(bar_extra_labels, bar_limits[2]) added_final_tick <- TRUE if ((length(brks) - 1) %% subsampleg < (length(brks) - 1) / 4 / 2) { remove_final_tick <- TRUE @@ -303,9 +324,9 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'draw_separators' must be logical.") } - ## draw_ticks - if (!is.logical(draw_ticks)) { - stop("Parameter 'draw_ticks' must be logical.") + ## draw_bar_ticks + if (!is.logical(draw_bar_ticks)) { + stop("Parameter 'draw_bar_ticks' must be logical.") } ## title @@ -321,26 +342,32 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, stop("Parameter 'title_scale' must be numeric.") } - ## label_scale - if (!is.numeric(label_scale)) { - stop("Parameter 'label_scale' must be numeric.") + ## bar_label_scale + if (missing(bar_label_scale) && !missing(label_scale)) { + warning("The parameter 'label_scale' is deprecated. Use 'bar_label_scale' instead.") + bar_label_scale <- label_scale } - - ## tick_scale - if (!is.numeric(tick_scale)) { - stop("Parameter 'tick_scale' must be numeric.") + if (!is.numeric(bar_label_scale)) { + stop("Parameter 'bar_label_scale' must be numeric.") } - ## extra_margin - if (!is.numeric(extra_margin) || length(extra_margin) != 4) { - stop("Parameter 'extra_margin' must be a numeric vector of length 4.") + ## bar_tick_scale + if (missing(bar_tick_scale) && !missing(tick_scale)) { + warning("The parameter 'tick_scale' is deprecated. Use 'bar_tick_scale' instead.") + bar_tick_scale <- tick_scale + } + if (!is.numeric(bar_tick_scale)) { + stop("Parameter 'bar_tick_scale' must be numeric.") } - ## label_digits - if (!is.numeric(label_digits)) { - stop("Parameter 'label_digits' must be numeric.") + ## bar_extra_margin + if (missing(bar_extra_margin) && !missing(extra_margin)) { + warning("The parameter 'extra_margin' is deprecated. Use 'bar_extra_margin' instead.") + bar_extra_margin <- extra_margin + } + if (!is.numeric(bar_extra_margin) || length(bar_extra_margin) != 4) { + stop("Parameter 'bar_extra_margin' must be a numeric vector of length 4.") } - label_digits <- round(label_digits) # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude @@ -445,7 +472,7 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, # Put the ticks plot_range <- length(brks) - 1 var_range <- tail(brks, 1) - head(brks, 1) - extra_labels_at <- ((extra_labels - head(brks, 1)) / var_range) * plot_range + 0.5 + bar_extra_labels_at <- ((bar_extra_labels - head(brks, 1)) / var_range) * plot_range + 0.5 at <- seq(1, length(cols), subsampleg) # at <- seq(1, length(brks), subsampleg) # labels <- brks[at] @@ -454,13 +481,13 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, # at <- at[-length(at)] # labels <- labels[-length(labels)] # } -# labels <- signif(labels, label_digits) +# labels <- signif(labels, bar_label_digits) if (added_final_tick) { - extra_labels[length(extra_labels)] <- signif(tail(extra_labels, 1), label_digits) + bar_extra_labels[length(bar_extra_labels)] <- signif(tail(bar_extra_labels, 1), bar_label_digits) } # at <- at - 0.5 - at <- c(at, extra_labels_at) - labels <- c(labels, extra_labels) + at <- c(at, bar_extra_labels_at) + labels <- c(labels, bar_extra_labels) tick_reorder <- sort(at, index.return = TRUE) at <- tick_reorder$x if (draw_labels) { @@ -469,7 +496,7 @@ ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, labels <- FALSE } # Put box labels - axis(d, at = at, tick = draw_ticks, labels = labels, cex.axis = cex_labels, tcl = cex_ticks) + axis(d, at = at, tick = draw_bar_ticks, labels = labels, cex.axis = cex_labels, tcl = cex_ticks) par(saved_pars) } invisible(list(brks = brks, cols = cols)) diff --git a/R/Viz2VarsVsLTime.R b/R/Viz2VarsVsLTime.R index f4a634585ae0fee15c6b599d3a9543f612884320..d96394e96ec000a8ebea265389189de813ca7235 100644 --- a/R/Viz2VarsVsLTime.R +++ b/R/Viz2VarsVsLTime.R @@ -17,12 +17,14 @@ #'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. #'@param hlines c(a, b, ...) Add horizontal black lines at Y-positions a, b, #' ... The default value is NULL. -#'@param leg TRUE/FALSE if legend should be added or not to the plot. +#'@param drawleg TRUE/FALSE if legend should be added or not to the plot. #' Default = TRUE. +#'@param leg Deprecated. Use 'drawleg' instead. #'@param siglev TRUE/FALSE if significance level should replace confidence #' interval.\cr #' Default = FALSE. -#'@param sizetit Multiplicative factor to change title size, optional. +#'@param title_scale Multiplicative factor to change title size, optional. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param show_conf TRUE/FALSE to show/not confidence intervals for input #' variables. #'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, @@ -65,7 +67,7 @@ #'input_rms[, 3, ] <- rms_ano$conf.upper[, 1, 1, ] #'esviz:::Viz2VarsVsLTime(input_cor, input_rms, #' toptitle = "Time correlation and RMSE with ERA5", -#' ytitle = "K", sizetit = 0.7, +#' ytitle = "K", title_scale = 0.7, #' monini = 11, freq = 1, limits = c(-1, 5), #' listexp = c('SEAS5'), listvars = c('Corr', 'RMSE'), #' fileout = NULL) @@ -73,12 +75,13 @@ #'@importFrom grDevices png jpeg postscript pdf svg bmp tiff postscript dev.cur dev.new dev.off #'@importFrom stats ts Viz2VarsVsLTime <- function(var1, var2, toptitle = '', ytitle = '', monini = 1, - freq = 12, nticks = NULL, limits = NULL, listexp = - c('exp1', 'exp2', 'exp3'), listvars = c('var1', - 'var2'), biglab = FALSE, hlines = NULL, leg = TRUE, - siglev = FALSE, sizetit = 1, show_conf = TRUE, - fileout = NULL, - width = 8, height = 5, size_units = 'in', res = 100, ...) { + freq = 12, nticks = NULL, limits = NULL, listexp = + c('exp1', 'exp2', 'exp3'), listvars = c('var1', + 'var2'), biglab = FALSE, hlines = NULL, + drawleg = TRUE, leg = NULL, siglev = FALSE, + title_scale = 1, sizetit = NULL, show_conf = TRUE, + fileout = NULL, width = 8, height = 5, + size_units = 'in', 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", "fin", "lab", "las", "lty", "lwd", "mai", "mgp", "new", "pin", "ps", "pty") @@ -130,6 +133,25 @@ Viz2VarsVsLTime <- function(var1, var2, toptitle = '', ytitle = '', monini = 1, end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), frequency = freq) empty <- array(dim = length(empty_ts)) + + # Check drawleg + if (missing(drawleg) && !missing(leg)) { + warning("The parameter 'leg' is deprecated. Use 'drawleg' instead.") + drawleg <- leg + } + if (!is.logical(drawleg) || length(drawleg) != 1) { + stop("Parameter 'drawleg' must be a single logical value.") + } + + # Check title_scale + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } + # # Define some plot parameters # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -193,7 +215,7 @@ Viz2VarsVsLTime <- function(var1, var2, toptitle = '', ytitle = '', monini = 1, legsize <- 1 } plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, - main = toptitle, cex.main = cexmain * sizetit, axes = FALSE) + main = toptitle, cex.main = cexmain * title_scale, axes = FALSE) axis(1, at = labind, labels = labmonth) axis(2) box() @@ -234,7 +256,7 @@ Viz2VarsVsLTime <- function(var1, var2, toptitle = '', ytitle = '', monini = 1, } } } - if (leg) { + if (drawleg) { legend(1, ul, legendnames, lty = legendsty, lwd = legendthick, col = legendcol, cex = legsize) } diff --git a/R/VizACC.R b/R/VizACC.R index 2787383b4f5a65b5cca08bf2a04669923195e2fb..b2197076b9bf33c4c3fa95eedc5bdc431a2c3304 100644 --- a/R/VizACC.R +++ b/R/VizACC.R @@ -15,7 +15,8 @@ #' interval and the 95\% significance level. #'@param sdates A character vector of startdates: c('YYYYMMDD','YYYYMMDD'). #'@param toptitle A character string of the main title, optional. -#'@param sizetit A multiplicative factor to scale title size, optional. +#'@param title_scale A multiplicative factor to scale title size, optional. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param ytitle A character string of the title of Y-axis for each experiment: #' c('', ''), optional. #'@param limits A numeric vector c(lower limit, upper limit): limits of the @@ -64,16 +65,16 @@ #'sdates <- paste0(2000:2005, '1101') #'esviz:::VizACC(input_acc, sdates, #' toptitle = "Spatial anomaly corr. coeff. with ERA5", -#' ytitle = "K", sizetit = 0.7, freq = 12, +#' ytitle = "K", title_scale = 0.7, freq = 12, #' legends = 'SEAS5', fileout = NULL) #' } #'@importFrom grDevices dev.cur dev.new dev.off #'@importFrom stats ts -VizACC <- function(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", - limits = NULL, legends = NULL, freq = 12, biglab = FALSE, - fill = FALSE, linezero = FALSE, points = TRUE, vlines = NULL, - fileout = NULL, - width = 8, height = 5, size_units = 'in', res = 100, ...) { +VizACC <- function(ACC, sdates, toptitle = "", title_scale = 1, sizetit = NULL, + ytitle = "", limits = NULL, legends = NULL, freq = 12, + biglab = FALSE, fill = FALSE, linezero = FALSE, + points = TRUE, vlines = NULL, fileout = NULL, + width = 8, height = 5, size_units = 'in', 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", "lab", "las", "lty", @@ -87,8 +88,15 @@ VizACC <- function(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", saveToFile <- deviceInfo$fun fileout <- deviceInfo$files } - - # + # Check title_scale + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } + # Check dim if (length(dim(ACC)) != 5 | dim(ACC)[5] != 4) { stop("5 dim needed : c(nexp, nobs, nsdates, nltime, 4)") } @@ -145,7 +153,7 @@ VizACC <- function(ACC, sdates, toptitle = "", sizetit = 1, ytitle = "", legsize <- 1 } plot(empty_ts, ylim = c(ll, ul), xlab = "Time (years)", ylab = ytitle, - main = toptitle, cex.main = cexmain * sizetit) + main = toptitle, cex.main = cexmain * title_scale) for (jexp in 1:nexp) { for (jobs in 1:nobs) { numcol <- jobs + (jexp - 1) * nobs diff --git a/R/VizAnimateMap.R b/R/VizAnimateMap.R index 061ca1e9604767c56e458f096947f6e82e36c172..f90a35558de66cb5e4826daf33d1b5a64b7367c3 100644 --- a/R/VizAnimateMap.R +++ b/R/VizAnimateMap.R @@ -7,22 +7,24 @@ #'observed data along the forecast time (lead-time) for all input experiments #'and input observational datasets. #' -#'@param var Matrix of dimensions (nltime, nlat, nlon) or +#'@param data Matrix of dimensions (nltime, nlat, nlon) or #' (nexp/nmod, nltime, nlat, nlon) or (nexp/nmod, 3/4, nltime, nlat, nlon) or #' (nexp/nmod, nobs, 3/4, nltime, nlat, nlon). +#'@param var Deprecated. Use 'data' instead. #'@param lon Vector containing longtitudes (degrees). #'@param lat Vector containing latitudes (degrees). #'@param toptitle c('','', \dots) array of main title for each animation, #' optional. If RMS, RMSSS, correlations: first exp with successive obs, then #' second exp with successive obs, etc ... -#'@param sizetit Multiplicative factor to increase title size, optional. +#'@param title_scale Scale factor for the figure top title. Defaults to 1. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param units Units, optional. #'@param monini Starting month between 1 and 12. Default = 1. #'@param freq 1 = yearly, 12 = monthly, 4 = seasonal ... #'@param msk95lev TRUE/FALSE grid points with dots if 95\% significance level #' reached. Default = FALSE. #'@param brks Limits of colour levels, optional. For example: -#' seq(min(var), max(var), (max(var) - min(var)) / 10). +#' seq(min(data), max(data), (max(data) - min(data)) / 10). #'@param cols Vector of colours of length(brks) - 1, optional. #'@param filled.continents Continents filled in grey (TRUE) or represented by #' a black line (FALSE). Default = TRUE. Filling unavailable if crossing @@ -68,9 +70,9 @@ #' \item{ #' Model output from load/ano/smoothing: #' (nmod, nmemb, sdate, nltime, nlat, nlon) -#' then passed through spread(var, posdim = 2, narm = TRUE) -#' & mean1dim(var, posdim = 3, narm = TRUE) -#' or through trend(mean1dim(var, 2), posTR = 2): +#' then passed through spread(data, posdim = 2, narm = TRUE) +#' & mean1dim(data, posdim = 3, narm = TRUE) +#' or through trend(mean1dim(data, 2), posTR = 2): #' (nmod, 3, nltime, nlat, nlon) #' animates average along start dates of IQR/MaxMin/SD/MAD across members #' or trends of the ensemble-mean computed accross the start dates. @@ -96,21 +98,22 @@ #'lons <- attr(map_temp$exp, "Variables")$common$lon #' \dontrun{ #'esviz:::VizAnimateMap(clim$clim_exp[1, 1, , , ], lon = lons, lat = lats, -#' toptitle = "climatology of decadal prediction", sizetit = 1, +#' toptitle = "climatology of decadal prediction", title_scale = 1, #' units = "K", brks = seq(270, 300, 3), monini = 11, freq = 12, #' msk95lev = FALSE, filled.continents = FALSE, intlon = 10, intlat = 10) #' } #'@importFrom grDevices postscript dev.off #'@importFrom s2dv InsertDim -VizAnimateMap <- function(var, lon, lat, toptitle = rep("", 11), sizetit = 1, - units = "", monini = 1, freq = 12, msk95lev = FALSE, - brks = NULL, cols = NULL, filled.continents = FALSE, - lonmin = 0, lonmax = 360, latmin = -90, latmax = 90, - intlon = 20, intlat = 30, drawleg = TRUE, - subsampleg = 1, colNA = "white", equi = TRUE, - fileout = c("output1_animvsltime.gif", - "output2_animvsltime.gif", - "output3_animvsltime.gif"), ...) { +VizAnimateMap <- function(data, lon, lat, toptitle = rep("", 11), title_scale = 1, + sizetit = NULL, units = "", monini = 1, freq = 12, + msk95lev = FALSE, brks = NULL, cols = NULL, + filled.continents = FALSE, lonmin = 0, lonmax = 360, + latmin = -90, latmax = 90, intlon = 20, intlat = 30, + drawleg = TRUE, subsampleg = 1, colNA = "white", + equi = TRUE, fileout = c("output1_animvsltime.gif", + "output2_animvsltime.gif", + "output3_animvsltime.gif"), + var = NULL, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("bg", "col", "fin", "lab", "lend", "new", "pin", "ps") @@ -124,37 +127,54 @@ VizAnimateMap <- function(var, lon, lat, toptitle = rep("", 11), sizetit = 1, } fileout <- sub("\\.[a-zA-Z0-9]*$", "", fileout) - # - - # Check var - if (!is.numeric(var) || !is.array(var)) { - stop("Parameter 'var' must be a numeric array.") + # Check data + if (missing(data) || is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") + } + if (!is.numeric(data) || !is.array(data)) { + stop("Parameter 'data' must be a numeric array.") } - if (length(dim(var)) < 3 || length(dim(var)) > 6) { - stop("Parameter 'var' must be an array with 3 to 6 dimensions.") + if (length(dim(data)) < 3 || length(dim(data)) > 6) { + stop("Parameter 'data' must be an array with 3 to 6 dimensions.") } - if (length(dim(var)) == 3) { - var <- InsertDim(var, posdim = 1, lendim = 1, name = 'new') + if (length(dim(data)) == 3) { + data <- InsertDim(data, posdim = 1, lendim = 1, name = 'new') } - if (length(dim(var)) == 4) { - var <- InsertDim(var, posdim = 2, lendim = 3, name = 'new') + if (length(dim(data)) == 4) { + data <- InsertDim(data, posdim = 2, lendim = 3, name = 'new') + } + if (length(dim(data)) == 5) { + data <- InsertDim(data, posdim = 2, lendim = 1, name = 'new') + } + + # Check title_scale + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit } - if (length(dim(var)) == 5) { - var <- InsertDim(var, posdim = 2, lendim = 1, name = 'new') + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") } - nleadtime <- dim(var)[4] - nexp <- dim(var)[1] - nobs <- dim(var)[2] - nlat <- dim(var)[5] - nlon <- dim(var)[6] + nleadtime <- dim(data)[4] + nexp <- dim(data)[1] + nobs <- dim(data)[2] + nlat <- dim(data)[5] + nlon <- dim(data)[6] if (length(lon) != nlon | length(lat) != nlat) { - stop("Inconsistent var dimensions / longitudes + latitudes") + stop("Inconsistent data dimensions / longitudes + latitudes") } colorbar <- ClimPalette() if (is.null(brks) == TRUE) { - ll <- signif(min(var[, , 2, , , ], na.rm = TRUE), 4) - ul <- signif(max(var[, , 2, , , ], na.rm = TRUE), 4) + ll <- signif(min(data[, , 2, , , ], na.rm = TRUE), 4) + ul <- signif(max(data[, , 2, , , ], na.rm = TRUE), 4) if (is.null(cols) == TRUE) { cols <- colorbar(10) } @@ -198,17 +218,17 @@ VizAnimateMap <- function(var, lon, lat, toptitle = rep("", 11), sizetit = 1, for (jt in 1:nleadtime) { title <- paste(toptitle[(jexp - 1) * nobs + jobs], " Time=", suffixtit[jt], sep = "") - varbis <- var[jexp, jobs, 2, jt, which(lat >= + varbis <- data[jexp, jobs, 2, jt, which(lat >= latmin & lat <= latmax), which(lon >= lonmin & lon <= lonmax)] varbis <- varbis[latb$ix, lonb$ix] flag <- array(FALSE, dim(varbis)) if (msk95lev) { - flag[which(var[jexp, jobs, 1, jt, latb$ix, - lonb$ix] > 0 & var[jexp, jobs, 3, jt, latb$ix, + flag[which(data[jexp, jobs, 1, jt, latb$ix, + lonb$ix] > 0 & data[jexp, jobs, 3, jt, latb$ix, lonb$ix] > 0)] <- TRUE - flag[which(var[jexp, jobs, 1, jt, latb$ix, - lonb$ix] < 0 & var[jexp, jobs, 3, jt, latb$ix, + flag[which(data[jexp, jobs, 1, jt, latb$ix, + lonb$ix] < 0 & data[jexp, jobs, 3, jt, latb$ix, lonb$ix] < 0)] <- TRUE } varbis[which(varbis <= min(brks))] <- min(brks) + @@ -217,13 +237,13 @@ VizAnimateMap <- function(var, lon, lat, toptitle = rep("", 11), sizetit = 1, (max(brks) - min(brks))/1000 if (equi) { VizEquiMap(t(varbis), lonb$x, latb$x, toptitle = title, - title_scale = sizetit, units = units, filled.continents = filled.continents, + title_scale = title_scale, units = units, filled.continents = filled.continents, dots = t(flag), brks = brks, cols = cols, intxlon = intlon, intylat = intlat, drawleg = drawleg, subsampleg = subsampleg, colNA = colNA, ...) } else { VizStereoMap(t(varbis), lonb$x, latb$x, latlims = c(latmin, - latmax), toptitle = title, title_scale = sizetit, + latmax), toptitle = title, title_scale = title_scale, units = units, filled.continents = filled.continents, dots = t(flag), brks = brks, cols = cols, intlat = intlat, drawleg = drawleg, subsampleg = subsampleg, diff --git a/R/VizAno.R b/R/VizAno.R index 7a034209d4d5cb4c6926484286b5519ca9a037cd..6122c04cf2f8fd4c7d04fa26e1eefb9e1ebbdd56 100644 --- a/R/VizAno.R +++ b/R/VizAno.R @@ -28,7 +28,8 @@ #'@param points TRUE/FALSE if points instead of lines should be shown. #' Default = FALSE. #'@param vlines List of x location where to add vertical black lines, optional. -#'@param sizetit Multiplicative factor to scale title size, optional. +#'@param title_scale Multiplicative factor to scale title size, optional. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param fileout Name of the output file for each experiment: c('',''). #' Extensions allowed: eps/ps, jpeg, png, pdf, bmp and tiff. If filenames #' with different extensions are passed, it will be considered only the first @@ -62,12 +63,12 @@ #'@importFrom stats ts #'@importFrom s2dv MeanDims VizAno <- function(exp_ano, obs_ano = NULL, sdates, toptitle = rep('', 15), - ytitle = rep('', 15), limits = NULL, legends = NULL, - freq = 12, biglab = FALSE, fill = TRUE, memb = TRUE, - ensmean = TRUE, linezero = FALSE, points = FALSE, - vlines = NULL, sizetit = 1, - fileout = NULL, - width = 8, height = 5, size_units = 'in', res = 100, ...) { + ytitle = rep('', 15), limits = NULL, legends = NULL, + freq = 12, biglab = FALSE, fill = TRUE, memb = TRUE, + ensmean = TRUE, linezero = FALSE, points = FALSE, + vlines = NULL, title_scale = 1, sizetit = NULL, + fileout = NULL, width = 8, height = 5, size_units = 'in', + 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", "fin", "lab", "las", "lty", "lwd", "mai", "mgp", "new", "pch", "pin", "ps", "pty") @@ -107,6 +108,14 @@ VizAno <- function(exp_ano, obs_ano = NULL, sdates, toptitle = rep('', 15), if (!all(nchar(sdates) == 8)) { stop ("The parameter 'sdates' must be formatted as YYYYMMDD.") } + # title_scale check + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } if (is.null(limits) == TRUE) { if (memb) { @@ -187,7 +196,7 @@ VizAno <- function(exp_ano, obs_ano = NULL, sdates, toptitle = rep('', 15), legsize <- 1 } plot(empty_ts, ylim = c(ll, ul), xlab = "Time (years)", ylab = ytitle[jexp], - main = toptitle[jexp], cex.main = cexmain * sizetit) + main = toptitle[jexp], cex.main = cexmain * title_scale) # # Plot experimental data + all observational datasets sdate by sdate # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/R/VizClim.R b/R/VizClim.R index 84dcd4616a98241f2131e60a8cc731ebba8e88b9..b4902b29cd4d0fc5e0dc1704276f9fa72926afb7 100644 --- a/R/VizClim.R +++ b/R/VizClim.R @@ -19,8 +19,10 @@ #'@param listexp List of experiment names, optional. #'@param listobs List of observational dataset names, optional. #'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. -#'@param leg TRUE/FALSE to plot the legend or not. -#'@param sizetit Multiplicative factor to scale title size, optional. +#'@param drawleg TRUE/FALSE to plot the legend or not. Default = TRUE. +#'@param leg Deprecated. Use 'drawleg' instead. +#'@param title_scale Multiplicative factor to scale title size, optional. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param width File width, in the units specified in the parameter size_units #' (inches by default). Takes 8 by default. #'@param height File height, in the units specified in the parameter @@ -57,8 +59,9 @@ VizClim <- function(exp_clim, obs_clim = NULL, toptitle = '', ytitle = '', monini = 1, freq = 12, limits = NULL, listexp = c('exp1', 'exp2', 'exp3'), listobs = c('obs1', 'obs2', 'obs3'), biglab = FALSE, - leg = TRUE, sizetit = 1, fileout = NULL, - width = 8, height = 5, size_units = 'in', res = 100, ...) { + drawleg = TRUE, leg = NULL, title_scale = 1, sizetit = NULL, + fileout = NULL, width = 8, height = 5, size_units = 'in', + 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", "fin", "lab", "las", "lty", "lwd", "mai", "mgp", "new", "pin", "ps", "pty", "tcl") @@ -112,6 +115,25 @@ VizClim <- function(exp_clim, obs_clim = NULL, toptitle = '', ytitle = '', } lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + + # Check drawleg + if (missing(drawleg) && !missing(leg)) { + warning("The parameter 'leg' is deprecated. Use 'drawleg' instead.") + drawleg <- leg + } + if (!is.logical(drawleg) || length(drawleg) != 1) { + stop("Parameter 'drawleg' must be a single logical value.") + } + + # Check title_scale + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } + # # Define some plot parameters # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -166,7 +188,7 @@ VizClim <- function(exp_clim, obs_clim = NULL, toptitle = '', ytitle = '', legsize <- 1 } plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, - main = toptitle, cex.main = cexmain * sizetit, axes = FALSE) + main = toptitle, cex.main = cexmain * title_scale, axes = FALSE) axis(1, at = labind, labels = labmonth) axis(2) box() @@ -191,14 +213,14 @@ VizClim <- function(exp_clim, obs_clim = NULL, toptitle = '', ytitle = '', axes = FALSE) } } - if (leg) { + if (drawleg) { legend(1, ul, c(listexp[1:nexp], listobs[1:nobs]), lty = c(array(1, dim = nexp), type[1:nobs]), lwd = c(array(2, dim = nexp), thickness[1:nobs]), col = c(color[1:nexp], array(1, dim = nobs)), cex = legsize) } } else { - if (leg) { + if (drawleg) { legend(1, ul, listexp[1:nexp], lty = 1, lwd = 2, col = color[1:nexp], cex = legsize) } diff --git a/R/VizCombinedMap.R b/R/VizCombinedMap.R index 5119385ae254354fe9ed69134d5b901764ec8e60..79e91a10e6bae0a6f3dc0e43e597525e9146abe1 100644 --- a/R/VizCombinedMap.R +++ b/R/VizCombinedMap.R @@ -50,9 +50,10 @@ #'@param mask Optional numeric array with dimensions (latitude, longitude), with #' values in the range [0, 1], indicating the opacity of the mask over each #' grid point. Cells with a 0 will result in no mask, whereas cells with a 1 -#' will result in a totally opaque superimposed pixel coloured in 'col_mask'. -#'@param col_mask Colour to be used for the superimposed mask (if specified in +#' will result in a totally opaque superimposed pixel coloured in 'mask_color'. +#'@param mask_color Colour to be used for the superimposed mask (if specified in #' 'mask'). Takes the value 'grey' by default. +#'@param col_mask Deprecated. Use 'mask_color' instead. #'@param dots Array of same dimensions as 'var' or with dimensions #' c(n, dim(var)), where n is the number of dot/symbol layers to add to the #' plot. A value of TRUE at a grid cell will draw a dot/symbol on the @@ -61,23 +62,23 @@ #' layers via the parameter 'dot_symbol'. #'@param bar_titles Optional vector of character strings providing the titles to #' be shown on top of each of the colour bars. -#'@param legend_scale Scale factor for the size of the colour bar labels. Takes +#'@param bar_label_scale Scale factor for the size of the colour bar labels. Takes #' 1 by default. #'@param cex_bar_titles Scale factor for the sizes of the bar titles. Takes 1.5 #' by default. -#'@param plot_margin Numeric vector of length 4 for the margin sizes in the -#' following order: bottom, left, top, and right. If not specified, use the -#' default of par("mar"), c(5.1, 4.1, 4.1, 2.1). Used as 'margin_scale' in -#' VizEquiMap. +#'@param margin_scale Numeric vector of length 4 for the margin sizes in the +#' following order: bottom, left, top, and right. If not specified (NULL), the +#' default of par("mar"), c(5.1, 4.1, 4.1, 2.1), is used. Default is NULL. +#'@param plot_margin Deprecated. Use 'margin_scale' instead. #'@param bar_extra_margin A numeric vector of 4 indicating the extra margins to #' be added around the color bar, in the format c(y1, x1, y2, x2). The units #' are margin lines. The default values are c(2, 0, 2, 0). #'@param fileout File where to save the plot. If not specified (default) a #' graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, bmp #' and tiff -#'@param width File width, in the units specified in the parameter size_units +#'@param width File width, in the units specified in the parameter 'size_units' #' (inches by default). Takes 8 by default. -#'@param height File height, in the units specified in the parameter size_units +#'@param height File height, in the units specified in the parameter 'size_units' #' (inches by default). Takes 5 by default. #'@param size_units Units of the size of the device (file or window) to plot in. #' Inches ('in') by default. See ?Devices and the creator function of the @@ -142,14 +143,14 @@ VizCombinedMap <- function(maps, lon, lat, bar_limits = NULL, triangle_ends = c(FALSE, FALSE), col_inf = NULL, col_sup = NULL, col_unknown_map = 'white', - mask = NULL, col_mask = 'grey', + mask = NULL, mask_color = 'grey', col_mask = NULL, dots = NULL, - bar_titles = NULL, legend_scale = 1, - cex_bar_titles = 1.5, + bar_titles = NULL, bar_label_scale = 1, + cex_bar_titles = 1.5, margin_scale = NULL, plot_margin = NULL, bar_extra_margin = c(2, 0, 2, 0), fileout = NULL, width = 8, height = 5, - size_units = 'in', res = 100, drawleg = T, return_leg = FALSE, - ...) { + size_units = 'in', res = 100, drawleg = T, + return_leg = FALSE, ...) { args <- list(...) # If there is any filenames to store the graphics, process them @@ -282,12 +283,12 @@ VizCombinedMap <- function(maps, lon, lat, subsampleg = NULL, bar_limits = bar_limits, var_limits = var_limits_maps, triangle_ends = triangle_ends, col_inf = col_inf, col_sup = col_sup, plot = FALSE, draw_separators = TRUE, - bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, + bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = bar_label_scale * 1.5, extra_margin = bar_extra_margin) - # Check legend_scale - if (!is.numeric(legend_scale)) { - stop("Parameter 'legend_scale' must be numeric.") + # Check bar_label_scale + if (!is.numeric(bar_label_scale)) { + stop("Parameter 'bar_label_scale' must be numeric.") } # Check col_unknown_map @@ -295,9 +296,13 @@ VizCombinedMap <- function(maps, lon, lat, stop("Parameter 'col_unknown_map' must be a character string.") } - # Check col_mask - if (!is.character(col_mask)) { - stop("Parameter 'col_mask' must be a character string.") + # Check mask_color + if (missing(mask_color) && !missing(col_mask)) { + warning("The parameter 'col_mask' is deprecated. Use 'mask_color' instead.") + mask_color <- col_mask + } + if (!is.character(mask_color)) { + stop("Parameter 'mask_color' must be a character string.") } # Check mask @@ -313,6 +318,7 @@ VizCombinedMap <- function(maps, lon, lat, stop("Parameter 'mask' must have dimensions c(lat, lon).") } } + # Check dots if (!is.null(dots)) { if (length(dim(dots)) != 2) { @@ -323,6 +329,17 @@ VizCombinedMap <- function(maps, lon, lat, stop("Parameter 'mask' must have dimensions c(lat, lon).") } } + + # Check margin_scale + if (missing(margin_scale) && !missing(plot_margin)) { + warning("The parameter 'plot_margin' is deprecated. Use 'margin_scale' instead.") + margin_scale <- plot_margin + } + if (!is.null(margin_scale)) { + if (!is.numeric(margin_scale) || length(margin_scale) != 4) { + stop("Parameter 'margin_scale' must be a numeric vector of length 4: c(bottom, left, top, right).") + } + } #---------------------- # Identify the most likely map @@ -458,13 +475,13 @@ VizCombinedMap <- function(maps, lon, lat, } } - if (is.null(plot_margin)) { - plot_margin <- c(5, 4, 4, 2) + 0.1 # default of par()$mar + if (is.null(margin_scale)) { + margin_scale <- c(5, 4, 4, 2) + 0.1 # default of par()$mar } VizEquiMap(var = ml_map, lon = lon, lat = lat, brks = tbrks, cols = tcols, drawleg = FALSE, - filled.continents = FALSE, dots = dots, margin_scale = plot_margin, ...) + filled.continents = FALSE, dots = dots, margin_scale = margin_scale, ...) #---------------------- # Add overplot on top @@ -480,7 +497,7 @@ VizCombinedMap <- function(maps, lon, lat, lonb <- sort(lon, index.return = TRUE) cols_mask <- sapply(seq(from = 0, to = 1, length.out = 10), - function(x) adjustcolor(col_mask, alpha.f = x)) + function(x) adjustcolor(mask_color, alpha.f = x)) image(lonb$x, latb$x, t(mask)[lonb$ix, latb$ix], axes = FALSE, col = cols_mask, breaks = seq(from = 0, to = 1, by = 0.1), @@ -516,7 +533,7 @@ VizCombinedMap <- function(maps, lon, lat, var_limits = var_limits_maps, triangle_ends = triangle_ends, col_inf = colorbar$col_inf, col_sup = colorbar$col_sup, plot = TRUE, draw_separators = TRUE, - bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, + bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = bar_label_scale * 1.5, extra_margin = bar_extra_margin) } @@ -532,7 +549,7 @@ VizCombinedMap <- function(maps, lon, lat, var_limits = var_limits_maps, triangle_ends = triangle_ends, col_inf = colorbar$col_inf, col_sup = colorbar$col_sup, plot = TRUE, draw_separators = TRUE, - bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, + bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = bar_label_scale * 1.5, extra_margin = bar_extra_margin) warning("The device is not off yet. Use dev.off() after plotting the color bars.") return(tmp) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index ef1b5b5d685e5e202b26493351377089179320ab..a9058184b1ce5e3f0060a291dfffa94db959535a 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -10,7 +10,7 @@ #'include continents, oceans, and lakes. This plot function is compatible with #'figure layouts if colour bar is disabled. #' -#'@param var Array with the values at each cell of a grid on a regular +#'@param data Array with the values at each cell of a grid on a regular #' rectangular or gaussian grid. The array is expected to have two #' dimensions: c(latitude, longitude). Longitudes can be in ascending or #' descending order and latitudes in any order. It can contain NA values @@ -19,20 +19,21 @@ #' this alternative is not appropriate for square arrays. It is allowed that #' the positions of the longitudinal and latitudinal coordinate dimensions #' are interchanged. +#'@param var Deprecated. Use 'data' instead. #'@param lon Numeric vector of longitude locations of the cell centers of the -#' grid of 'var', in ascending or descending order (same as 'var'). Expected +#' grid of 'data', in ascending or descending order (same as 'data'). Expected #' to be regularly spaced, within either of the ranges [-180, 180] or #' [0, 360]. Data for two adjacent regions split by the limits of the #' longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)} -#' ('var' must be provided consitently). +#' ('data' must be provided consitently). #'@param lat Numeric vector of latitude locations of the cell centers of the -#' grid of 'var', in any order (same as 'var'). Expected to be from a regular +#' grid of 'data', in any order (same as 'data'). Expected to be from a regular #' rectangular or gaussian grid, within the range [-90, 90]. #'@param varu Array of the zonal component of wind/current/other field with -#' the same dimensions as 'var'. It is allowed that the positions of the +#' the same dimensions as 'data'. It is allowed that the positions of the #' longitudinal and latitudinal coordinate dimensions are interchanged. #'@param varv Array of the meridional component of wind/current/other field -#' with the same dimensions as 'var'. It is allowed that the positions of the +#' with the same dimensions as 'data'. It is allowed that the positions of the #' longitudinal and latitudinal coordinate dimensions are interchanged. #'@param toptitle Top title of the figure, scalable with parameter #' 'title_scale'. @@ -43,18 +44,18 @@ #' manipulation functions like \code{paste()} or \code{paste0()}, using #' \code{"\n"} to indicate line breaks. #'@param units Title at the top of the colour bar, most commonly the units of -#' the variable provided in parameter 'var'. +#' the variable provided in parameter 'data'. #'@param brks,cols,bar_limits,triangle_ends Usually only providing 'brks' is #' enough to generate the desired colour bar. These parameters allow to #' define n breaks that define n - 1 intervals to classify each of the values -#' in 'var'. The corresponding grid cell of a given value in 'var' will be +#' in 'data'. The corresponding grid cell of a given value in 'data' will be #' coloured in function of the interval it belongs to. These parameters are #' sent to \code{ColorBar()} to generate the breaks and colours. Additional #' colours for values beyond the limits of the colour bar are also generated #' and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are #' properly provided to do so. See ?ColorBar for a full explanation. #'@param col_inf,col_sup,colNA Colour identifiers to colour the values in -#' 'var' that go beyond the extremes of the colour bar and to colour NA +#' 'data' that go beyond the extremes of the colour bar and to colour NA #' values, respectively. 'colNA' takes attr(cols, 'na_color') if available by #' default, where cols is the parameter 'cols' if provided or the vector of #' colors returned by 'color_fun'. If not available, it takes 'pink' by @@ -70,7 +71,7 @@ #' parameters to control the visual aspect of the drawn colour bar (3/3). #' See ?ColorBar for a full explanation. #'@param square Logical value to choose either to draw a coloured square for -#' each grid cell in 'var' (TRUE; default) or to draw contour lines and fill +#' each grid cell in 'data' (TRUE; default) or to draw contour lines and fill #' the spaces in between with colours (FALSE). In the latter case, #' 'filled.continents' will take the value FALSE if not specified. #'@param filled.continents Colour to fill in drawn projected continents. @@ -94,7 +95,7 @@ #' location of the shape. The default value is NULL. #'@param shapefile_color Line color of the shapefile. #'@param shapefile_lwd Line width of the shapefile. The default value is 1. -#'@param contours Array of same dimensions as 'var' to be added to the plot +#'@param contours Array of same dimensions as 'data' to be added to the plot #' and displayed with contours. Parameter 'brks2' is required to define the #' magnitude breaks for each contour curve. Disregarded if 'square = FALSE'. #' It is allowed that the positions of the longitudinal and latitudinal @@ -111,8 +112,8 @@ #' contour labels or not. The default value is TRUE. #'@param contour_label_scale Scale factor for the superimposed labels when #' drawing contour levels. -#'@param dots Array of same dimensions as 'var' or with dimensions -#' c(n, dim(var)), where n is the number of dot/symbol layers to add to the +#'@param dots Array of same dimensions as 'data' or with dimensions +#' c(n, dim(data)), where n is the number of dot/symbol layers to add to the #' plot. A value of TRUE at a grid cell will draw a dot/symbol on the #' corresponding square of the plot. By default all layers provided in 'dots' #' are plotted with dots, but a symbol can be specified for each of the @@ -126,7 +127,7 @@ #'@param dot_size Scale factor for the dots/symbols to be plotted, specified #' in 'dots'. If a single value is specified, it will be applied to all #' layers in 'dots'. Takes 1 by default. -#'@param mask An array with the same dimensions as 'var' of [0, 1] or logical +#'@param mask An array with the same dimensions as 'data' of [0, 1] or logical #' indicating the grids to not plot data. The value 0 or FALSE is the point not #' to be plotted. #'@param mask_color Color of the mask. The default value is 'white'. @@ -184,6 +185,31 @@ #'@param vertical TRUE/FALSE for vertical/horizontal colour bar. Default is #' FALSE. Parameters 'width' and 'height' might need to be modified to #' accommodate the vertical colour bar. +#'@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 hatching_mask Logical or binary (0/1) array with two named dimensions: +#' c(latitude, longitude). Hatching is applied to grid cells where +#' 'hatching_mask' is TRUE (or 1). Arrays with dimensions c(longitude, latitude) +#' are also accepted, but the resulting hatching may appear transposed. To +#' ensure correct alignment with the map, provide 'data'. The function will +#' compare the dimension order of 'hatching_mask' and 'data', and automatically +#' transpose 'hatching_mask' if the latitude and longitude dimensions appear to +#' be reversed. +#'@param hatching_density The density of shading lines, in lines per inch. A +#' zero value of density means no shading nor filling, whereas negative values +#' and NA suppress shading (and so allow color filling). NULL means that no +#' shading lines are drawn. Default is 10. +#'@param hatching_angle The slope of shading lines, given as an angle in degrees +#' (counter-clockwise). Default is 45. +#'@param hatching_color Color of the hatching lines. Default is +#' \code{"#252525"}. +#'@param hatching_lwd The line width, a positive number. The interpretation is +#' device-specific, and some devices do not implement line widths less than +#' one. Default is 0.5. +#'@param hatching_cross A logical value indicating crosshatching. If TRUE, adds +#' a second set of lines in the opposite angle. Default is FALSE. #'@param boxlim Limits of a box to be added to the plot, in degrees: #' c(x1, y1, x2, y2). A list with multiple box specifications can also be #' provided. @@ -203,40 +229,15 @@ #'@param fileout File where to save the plot. If not specified (default) a #' graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, #' bmp and tiff. -#'@param width File width, in the units specified in the parameter size_units +#'@param width File width, in the units specified in the parameter 'size_units' #' (inches by default). Takes 8 by default. #'@param height File height, in the units specified in the parameter -#' size_units (inches by default). Takes 5 by default. +#' 'size_units' (inches by default). Takes 5 by default. #'@param size_units Units of the size of the device (file or window) to plot #' in. Inches ('in') by default. See ?Devices and the creator function of #' 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 hatching_mask Logical or binary (0/1) array with two named dimensions: -#' c(latitude, longitude). Hatching is applied to grid cells where -#' 'hatching_mask' is TRUE (or 1). Arrays with dimensions c(longitude, latitude) -#' are also accepted, but the resulting hatching may appear transposed. To -#' ensure correct alignment with the map, provide 'data'. The function will -#' compare the dimension order of 'hatching_mask' and 'data', and automatically -#' transpose 'hatching_mask' if the latitude and longitude dimensions appear to -#' be reversed. -#'@param hatching_density The density of shading lines, in lines per inch. A -#' zero value of density means no shading nor filling, whereas negative values -#' and NA suppress shading (and so allow color filling). NULL means that no -#' shading lines are drawn. Default is 10. -#'@param hatching_angle The slope of shading lines, given as an angle in degrees -#' (counter-clockwise). Default is 45. -#'@param hatching_color Color of the hatching lines. Default is -#' \code{"#252525"}. -#'@param hatching_lwd The line width, a positive number. The interpretation is -#' device-specific, and some devices do not implement line widths less than -#' one. Default is 0.5. -#'@param hatching_cross A logical value indicating crosshatching. If TRUE, adds -#' a second set of lines in the opposite angle. Default is FALSE. #'@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 @@ -266,11 +267,11 @@ #' \dontrun{ #'ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, #' dat_dim = c('dat', 'member'), memb_dim = 'member') -#'var <- s2dv::MeanDims(ano$exp, "member") +#'data <- s2dv::MeanDims(ano$exp, "member") #'lats <- attr(map_temp$exp, "Variables")$common$lat #'lons <- attr(map_temp$exp, "Variables")$common$lon #' -#'VizEquiMap(var[1, 1, 1, 1, , ], lon = lons, lat = lats, +#'VizEquiMap(data[1, 1, 1, 1, , ], lon = lons, lat = lats, #' toptitle = 'Near-surface temperature anomaly, Nov. 2000', #' filled.continents = FALSE, title_scale = 0.7, #' caption = paste0("This is a test caption.", "\n", @@ -279,9 +280,9 @@ #'@import graphics maps utils #'@importFrom grDevices dev.cur dev.new dev.off gray #'@importFrom stats cor -#' @importFrom s2dv InsertDim +#'@importFrom s2dv InsertDim #'@export -VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, +VizEquiMap <- function(data, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, sizetit = NULL, caption = NULL, units = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, @@ -308,16 +309,17 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, draw_separators = FALSE, triangle_ends_scale = 1, bar_label_digits = 4, bar_label_scale = 1, units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), + bar_extra_margin = rep(0, 4), + include_lower_boundary = TRUE, + include_upper_boundary = TRUE, hatching_mask = NULL, + hatching_density = 10, hatching_angle = 45, + hatching_color = "#252525", hatching_lwd = 0.5, + hatching_cross = FALSE, boxlim = NULL, boxcol = 'purple2', boxlwd = 5, margin_scale = rep(1, 4), title_scale = 1, caption_size = 0.8, numbfig = NULL, fileout = NULL, width = 8, height = 5, size_units = 'in', - res = 100, include_lower_boundary = TRUE, - include_upper_boundary = TRUE, hatching_mask = NULL, - hatching_density = 10, hatching_angle = 45, - hatching_color = "#252525", hatching_lwd = 0.5, - hatching_cross = FALSE, ...) { + res = 100, var = 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") @@ -336,59 +338,66 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, stop("Parameters 'lon' and 'lat' must be numeric vectors.") } - # Check var - if (is.null(var)) { - stop("Parameter 'var' cannot be NULL.") + # Check data + if (missing(data) || is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") } - if (!is.array(var)) { - stop("Parameter 'var' must be a numeric array.") + if (!is.array(data)) { + stop("Parameter 'data' must be a numeric array.") } transpose <- FALSE - if (!is.null(names(dim(var)))) { - if (any(names(dim(var)) %in% .KnownLonNames()) && - any(names(dim(var)) %in% .KnownLatNames())) { - lon_dim <- names(dim(var))[names(dim(var)) %in% .KnownLonNames()] - lat_dim <- names(dim(var))[names(dim(var)) %in% .KnownLatNames()] + if (!is.null(names(dim(data)))) { + if (any(names(dim(data)) %in% .KnownLonNames()) && + any(names(dim(data)) %in% .KnownLatNames())) { + lon_dim <- names(dim(data))[names(dim(data)) %in% .KnownLonNames()] + lat_dim <- names(dim(data))[names(dim(data)) %in% .KnownLatNames()] } else { - names(dim(var)) <- NULL + names(dim(data)) <- NULL lat_dim <- NULL lon_dim <- NULL - warning("Dimension names of 'var' doesn't correspond to any coordinates names supported by s2dv package.") + warning("Dimension names of 'data' doesn't correspond to any coordinates names supported by s2dv package.") } } else { lon_dim <- NULL lat_dim <- NULL - warning("Parameter 'var' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.") + warning("Parameter 'data' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.") } - if (length(dim(var)) > 2) { + if (length(dim(data)) > 2) { if (!is.null(lon_dim) & !is.null(lat_dim)) { - dimnames <- names(dim(var)) - dim(var) <- dim(var)[which((dimnames == lon_dim | dimnames == lat_dim | dim(var) != 1))] + dimnames <- names(dim(data)) + dim(data) <- dim(data)[which((dimnames == lon_dim | dimnames == lat_dim | dim(data) != 1))] } else { - if (all(dim(var) == 1)) { - dim(var) <- c(1, 1) - } else if (length(dim(var)[which(dim(var) > 1)]) == 2) { - var <- drop(var) - } else if (length(dim(var)[which(dim(var) > 1)]) == 1) { - dim(var) <- c(dim(var)[which(dim(var) > 1)], 1) + if (all(dim(data) == 1)) { + dim(data) <- c(1, 1) + } else if (length(dim(data)[which(dim(data) > 1)]) == 2) { + data <- drop(data) + } else if (length(dim(data)[which(dim(data) > 1)]) == 1) { + dim(data) <- c(dim(data)[which(dim(data) > 1)], 1) } } } - if (length(dim(var)) != 2) { - stop("Parameter 'var' must be a numeric array with two dimensions.") + if (length(dim(data)) != 2) { + stop("Parameter 'data' must be a numeric array with two dimensions.") } - if ((dim(var)[1] == length(lon) && dim(var)[2] == length(lat)) || - (dim(var)[2] == length(lon) && dim(var)[1] == length(lat))) { - if (dim(var)[2] == length(lon) && dim(var)[1] == length(lat)) { + if ((dim(data)[1] == length(lon) && dim(data)[2] == length(lat)) || + (dim(data)[2] == length(lon) && dim(data)[1] == length(lat))) { + if (dim(data)[2] == length(lon) && dim(data)[1] == length(lat)) { if (length(lon) == length(lat)) { - if (is.null(names(dim(var)))) { - warning("Parameter 'var' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.") + if (is.null(names(dim(data)))) { + warning("Parameter 'data' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.") } else { - if (names(dim(var)[1]) == lat_dim) { + if (names(dim(data)[1]) == lat_dim) { transpose <- TRUE } } @@ -397,17 +406,17 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } } } else { - stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'var'.") + stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'data'.") } - if (!is.null(names(dim(var)))) { - if (names(dim(var)[1]) == lon_dim) { + if (!is.null(names(dim(data)))) { + if (names(dim(data)[1]) == lon_dim) { if (transpose) { - stop("Coordinates dimensions of 'var' doesn't correspond to lat or lon.") + stop("Coordinates dimensions of 'data' doesn't correspond to lat or lon.") } - } else if (names(dim(var)[2]) == lon_dim) { + } else if (names(dim(data)[2]) == lon_dim) { if (!transpose) { - stop("Coordinates dimensions of 'var' doesn't correspond to lat or lon.") + stop("Coordinates dimensions of 'data' doesn't correspond to lat or lon.") } } } @@ -416,13 +425,13 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # with dimensions c(lon, lat). if (transpose) { - var <- t(var) + data <- t(data) } transpose <- FALSE - names(dim(var)) <- c(lon_dim, lat_dim) - dims <- dim(var) + names(dim(data)) <- c(lon_dim, lat_dim) + dims <- dim(data) # Check varu and varv if (!is.null(varu) && !is.null(varv)) { @@ -450,9 +459,9 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { if (!is.null(names(dim(varu)))) { if (!(lon_dim %in% names(dim(varu)) && lat_dim %in% names(dim(varu)))) { - stop("Parameters 'varu' and 'varv' must have same dimension names as 'var'.") - } else if (dim(varu)[lon_dim] != dim(var)[lon_dim] || dim(varu)[lat_dim] != dim(var)[lat_dim]) { - stop("Parameters 'varu' and 'varv' must have same dimensions as 'var'.") + stop("Parameters 'varu' and 'varv' must have same dimension names as 'data'.") + } else if (dim(varu)[lon_dim] != dim(data)[lon_dim] || dim(varu)[lat_dim] != dim(data)[lat_dim]) { + stop("Parameters 'varu' and 'varv' must have same dimensions as 'data'.") } } else { warning("Parameters 'varu' and 'varv' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.") @@ -503,9 +512,9 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { if (!is.null(names(dim(contours)))) { if (!(lon_dim %in% names(dim(contours)) && lat_dim %in% names(dim(contours)))) { - stop("Parameters 'contours' must have same dimension names as 'var'.") - } else if (dim(contours)[lon_dim] != dim(var)[lon_dim] || dim(contours)[lat_dim] != dim(var)[lat_dim]) { - stop("Parameters 'contours' must have same dimensions as 'var'.") + stop("Parameters 'contours' must have same dimension names as 'data'.") + } else if (dim(contours)[lon_dim] != dim(data)[lon_dim] || dim(contours)[lat_dim] != dim(data)[lat_dim]) { + stop("Parameters 'contours' must have same dimensions as 'data'.") } } else { warning("Parameters 'contours' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.") @@ -580,37 +589,37 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, stop("Parameter 'vertical' must be TRUE or FALSE.") } - tmp <- .create_var_limits(data = var, brks = brks, + tmp <- .create_var_limits(data = data, 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, + # draw_separators, triangle_ends_scale, bar_label_scale, units, units_scale, # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup colorbar <- ColorBarContinuous(brks, cols, vertical = vertical, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, - extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, + bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks, draw_separators = draw_separators, 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) + bar_label_scale = bar_label_scale, title = units, + title_scale = units_scale, bar_tick_scale = bar_tick_scale, + bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits) 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'. + # Adjust 'data' 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 + data[data == 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 + data[data == tail(brks, 1)] <- tail(brks, 1) + tail(diff(brks), 1)/10 } # Check colNA @@ -739,7 +748,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, if (is.null(contours)) { if (!square) { brks2 <- brks - contours <- var + contours <- data } } else { ll <- signif(min(contours, na.rm = TRUE), 2) @@ -787,9 +796,9 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } else { if (!is.null(names(dim(dots)))) { if (!(lon_dim %in% names(dim(dots)) && lat_dim %in% names(dim(dots)))) { - stop("Parameters 'dots' must have same dimension names as 'var'.") - } else if (dim(dots)[lon_dim] != dim(var)[lon_dim] || dim(dots)[lat_dim] != dim(var)[lat_dim]) { - stop("Parameters 'dots' must have same dimensions as 'var'.") + stop("Parameters 'dots' must have same dimension names as 'data'.") + } else if (dim(dots)[lon_dim] != dim(data)[lon_dim] || dim(dots)[lat_dim] != dim(data)[lat_dim]) { + stop("Parameters 'dots' must have same dimensions as 'data'.") } } else { warning("Parameters 'dots' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.") @@ -813,7 +822,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } } } else { - stop("Parameter 'dots' must have same number of longitudes and latitudes as 'var'.") + stop("Parameter 'dots' must have same number of longitudes and latitudes as 'data'.") } if (transpose) { @@ -848,14 +857,14 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, if (!is.null(mask)) { mask <- drop(mask) if (!is.array(mask) || any(!names(dim(mask)) %in% c(lon_dim, lat_dim))) { - stop("Parameter 'mask' must have two dimensions named as the longitude and latitude dimensions in 'var'.") + stop("Parameter 'mask' must have two dimensions named as the longitude and latitude dimensions in 'data'.") } else { - if (!identical(names(dim(mask)), names(dim(var)))) { - mask <- aperm(mask, match(names(dim(mask)), names(dim(var)))) + if (!identical(names(dim(mask)), names(dim(data)))) { + mask <- aperm(mask, match(names(dim(mask)), names(dim(data)))) } } - if (!identical(dim(mask), dim(var))) { - stop("Parameter 'mask' must have the same dimensions as 'var'.") + if (!identical(dim(mask), dim(data))) { + stop("Parameter 'mask' must have the same dimensions as 'data'.") } else if (is.numeric(mask)) { if (all(mask %in% c(0, 1))) { mask <- array(as.logical(mask), dim = dim(mask)) @@ -882,7 +891,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, if (!is.null(hatching_mask)) { hatching_mask <- drop(hatching_mask) if (!is.array(hatching_mask) || any(!names(dim(hatching_mask)) %in% c(lon_dim, lat_dim))) { - stop("Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'var'.") + stop("Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'data'.") } } @@ -1218,18 +1227,18 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # If lat and lon are both regular-spaced, "useRaster = TRUE" can avoid # artifact white lines on the figure. If not, useRaster has to be FALSE (default) tryCatch({ - image(lonb$x, latb$x, var[lonb$ix, latb$ix], + image(lonb$x, latb$x, data[lonb$ix, latb$ix], col = c(col_inf_image, cols, col_sup_image), breaks = c(-.Machine$double.xmax, 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], + image(lonb$x, latb$x, data[lonb$ix, latb$ix], col = c(col_inf_image, cols, col_sup_image), breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax), axes = FALSE, xlab = "", ylab = "", add = TRUE) }) } else { - .filled.contour(lonb$x, latb$x, var[lonb$ix, latb$ix], + .filled.contour(lonb$x, latb$x, data[lonb$ix, latb$ix], levels = c(.Machine$double.xmin, brks, .Machine$double.xmax), col = c(col_inf_image, cols, col_sup_image)) } @@ -1252,13 +1261,13 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # if (!is.null(dots)) { - data_avail <- !is.na(var) + data_avail <- !is.na(data) for (counter in 1:(dim(dots)[1])) { points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE) points(lon[points[, 1]], lat[points[, 2]], pch = dot_symbol[counter], - cex = dot_size[counter] * 3 / sqrt(sqrt(length(var))), - lwd = dot_size[counter] * 3 / sqrt(sqrt(length(var)))) + cex = dot_size[counter] * 3 / sqrt(sqrt(length(data))), + lwd = dot_size[counter] * 3 / sqrt(sqrt(length(data)))) } } @@ -1267,7 +1276,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # ~~~~~~~~~~~~~~~~~ # if (!is.null(hatching_mask)) { - Hatching(hatching_mask = hatching_mask, lat = lat, lon = lon, data = var, + Hatching(hatching_mask = hatching_mask, lat = lat, lon = lon, data = data, hatching_density = hatching_density, hatching_angle = hatching_angle, hatching_color = hatching_color, hatching_lwd = hatching_lwd, @@ -1486,11 +1495,11 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } ColorBarContinuous(brks, cols, vertical = vertical, subsampleg, bar_limits, var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup, - extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, + bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks, 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) + bar_label_scale = bar_label_scale, bar_tick_scale = bar_tick_scale, + bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits) } # If the graphic was saved to file, close the connection with the device diff --git a/R/VizForecastPDF.R b/R/VizForecastPDF.R index 39bc2068de4e06fac07de451fb9e15b561777efe..c91c0ab35508585c4802f5a3649977ed75cc1997 100644 --- a/R/VizForecastPDF.R +++ b/R/VizForecastPDF.R @@ -28,13 +28,39 @@ #'@param obs (optional) A vector providing the observed values for each forecast #' panel or a single value that will be reused for all forecast panels. #' (Default: observation is not shown). -#'@param plotfile (optional) A filename (pdf, png...) where the plot will be -#' saved. (Default: the plot is not saved). -#'@param title A string with the plot title. +#'@param toptitle A string with the plot main title. +#'@param title Deprecated. Use 'toptitle' instead. #'@param var.name A string with the variable name and units. -#'@param fcst.names (optional) An array of strings with the titles of each -#' individual forecast. -#'@param add.ensmemb Either to add the ensemble members \code{'above'} (default) +#'@param title.legend A string with the title of the legend showing the +#' probabilistic categories. By default, it is set to "Probability of terciles". +#'@param strings.legend A vector of strings with the name of the probabilistic +#' categories. By default, it is set to c("Below normal", "Near normal", +#' "Above normal"). +#'@param ensemble.legend A string with the title of the legend showing the +#' ensemble members. By default, it is set to "Ensemble members". +#'@param obs.title A string with the title of the legend showing the +#' observations ('obs'). By default, it is set to "Observations". +#'@param strings.obs A vector of strings with the name of the observations, +#' which correspond to the values of 'obs'. By default, it is set to NULL. +#'@param title.extremes A string with the title of the legend showing the +#' extreme categories. By default, it is set to "Probability of extremes". +#'@param strings.extremes A vector of strings with the name of the extreme +#' categories. By default, it is set to c("Below p10", "Above p90"). +#'@param xlab.title A string with the title of the x-axis. By default, it is set +#' to "Probability density". +#'@param fcst.names (optional) A string or vector of strings with the titles of +#' each individual forecast panel. +#'@param title.cex A number with the size of 'toptitle'. By default, it is set +#' to 1. +#'@param labs.cex A number with the size of the labels in the axes. By default, +#' it is set to 1. +#'@param fcst.names.cex A number with the size of the 'fcst.names'. By default, +#' it is set to 1. +#'@param obs.lines A logical value indicating whether to draw horizontal lines +#' at the height of the observations. The default value is TRUE. +#'@param obs.size A number with the size of the observation dots. By default, it +#' is set to 3. +#'@param add.ensmemb Either to add the ensemble members \code{'above'} (default) #' or \code{'below'} the pdf, or not (\code{'no'}). #'@param color.set A selection of predefined color sets: use \code{'ggplot'} #' (default) for blue/green/red, \code{'s2s4e'} for blue/grey/orange, @@ -42,8 +68,18 @@ #' inflows) or the \code{"vitigeoss"} color set. #'@param memb_dim A character string indicating the name of the member #' dimension. -#' +#'@param width File width, in the units specified in the parameter size_units +#' (inches by default). Takes 8 by default. +#'@param height File height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param fileout (optional) A filename (pdf, png...) where the plot will be +#' saved. (Default: the plot is not saved). +#'@param plotfile Deprecated. Use 'fileout' instead. +#'@param res Resolution of the device (file or window) to plot in. See +#' ?Devices and the creator function of the corresponding device. +#' #'@return A ggplot object containing the plot. +#' #'@examples #'fcsts <- data.frame(fcst1 = rnorm(10), fcst2 = rnorm(10, 0.5, 1.2)) #'VizForecastPDF(fcsts,c(-1,1)) @@ -53,575 +89,586 @@ #'@importFrom plyr . dlply #'@importFrom s2dv InsertDim #'@export -VizForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = NULL, - title = "Set a title", +VizForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, + obs = NULL, toptitle = "Set a title", title = NULL, var.name = "Varname (units)", - title.legend = 'Probability of terciles', - ensemble.legend = 'Ensemble members', - obs.title = 'Observations', - title.extremes = 'Probability of extremes', - strings.extremes = c('Below p10', 'Above p90'), - strings.legend = c('Below normal', 'Near normal', 'Above normal'), + title.legend = "Probability of terciles", + strings.legend = c("Below normal", "Near normal", "Above normal"), + ensemble.legend = "Ensemble members", + obs.title = "Observations", strings.obs = NULL, - xlab.title = 'Probability density', - title.cex = 1, - labs.cex = 1, - fcst.names = NULL, - fcst.names.cex = 1, - obs.lines = TRUE, - obs.size = 3, + title.extremes = "Probability of extremes", + strings.extremes = c("Below p10", "Above p90"), + xlab.title = "Probability density", fcst.names = NULL, + title.cex = 1, labs.cex = 1, fcst.names.cex = 1, + obs.lines = TRUE, obs.size = 3, add.ensmemb = c("above", "below", "no"), color.set = c("ggplot", "s2s4e", "hydro", "vitigeoss"), - memb_dim = 'member', - height = 5, width = 6, res = 300, plotfile = NULL) { - - value <- init <- extremes <- x <- ymin <- ymax <- tercile <- NULL - y <- xend <- yend <- yjitter <- MLT <- lab.pos <- NULL - ggColorHue <- function(n) { - hues <- seq(15, 375, length = n + 1) - hcl(h = hues, l = 65, c = 100)[1:n] - } - #------------------------ - # Define color sets - #------------------------ - color.set <- match.arg(color.set) - if (color.set == "s2s4e") { - colorFill <- c("#FF764D", "#b5b5b5", "#33BFD1") # AN, N, BN fill colors - colorHatch <- c("indianred3", "deepskyblue3") # AP90, BP10 line colors - colorMember <- c("#ffff7f") - colorObs <- "purple" - colorLab <- c("red", "blue") # AP90, BP10 text colors - } else if (color.set == "hydro") { - colorFill <- c("#41CBC9", "#b5b5b5", "#FFAB38") - colorHatch <- c("deepskyblue3", "darkorange1") - colorMember <- c("#ffff7f") - colorObs <- "purple" - colorLab <- c("blue", "darkorange3") - } else if (color.set == "ggplot") { - colorFill <- ggColorHue(3) - colorHatch <- c("indianred3", "deepskyblue3") - colorMember <- c("#ffff7f") - colorObs <- "purple" - colorLab <- c("red", "blue") - } else if (color.set == "vitigeoss") { - colorFill <- rev(c("#007be2", "#acb2b5", "#f40000")) - colorHatch <- rev(c("#211b79", "#ae0003")) - colorMember <- c("#ffff7f") - colorObs <- "purple" - colorLab <- colorHatch - } else { - stop("Parameter 'color.set' should be one of ggplot/s2s4e/hydro") + memb_dim = "member", width = 6, height = 5, + fileout = NULL, plotfile = NULL, res = 300) { + value <- init <- extremes <- x <- ymin <- ymax <- tercile <- NULL + y <- xend <- yend <- yjitter <- MLT <- lab.pos <- NULL + ggColorHue <- function(n) { + hues <- seq(15, 375, length = n + 1) + hcl(h = hues, l = 65, c = 100)[1:n] + } + #------------------------ + # Define color sets + #------------------------ + color.set <- match.arg(color.set) + if (color.set == "s2s4e") { + colorFill <- c("#FF764D", "#b5b5b5", "#33BFD1") # AN, N, BN fill colors + colorHatch <- c("indianred3", "deepskyblue3") # AP90, BP10 line colors + colorMember <- c("#ffff7f") + colorObs <- "purple" + colorLab <- c("red", "blue") # AP90, BP10 text colors + } else if (color.set == "hydro") { + colorFill <- c("#41CBC9", "#b5b5b5", "#FFAB38") + colorHatch <- c("deepskyblue3", "darkorange1") + colorMember <- c("#ffff7f") + colorObs <- "purple" + colorLab <- c("blue", "darkorange3") + } else if (color.set == "ggplot") { + colorFill <- ggColorHue(3) + colorHatch <- c("indianred3", "deepskyblue3") + colorMember <- c("#ffff7f") + colorObs <- "purple" + colorLab <- c("red", "blue") + } else if (color.set == "vitigeoss") { + colorFill <- rev(c("#007be2", "#acb2b5", "#f40000")) + colorHatch <- rev(c("#211b79", "#ae0003")) + colorMember <- c("#ffff7f") + colorObs <- "purple" + colorLab <- colorHatch + } else { + stop("Parameter 'color.set' should be one of ggplot/s2s4e/hydro") + } + #------------------------ + # Check input arguments + #------------------------ + add.ensmemb <- match.arg(add.ensmemb) + # Check toptitle + if (missing(toptitle) && !missing(title)) { + warning("The parameter 'title' is deprecated. Use 'toptitle' instead.") + toptitle <- title + } + if (!is.character(toptitle)) { + stop("Parameter 'toptitle' must be a character string.") + } + # Check fileout + if (missing(fileout) && !missing(plotfile)) { + warning("The parameter 'plotfile' is deprecated. Use 'fileout' instead.") + fileout <- plotfile + } + #------------------------ + # Check fcst type and convert to data.frame if needed + #------------------------ + if (is.array(fcst)) { + if (!memb_dim %in% names(dim(fcst)) | length(dim(fcst)) != 2) { + stop("Parameter 'fcst' should be a two-dimensional array with labelled dimensions and one of them should be for member. The name of this dimension can be adjusted with 'memb_dim'.") } - #------------------------ - # Check input arguments - #------------------------ - add.ensmemb <- match.arg(add.ensmemb) - #------------------------ - # Check fcst type and convert to data.frame if needed - #------------------------ - if (is.array(fcst)) { - if (!memb_dim %in% names(dim(fcst)) | length(dim(fcst)) != 2) { - stop("Parameter 'fcst' should be a two-dimensional array with labelled dimensions and one of them should be for member. The name of this dimension can be adjusted with 'memb_dim'.") - } - dim.members <- which(names(dim(fcst)) == memb_dim) - if (dim.members == 1) { - fcst.df <- data.frame(fcst) - } else { - fcst.df <- data.frame(t(fcst)) - } - } else if (is.data.frame(fcst)) { - fcst.df <- fcst + dim.members <- which(names(dim(fcst)) == memb_dim) + if (dim.members == 1) { + fcst.df <- data.frame(fcst) } else { - stop("Parameter 'fcst' should be an array or a data.frame") + fcst.df <- data.frame(t(fcst)) } - npanels <- ncol(fcst.df) - #------------------------ - # Check observations - #------------------------ - if (!is.null(obs)) { - if (is.array(obs) & length(dim(obs)) == 1) { - obs <- as.vector(obs) - } - if (is.vector(obs)) { - if (!length(obs) %in% c(1, npanels)) { - stop("The number of observations should equal one or the number of forecasts") - } - if (!is.null(strings.obs) & !length(obs) == length(strings.obs)) { - stop('The lenghts of string.obs and obs must coincide') - } - } else if (is.array(obs)) { - if (!length(obs[1, ]) %in% c(1, npanels)) { - stop("The number of observations (second dimension) should equal one or the number of forecasts") - } - if (!is.null(strings.obs) & !length(obs[, 1]) == length(strings.obs)) { - stop('The lenghts of string.obs and obs must coincide') - } - colorObs <- rep(c(colorObs, brewer.pal(length(obs[, 1]) - 1, "Accent")), as.numeric(dim(obs)[2])) - } else {stop('Observations should be a vector or an array')} + } else if (is.data.frame(fcst)) { + fcst.df <- fcst + } else { + stop("Parameter 'fcst' should be an array or a data.frame") + } + npanels <- ncol(fcst.df) + #------------------------ + # Check observations + #------------------------ + if (!is.null(obs)) { + if (is.array(obs) & length(dim(obs)) == 1) { + obs <- as.vector(obs) } - #------------------------ - # Check tercile limits - #------------------------ - if (is.vector(tercile.limits)) { - if (length(tercile.limits) != 2) { - stop("Provide two tercile limits") - } - tercile.limits <- InsertDim(tercile.limits, 1, npanels, name = "new") - } else if (is.array(tercile.limits)) { - if (length(dim(tercile.limits)) == 2) { - if (dim(tercile.limits)[2] != 2) { - stop("Provide two tercile limits for each panel") - } - if (dim(tercile.limits)[1] != npanels) { - stop("The number of tercile limits does not match the number of forecasts provided") - } - } else { - stop("Tercile limits should have two dimensions") - } + if (is.vector(obs)) { + if (!length(obs) %in% c(1, npanels)) { + stop("The number of observations should equal one or the number of forecasts") + } + if (!is.null(strings.obs) & !length(obs) == length(strings.obs)) { + stop('The lenghts of string.obs and obs must coincide') + } + } else if (is.array(obs)) { + if (!length(obs[1, ]) %in% c(1, npanels)) { + stop("The number of observations (second dimension) should equal one or the number of forecasts") + } + if (!is.null(strings.obs) & !length(obs[, 1]) == length(strings.obs)) { + stop('The lenghts of string.obs and obs must coincide') + } + colorObs <- rep(c(colorObs, brewer.pal(length(obs[, 1]) - 1, "Accent")), as.numeric(dim(obs)[2])) + } else {stop('Observations should be a vector or an array')} + } + #------------------------ + # Check tercile limits + #------------------------ + if (is.vector(tercile.limits)) { + if (length(tercile.limits) != 2) { + stop("Provide two tercile limits") + } + tercile.limits <- InsertDim(tercile.limits, 1, npanels, name = "new") + } else if (is.array(tercile.limits)) { + if (length(dim(tercile.limits)) == 2) { + if (dim(tercile.limits)[2] != 2) { + stop("Provide two tercile limits for each panel") + } + if (dim(tercile.limits)[1] != npanels) { + stop("The number of tercile limits does not match the number of forecasts provided") + } } else { - stop("Tercile limits should be a vector of length two or an array of dimension (nfcsts,2)") - } - # check consistency of tercile limits - if (any(tercile.limits[, 1] >= tercile.limits[, 2])) { - stop("Inconsistent tercile limits") - } - #------------------------ - # Check extreme limits - #------------------------ - if (!is.null(extreme.limits)) { - if (is.vector(extreme.limits)) { - if (length(extreme.limits) != 2) { - stop("Provide two extreme limits") - } - extreme.limits <- InsertDim(extreme.limits, 1, npanels, name = "new") - } else if (is.array(extreme.limits)) { - if (length(dim(extreme.limits)) == 2) { - if (dim(extreme.limits)[2] != 2) { - stop("Provide two extreme limits for each panel") - } - if (dim(extreme.limits)[1] != npanels) { - stop("The number of extreme limits does not match the number of forecasts provided") - } - } else { - stop("extreme limits should have two dimensions") - } - } else { - stop("Extreme limits should be a vector of length two or an array of dimensions (nfcsts,2)") - } - # Check that extreme limits are consistent with tercile limits - if (any(extreme.limits[, 1] >= tercile.limits[, 1])) { - stop("Inconsistent lower extreme limits") + stop("Tercile limits should have two dimensions") + } + } else { + stop("Tercile limits should be a vector of length two or an array of dimension (nfcsts,2)") + } + # check consistency of tercile limits + if (any(tercile.limits[, 1] >= tercile.limits[, 2])) { + stop("Inconsistent tercile limits") + } + #------------------------ + # Check extreme limits + #------------------------ + if (!is.null(extreme.limits)) { + if (is.vector(extreme.limits)) { + if (length(extreme.limits) != 2) { + stop("Provide two extreme limits") + } + extreme.limits <- InsertDim(extreme.limits, 1, npanels, name = "new") + } else if (is.array(extreme.limits)) { + if (length(dim(extreme.limits)) == 2) { + if (dim(extreme.limits)[2] != 2) { + stop("Provide two extreme limits for each panel") } - if (any(extreme.limits[, 2] <= tercile.limits[, 2])) { - stop("Inconsistent higher extreme limits") + if (dim(extreme.limits)[1] != npanels) { + stop("The number of extreme limits does not match the number of forecasts provided") } - } - #------------------------ - # Set proper fcst names - #------------------------ - if (!is.null(fcst.names)) { - if (length(fcst.names) != dim(fcst.df)[2]) { - stop("Parameter 'fcst.names' should be an array with as many names as distinct forecasts provided") - } - colnames(fcst.df) <- factor(fcst.names, levels = fcst.names) - } - #------------------------ - # Produce a first plot with the pdf for each init in a panel - #------------------------ - melt.df <- reshape2::melt(fcst.df, variable.name = "init", id.vars = NULL) - plot <- ggplot(melt.df, aes(x = value)) + - geom_density(alpha = 1, na.rm = T) + - coord_flip() + facet_wrap(~init, strip.position = "top", nrow = 1) + - xlim(range(c(obs, density(melt.df$value, na.rm = T)$x))) - ggp <- ggplot_build(plot) - #------------------------ - # Gather the coordinates of the plots together with init and corresponding - # terciles - #------------------------ - tmp.df <- ggp$data[[1]][, c("x", "ymin", "ymax", "PANEL")] - if (!is.null(ggp$layout$layout)) { - tmp.df$init <- ggp$layout$layout$init[as.numeric(tmp.df$PANEL)] - } else if (!is.null(ggp$layout$panel_layout)) { - tmp.df$init <- ggp$layout$panel_layout$init[as.numeric(tmp.df$PANEL)] + } else { + stop("extreme limits should have two dimensions") + } } else { - stop("Cannot find PANELS in ggp object") - } - tmp.df$tercile <- factor(ifelse(tmp.df$x < tercile.limits[tmp.df$PANEL, 1], - strings.legend[1], - ifelse(tmp.df$x < tercile.limits[tmp.df$PANEL, 2], - strings.legend[2], strings.legend[3])), - levels = rev(strings.legend)) - #------------------------ - # Get the height and width of a panel - #------------------------ - pan.width <- diff(range(tmp.df$x)) - pan.height <- max(tmp.df$ymax) - magic.ratio <- 9 * pan.height / pan.width - #------------------------ - # Compute hatch coordinates for extremes - #------------------------ - if (!is.null(extreme.limits)) { - tmp.df$extremes <- factor(ifelse(tmp.df$x < extreme.limits[tmp.df$PANEL, 1], - strings.extremes[1], ifelse(tmp.df$x < extreme.limits[tmp.df$PANEL, 2], - strings.legend[2], strings.extremes[2])), - levels = c(strings.extremes[2], strings.legend[2], strings.extremes[1])) - hatch.ls <- dlply(tmp.df, .(init, extremes), function(x) { - # close the polygon - tmp.df2 <- data.frame(x = c(x$x, max(x$x), min(x$x)), y = c(x$ymax, 0, - 0)) - # compute the hatches for this polygon - hatches <- .polygon.fullhatch(tmp.df2$x, tmp.df2$y, angle = 60, density = 10, - width.units = pan.width, height.units = pan.height) - # add bottom segment - end1 <- data.frame(x = x$x[1], y = x$ymax[1], xend = x$x[1], yend = 0) - # add top segment - end2 <- data.frame(x = x$x[length(x$x)], y = x$ymax[length(x$x)], xend = x$x[length(x$x)], - yend = 0) - return(rbind(hatches, end1, end2)) - }) - attr <- attr(hatch.ls, "split_labels") - for (i in 1:length(hatch.ls)) { - hatch.ls[[i]] <- cbind(hatch.ls[[i]], attr[i, ], row.names = NULL) - } - hatch.df <- do.call("rbind", hatch.ls) - # Compute max y for each extreme category - max.ls <- dlply(tmp.df, .(init, extremes), function(x) { - data.frame(y = min(0.85 * pan.height, max(x$ymax))) - }) - attr <- attr(max.ls, "split_labels") - for (i in 1:length(max.ls)) { - max.ls[[i]] <- cbind(max.ls[[i]], attr[i, ], row.names = NULL) - } - max.df <- do.call("rbind", max.ls) - } - #------------------------ - # Compute jitter space for ensemble members - #------------------------ - if (add.ensmemb != "no") { - jitter.df <- reshape2::melt(data.frame(dlply(melt.df, .(init), function(x) { - .jitter.ensmemb(sort(x$value, na.last = T), pan.width / 100) - }), check.names = F), value.name = "yjitter", variable.name = "init", id.vars = NULL) - jitter.df$x <- reshape2::melt(data.frame(dlply(melt.df, .(init), function(x) { - sort(x$value, na.last = T) - })), value.name = "x", id.vars = NULL)$x + stop("Extreme limits should be a vector of length two or an array of dimensions (nfcsts,2)") } - #------------------------ - # Get y coordinates for observed x values, using a cool data.table feature: merge - # to nearest value - #------------------------ - if (!is.null(obs)) { - tmp.dt <- data.table(tmp.df, key = c("init", "x")) - obs.dt <- data.table(init = factor(colnames(fcst.df), levels = colnames(fcst.df)), - value = rep(obs, dim(fcst.df)[2])) - setkey(obs.dt, init, value) - obs.xy <- tmp.dt[obs.dt, roll = "nearest"] + # Check that extreme limits are consistent with tercile limits + if (any(extreme.limits[, 1] >= tercile.limits[, 1])) { + stop("Inconsistent lower extreme limits") } - #------------------------ - # Fill each pdf with different colors for the terciles - #------------------------ - plot <- plot + - geom_ribbon(data = tmp.df, - aes(x = x, ymin = ymin, ymax = ymax, fill = tercile), - alpha = 0.7) - #------------------------ - # Add hatches for extremes - #------------------------ - if (!is.null(extreme.limits)) { - if (nrow(hatch.df[hatch.df$extremes != strings.legend[2], ]) == 0) { - warning("The provided extreme categories are outside the plot bounds. The extremes will not be drawn.") - extreme.limits <- NULL - } else { - plot <- plot + - geom_segment(data = hatch.df[hatch.df$extremes != strings.legend[2], ], - aes(x = x, y = y, - xend = xend, yend = yend, color = extremes)) - } + if (any(extreme.limits[, 2] <= tercile.limits[, 2])) { + stop("Inconsistent higher extreme limits") } - #------------------------ - # Add obs line - #------------------------ - if (!is.null(obs) & isTRUE(obs.lines)) { - plot <- plot + - geom_vline(data = unique(obs.dt), - aes(xintercept = value), - linetype = "dashed", color = colorObs) + } + #------------------------ + # Set proper fcst names + #------------------------ + if (!is.null(fcst.names)) { + if (length(fcst.names) != dim(fcst.df)[2]) { + stop("Parameter 'fcst.names' should be an array with as many names as distinct forecasts provided") } - #------------------------ - # Add ensemble members - #------------------------ - if (add.ensmemb == "below") { - plot <- plot + - # this adds a grey box for ensmembers - geom_rect(aes(xmin = -Inf, xmax = Inf, - ymin = -Inf, ymax = -pan.height / 10), - fill = "gray95", color = "black", width = 0.2) + - # this adds the ensemble members - geom_point(data = jitter.df, - aes(x = x, - y = -pan.height / 10 - magic.ratio * yjitter, - shape = ensemble.legend), - color = "black", fill = colorMember, alpha = 1) - - } else if (add.ensmemb == "above") { - plot <- plot + - geom_point(data = jitter.df, - aes(x = x, - y = 0.7 * magic.ratio * yjitter, - shape = ensemble.legend), - color = "black", fill = colorMember, alpha = 1) - + colnames(fcst.df) <- factor(fcst.names, levels = fcst.names) + } + #------------------------ + # Produce a first plot with the pdf for each init in a panel + #------------------------ + melt.df <- reshape2::melt(fcst.df, variable.name = "init", id.vars = NULL) + plot <- ggplot(melt.df, aes(x = value)) + + geom_density(alpha = 1, na.rm = T) + + coord_flip() + facet_wrap(~init, strip.position = "top", nrow = 1) + + xlim(range(c(obs, density(melt.df$value, na.rm = T)$x))) + ggp <- ggplot_build(plot) + #------------------------ + # Gather the coordinates of the plots together with init and corresponding + # terciles + #------------------------ + tmp.df <- ggp$data[[1]][, c("x", "ymin", "ymax", "PANEL")] + if (!is.null(ggp$layout$layout)) { + tmp.df$init <- ggp$layout$layout$init[as.numeric(tmp.df$PANEL)] + } else if (!is.null(ggp$layout$panel_layout)) { + tmp.df$init <- ggp$layout$panel_layout$init[as.numeric(tmp.df$PANEL)] + } else { + stop("Cannot find PANELS in ggp object") + } + tmp.df$tercile <- factor(ifelse(tmp.df$x < tercile.limits[tmp.df$PANEL, 1], + strings.legend[1], + ifelse(tmp.df$x < tercile.limits[tmp.df$PANEL, 2], + strings.legend[2], strings.legend[3])), + levels = rev(strings.legend)) + #------------------------ + # Get the height and width of a panel + #------------------------ + pan.width <- diff(range(tmp.df$x)) + pan.height <- max(tmp.df$ymax) + magic.ratio <- 9 * pan.height / pan.width + #------------------------ + # Compute hatch coordinates for extremes + #------------------------ + if (!is.null(extreme.limits)) { + tmp.df$extremes <- factor(ifelse(tmp.df$x < extreme.limits[tmp.df$PANEL, 1], + strings.extremes[1], ifelse(tmp.df$x < extreme.limits[tmp.df$PANEL, 2], + strings.legend[2], strings.extremes[2])), + levels = c(strings.extremes[2], strings.legend[2], strings.extremes[1])) + hatch.ls <- dlply(tmp.df, .(init, extremes), function(x) { + # close the polygon + tmp.df2 <- data.frame(x = c(x$x, max(x$x), min(x$x)), y = c(x$ymax, 0, + 0)) + # compute the hatches for this polygon + hatches <- .polygon.fullhatch(tmp.df2$x, tmp.df2$y, angle = 60, density = 10, + width.units = pan.width, height.units = pan.height) + # add bottom segment + end1 <- data.frame(x = x$x[1], y = x$ymax[1], xend = x$x[1], yend = 0) + # add top segment + end2 <- data.frame(x = x$x[length(x$x)], y = x$ymax[length(x$x)], xend = x$x[length(x$x)], + yend = 0) + return(rbind(hatches, end1, end2)) + }) + attr <- attr(hatch.ls, "split_labels") + for (i in 1:length(hatch.ls)) { + hatch.ls[[i]] <- cbind(hatch.ls[[i]], attr[i, ], row.names = NULL) } - #------------------------ - # Add obs diamond - #------------------------ - # if (!is.null(obs)) { - # plot <- plot + - # # this adds the obs diamond - # geom_point(data = obs.xy, - # aes(x = x, y = ymax, size = obs.title), - # shape = 23, color = "black", fill = colorObs, show.legend = F) - # } - # #------------------------ - # Compute probability for each tercile and identify MLT - #------------------------ - tmp.dt <- data.table(tmp.df) - pct <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), - by = .(init, tercile)] - # include potentially missing groups - pct <- merge(pct, CJ(init = factor(levels(pct$init), levels = levels(pct$init)), - tercile = factor(strings.legend, levels = rev(strings.legend))), - by = c("init", "tercile"), all.y = T) - pct[is.na(pct), "pct"] <- 0 - tot <- pct[, .(tot = sum(pct)), by = init] - pct <- merge(pct, tot, by = "init") - pct$pct <- round(100 * pct$pct / pct$tot, 0) - pct$MLT <- pct[, .(MLT = pct == max(pct)), by = init]$MLT - pct <- pct[order(init, tercile)] - pct$lab.pos <- as.vector(apply(tercile.limits, 1, function(x) {c(max(x), mean(x), min(x))})) - #------------------------ - # Compute probability for extremes - #------------------------ - if (!is.null(extreme.limits)) { - pct2 <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), - by = .(init, extremes)] - # include potentially missing groups - pct2 <- merge(pct2, CJ(init = factor(levels(pct2$init), levels = levels(pct2$init)), - extremes = factor(c(strings.extremes[1], strings.legend[2], strings.extremes[2]), - levels = c(strings.extremes[2], strings.legend[2], strings.extremes[1]))), - by = c("init", "extremes"), all.y = T) - pct2[is.na(pct), "pct"] <- 0 - tot2 <- pct2[, .(tot = sum(pct)), by = init] - pct2 <- merge(pct2, tot2, by = "init") - pct2$pct <- round(100 * pct2$pct / pct2$tot, 0) - pct2 <- pct2[order(init, extremes)] - pct2$lab.pos <- as.vector(apply(extreme.limits, 1, function(x) {c(x[2], NA, x[1])})) - pct2 <- merge(pct2, max.df, by = c("init", "extremes"), all.x = T) + hatch.df <- do.call("rbind", hatch.ls) + # Compute max y for each extreme category + max.ls <- dlply(tmp.df, .(init, extremes), function(x) { + data.frame(y = min(0.85 * pan.height, max(x$ymax))) + }) + attr <- attr(max.ls, "split_labels") + for (i in 1:length(max.ls)) { + max.ls[[i]] <- cbind(max.ls[[i]], attr[i, ], row.names = NULL) } - #------------------------ - # Add probability labels for terciles - #------------------------ - if (add.ensmemb == "above") { - labpos <- -0.2 * pan.height - vjust <- 0 + max.df <- do.call("rbind", max.ls) + } + #------------------------ + # Compute jitter space for ensemble members + #------------------------ + if (add.ensmemb != "no") { + jitter.df <- reshape2::melt(data.frame(dlply(melt.df, .(init), function(x) { + .jitter.ensmemb(sort(x$value, na.last = T), pan.width / 100) + }), check.names = F), value.name = "yjitter", variable.name = "init", id.vars = NULL) + jitter.df$x <- reshape2::melt(data.frame(dlply(melt.df, .(init), function(x) { + sort(x$value, na.last = T) + })), value.name = "x", id.vars = NULL)$x + } + #------------------------ + # Get y coordinates for observed x values, using a cool data.table feature: merge + # to nearest value + #------------------------ + if (!is.null(obs)) { + tmp.dt <- data.table(tmp.df, key = c("init", "x")) + obs.dt <- data.table(init = factor(colnames(fcst.df), levels = colnames(fcst.df)), + value = rep(obs, dim(fcst.df)[2])) + setkey(obs.dt, init, value) + obs.xy <- tmp.dt[obs.dt, roll = "nearest"] + } + #------------------------ + # Fill each pdf with different colors for the terciles + #------------------------ + plot <- plot + + geom_ribbon(data = tmp.df, + aes(x = x, ymin = ymin, ymax = ymax, fill = tercile), + alpha = 0.7) + #------------------------ + # Add hatches for extremes + #------------------------ + if (!is.null(extreme.limits)) { + if (nrow(hatch.df[hatch.df$extremes != strings.legend[2], ]) == 0) { + warning("The provided extreme categories are outside the plot bounds. The extremes will not be drawn.") + extreme.limits <- NULL } else { - labpos <- 0 - vjust <- -0.5 + plot <- plot + + geom_segment(data = hatch.df[hatch.df$extremes != strings.legend[2], ], + aes(x = x, y = y, + xend = xend, yend = yend, color = extremes)) } + } + #------------------------ + # Add obs line + #------------------------ + if (!is.null(obs) & isTRUE(obs.lines)) { plot <- plot + - geom_text(data = pct, - aes(x = lab.pos, y = labpos, label = paste0(pct, "%"), - hjust = as.integer(tercile) * -1.5 + 3.5), - vjust = vjust, angle = -90, size = 3.2) + - geom_text(data = pct[MLT == T, ], - aes(x = lab.pos, y = labpos, label = "*", - hjust = as.integer(tercile) * -3.5 + 9), - vjust = 0.1, angle = -90, size = 7, color = "black") - #------------------------ - # Add probability labels for extremes - #------------------------ - if (!is.null(extreme.limits)) { - plot <- plot + - geom_text(data = pct2[extremes != strings.legend[2], ], - aes(x = lab.pos, y = 0.9 * y, label = paste0(pct, "%"), - hjust = as.integer(extremes) * -1.5 + 3.5), - vjust = -0.5, angle = -90, size = 3.2, - color = rep(colorLab, dim(fcst.df)[2])) - } - #------------------------ - # Finish all theme and legend details - #------------------------ + geom_vline(data = unique(obs.dt), + aes(xintercept = value), + linetype = "dashed", color = colorObs) + } + #------------------------ + # Add ensemble members + #------------------------ + if (add.ensmemb == "below") { plot <- plot + - theme_minimal() + - scale_fill_manual(name = title.legend, - values = colorFill, drop = F) + - scale_color_manual(name = title.extremes, - values = colorHatch) + - scale_shape_manual(name = ensemble.legend, - values = c(21)) + - # scale_size_manual(name = obs.title, - # values = c(3)) + - labs(x = var.name, - y = xlab.title, - title = title) + - theme(axis.text.x = element_blank(), - plot.title = element_text(size = 10*title.cex), - axis.title.x = element_text(size = 8*labs.cex), - axis.title.y = element_text(size = 8*labs.cex), - legend.title = element_text(size = 8*labs.cex), - legend.text = element_text(size = 8*labs.cex), - panel.grid.minor.x = element_blank(), - legend.key.size = unit(0.2, "in"), - panel.border = element_rect(fill = NA, color = "black"), - strip.background = element_rect(colour = "black", fill = "gray80"), - strip.text = element_text(size = 8*fcst.names.cex), - panel.spacing = unit(0.2, "in"), - panel.grid.major.x = element_line(color = "grey93"), - panel.background = element_rect(fill = "white"), - plot.background = element_rect(fill = "white", color = NA)) + - guides(fill = guide_legend(order = 1), - color = guide_legend(order = 2), - shape = guide_legend(order = 3, label = F), - size = guide_legend(order = 4, label = F)) - #------------------------ - # Add obs diamond - #------------------------ - if (!is.null(obs)) { - obs.xy <- obs.xy[match(obs, obs.xy$x), ] - obs.xy$obs.factor <- factor(obs.xy$x, levels = obs) - obs.xy$obs.color <- colorObs - plot <- plot + new_scale(new_aes = "fill") + - geom_point(data = obs.xy, aes(x = x, y = ymax, fill = obs.color), - shape = 23, size = obs.size, color = "black") + - scale_fill_manual(name = obs.title, - values = unique(colorObs), - breaks = unique(colorObs), - labels = strings.obs) - } - #------------------------ - # Save to plotfile if needed, and return plot - #------------------------ - if (!is.null(plotfile)) { - ggsave(filename = plotfile, plot = plot, height = height, width = width, dpi = res) - } - return(plot) + # this adds a grey box for ensmembers + geom_rect(aes(xmin = -Inf, xmax = Inf, + ymin = -Inf, ymax = -pan.height / 10), + fill = "gray95", color = "black", width = 0.2) + + # this adds the ensemble members + geom_point(data = jitter.df, + aes(x = x, + y = -pan.height / 10 - magic.ratio * yjitter, + shape = ensemble.legend), + color = "black", fill = colorMember, alpha = 1) + + } else if (add.ensmemb == "above") { + plot <- plot + + geom_point(data = jitter.df, + aes(x = x, + y = 0.7 * magic.ratio * yjitter, + shape = ensemble.legend), + color = "black", fill = colorMember, alpha = 1) + + } + #------------------------ + # Add obs diamond + #------------------------ + # if (!is.null(obs)) { + # plot <- plot + + # # this adds the obs diamond + # geom_point(data = obs.xy, + # aes(x = x, y = ymax, size = obs.title), + # shape = 23, color = "black", fill = colorObs, show.legend = F) + # } + # #------------------------ + # Compute probability for each tercile and identify MLT + #------------------------ + tmp.dt <- data.table(tmp.df) + pct <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), + by = .(init, tercile)] + # include potentially missing groups + pct <- merge(pct, CJ(init = factor(levels(pct$init), levels = levels(pct$init)), + tercile = factor(strings.legend, levels = rev(strings.legend))), + by = c("init", "tercile"), all.y = T) + pct[is.na(pct), "pct"] <- 0 + tot <- pct[, .(tot = sum(pct)), by = init] + pct <- merge(pct, tot, by = "init") + pct$pct <- round(100 * pct$pct / pct$tot, 0) + pct$MLT <- pct[, .(MLT = pct == max(pct)), by = init]$MLT + pct <- pct[order(init, tercile)] + pct$lab.pos <- as.vector(apply(tercile.limits, 1, function(x) {c(max(x), mean(x), min(x))})) + #------------------------ + # Compute probability for extremes + #------------------------ + if (!is.null(extreme.limits)) { + pct2 <- tmp.dt[, .(pct = integrate(approxfun(x, ymax), lower = min(x), upper = max(x))$value), + by = .(init, extremes)] + # include potentially missing groups + pct2 <- merge(pct2, CJ(init = factor(levels(pct2$init), levels = levels(pct2$init)), + extremes = factor(c(strings.extremes[1], strings.legend[2], strings.extremes[2]), + levels = c(strings.extremes[2], strings.legend[2], strings.extremes[1]))), + by = c("init", "extremes"), all.y = T) + pct2[is.na(pct), "pct"] <- 0 + tot2 <- pct2[, .(tot = sum(pct)), by = init] + pct2 <- merge(pct2, tot2, by = "init") + pct2$pct <- round(100 * pct2$pct / pct2$tot, 0) + pct2 <- pct2[order(init, extremes)] + pct2$lab.pos <- as.vector(apply(extreme.limits, 1, function(x) {c(x[2], NA, x[1])})) + pct2 <- merge(pct2, max.df, by = c("init", "extremes"), all.x = T) + } + #------------------------ + # Add probability labels for terciles + #------------------------ + if (add.ensmemb == "above") { + labpos <- -0.2 * pan.height + vjust <- 0 + } else { + labpos <- 0 + vjust <- -0.5 + } + plot <- plot + + geom_text(data = pct, + aes(x = lab.pos, y = labpos, label = paste0(pct, "%"), + hjust = as.integer(tercile) * -1.5 + 3.5), + vjust = vjust, angle = -90, size = 3.2) + + geom_text(data = pct[MLT == T, ], + aes(x = lab.pos, y = labpos, label = "*", + hjust = as.integer(tercile) * -3.5 + 9), + vjust = 0.1, angle = -90, size = 7, color = "black") + #------------------------ + # Add probability labels for extremes + #------------------------ + if (!is.null(extreme.limits)) { + plot <- plot + + geom_text(data = pct2[extremes != strings.legend[2], ], + aes(x = lab.pos, y = 0.9 * y, label = paste0(pct, "%"), + hjust = as.integer(extremes) * -1.5 + 3.5), + vjust = -0.5, angle = -90, size = 3.2, + color = rep(colorLab, dim(fcst.df)[2])) + } + #------------------------ + # Finish all theme and legend details + #------------------------ + plot <- plot + + theme_minimal() + + scale_fill_manual(name = title.legend, + values = colorFill, drop = F) + + scale_color_manual(name = title.extremes, + values = colorHatch) + + scale_shape_manual(name = ensemble.legend, + values = c(21)) + + # scale_size_manual(name = obs.title, + # values = c(3)) + + labs(x = var.name, + y = xlab.title, + title = toptitle) + + theme(axis.text.x = element_blank(), + plot.title = element_text(size = 10*title.cex), + axis.title.x = element_text(size = 8*labs.cex), + axis.title.y = element_text(size = 8*labs.cex), + legend.title = element_text(size = 8*labs.cex), + legend.text = element_text(size = 8*labs.cex), + panel.grid.minor.x = element_blank(), + legend.key.size = unit(0.2, "in"), + panel.border = element_rect(fill = NA, color = "black"), + strip.background = element_rect(colour = "black", fill = "gray80"), + strip.text = element_text(size = 8*fcst.names.cex), + panel.spacing = unit(0.2, "in"), + panel.grid.major.x = element_line(color = "grey93"), + panel.background = element_rect(fill = "white"), + plot.background = element_rect(fill = "white", color = NA)) + + guides(fill = guide_legend(order = 1), + color = guide_legend(order = 2), + shape = guide_legend(order = 3, label = F), + size = guide_legend(order = 4, label = F)) + #------------------------ + # Add obs diamond + #------------------------ + if (!is.null(obs)) { + obs.xy <- obs.xy[match(obs, obs.xy$x), ] + obs.xy$obs.factor <- factor(obs.xy$x, levels = obs) + obs.xy$obs.color <- colorObs + plot <- plot + new_scale(new_aes = "fill") + + geom_point(data = obs.xy, aes(x = x, y = ymax, fill = obs.color), + shape = 23, size = obs.size, color = "black") + + scale_fill_manual(name = obs.title, + values = unique(colorObs), + breaks = unique(colorObs), + labels = strings.obs) + } + #------------------------ + # Save to fileout if needed, and return plot + #------------------------ + if (!is.null(fileout)) { + ggsave(filename = fileout, plot = plot, height = height, width = width, dpi = res) + } + return(plot) } + .jitter.ensmemb <- function(x, thr = 0.1) { - # Idea: start with first level. Loop all points, and if distance to last point in - # the level is more than a threshold, include the point to the level. Otherwise - # keep the point for another round. Do one round in each direction to avoid - # uggly patterns. - if (is.unsorted(x, na.rm = T)) { - stop("Provide a sorted array!") + # Idea: start with first level. Loop all points, and if distance to last point in + # the level is more than a threshold, include the point to the level. Otherwise + # keep the point for another round. Do one round in each direction to avoid + # uggly patterns. + if (is.unsorted(x, na.rm = T)) { + stop("Provide a sorted array!") + } + lev <- x * 0 + lev[is.na(lev)] <- -1 + level <- 1 + while (any(lev == 0)) { + last <- -1 / 0 + for (i in 1:length(x)) { + if (lev[i] != 0) { + next + } + if (x[i] - last > thr) { + lev[i] <- level + last <- x[i] + } } - lev <- x * 0 - lev[is.na(lev)] <- -1 - level <- 1 - while (any(lev == 0)) { - last <- -1 / 0 - for (i in 1:length(x)) { - if (lev[i] != 0) { - next - } - if (x[i] - last > thr) { - lev[i] <- level - last <- x[i] - } - } - level <- level + 1 - last <- 1 / 0 - for (i in seq(length(x), 1, -1)) { - if (lev[i] != 0) { - next - } - if (last - x[i] > thr) { - lev[i] <- level - last <- x[i] - } - } - level <- level + 1 + level <- level + 1 + last <- 1 / 0 + for (i in seq(length(x), 1, -1)) { + if (lev[i] != 0) { + next + } + if (last - x[i] > thr) { + lev[i] <- level + last <- x[i] + } } - lev[lev == -1] <- NA - return(lev * thr * sqrt(3) / 2) + level <- level + 1 + } + lev[lev == -1] <- NA + return(lev * thr * sqrt(3) / 2) } + .polygon.onehatch <- function(x, y, x0, y0, xd, yd, fillOddEven = F) { - halfplane <- as.integer(xd * (y - y0) - yd * (x - x0) <= 0) - cross <- halfplane[-1L] - halfplane[-length(halfplane)] - does.cross <- cross != 0 - if (!any(does.cross)) { - return() - } - x1 <- x[-length(x)][does.cross] - y1 <- y[-length(y)][does.cross] - x2 <- x[-1L][does.cross] - y2 <- y[-1L][does.cross] - t <- (((x1 - x0) * (y2 - y1) - (y1 - y0) * (x2 - x1)) / (xd * (y2 - y1) - yd * - (x2 - x1))) - o <- order(t) - tsort <- t[o] - crossings <- cumsum(cross[does.cross][o]) - if (fillOddEven) { - crossings <- crossings %% 2 - } - drawline <- crossings != 0 - lx <- x0 + xd * tsort - ly <- y0 + yd * tsort - lx1 <- lx[-length(lx)][drawline] - ly1 <- ly[-length(ly)][drawline] - lx2 <- lx[-1L][drawline] - ly2 <- ly[-1L][drawline] - return(data.frame(x = lx1, y = ly1, xend = lx2, yend = ly2)) + halfplane <- as.integer(xd * (y - y0) - yd * (x - x0) <= 0) + cross <- halfplane[-1L] - halfplane[-length(halfplane)] + does.cross <- cross != 0 + if (!any(does.cross)) { + return() + } + x1 <- x[-length(x)][does.cross] + y1 <- y[-length(y)][does.cross] + x2 <- x[-1L][does.cross] + y2 <- y[-1L][does.cross] + t <- (((x1 - x0) * (y2 - y1) - (y1 - y0) * (x2 - x1)) / (xd * (y2 - y1) - yd * + (x2 - x1))) + o <- order(t) + tsort <- t[o] + crossings <- cumsum(cross[does.cross][o]) + if (fillOddEven) { + crossings <- crossings %% 2 + } + drawline <- crossings != 0 + lx <- x0 + xd * tsort + ly <- y0 + yd * tsort + lx1 <- lx[-length(lx)][drawline] + ly1 <- ly[-length(ly)][drawline] + lx2 <- lx[-1L][drawline] + ly2 <- ly[-1L][drawline] + return(data.frame(x = lx1, y = ly1, xend = lx2, yend = ly2)) } -.polygon.fullhatch <- function(x, y, density, angle, width.units, height.units, inches = c(5, - 1)) { - x <- c(x, x[1L]) - y <- c(y, y[1L]) - angle <- angle %% 180 - upi <- c(width.units, height.units) / inches - if (upi[1L] < 0) { - angle <- 180 - angle + +.polygon.fullhatch <- function(x, y, density, angle, width.units, height.units, + inches = c(5, 1)) { + x <- c(x, x[1L]) + y <- c(y, y[1L]) + angle <- angle %% 180 + upi <- c(width.units, height.units) / inches + if (upi[1L] < 0) { + angle <- 180 - angle + } + if (upi[2L] < 0) { + angle <- 180 - angle + } + upi <- abs(upi) + xd <- cos(angle / 180 * pi) * upi[1L] + yd <- sin(angle / 180 * pi) * upi[2L] + hatch.ls <- list() + i <- 1 + if (angle < 45 || angle > 135) { + if (angle < 45) { + first.x <- max(x) + last.x <- min(x) + } else { + first.x <- min(x) + last.x <- max(x) } - if (upi[2L] < 0) { - angle <- 180 - angle + y.shift <- upi[2L] / density / abs(cos(angle/180 * pi)) + x0 <- 0 + y0 <- floor((min(y) - first.x * yd/xd)/y.shift) * y.shift + y.end <- max(y) - last.x * yd/xd + while (y0 < y.end) { + hatch.ls[[i]] <- .polygon.onehatch(x, y, x0, y0, xd, yd) + i <- i + 1 + y0 <- y0 + y.shift } - upi <- abs(upi) - xd <- cos(angle / 180 * pi) * upi[1L] - yd <- sin(angle / 180 * pi) * upi[2L] - hatch.ls <- list() - i <- 1 - if (angle < 45 || angle > 135) { - if (angle < 45) { - first.x <- max(x) - last.x <- min(x) - } else { - first.x <- min(x) - last.x <- max(x) - } - y.shift <- upi[2L] / density / abs(cos(angle/180 * pi)) - x0 <- 0 - y0 <- floor((min(y) - first.x * yd/xd)/y.shift) * y.shift - y.end <- max(y) - last.x * yd/xd - while (y0 < y.end) { - hatch.ls[[i]] <- .polygon.onehatch(x, y, x0, y0, xd, yd) - i <- i + 1 - y0 <- y0 + y.shift - } + } else { + if (angle < 90) { + first.y <- max(y) + last.y <- min(y) } else { - if (angle < 90) { - first.y <- max(y) - last.y <- min(y) - } else { - first.y <- min(y) - last.y <- max(y) - } - x.shift <- upi[1L]/density/abs(sin(angle/180 * pi)) - x0 <- floor((min(x) - first.y * xd/yd)/x.shift) * x.shift - y0 <- 0 - x.end <- max(x) - last.y * xd/yd - while (x0 < x.end) { - hatch.ls[[i]] <- .polygon.onehatch(x, y, x0, y0, xd, yd) - i <- i + 1 - x0 <- x0 + x.shift - } + first.y <- min(y) + last.y <- max(y) + } + x.shift <- upi[1L]/density/abs(sin(angle/180 * pi)) + x0 <- floor((min(x) - first.y * xd/yd)/x.shift) * x.shift + y0 <- 0 + x.end <- max(x) - last.y * xd/yd + while (x0 < x.end) { + hatch.ls[[i]] <- .polygon.onehatch(x, y, x0, y0, xd, yd) + i <- i + 1 + x0 <- x0 + x.shift } - return(do.call("rbind", hatch.ls)) + } + return(do.call("rbind", hatch.ls)) } diff --git a/R/VizLayout.R b/R/VizLayout.R index a11587942fb70ab411f0784fb29afa81368b24d2..1efe302bf7688830a977cdfbe2fe165bc0d6502c 100644 --- a/R/VizLayout.R +++ b/R/VizLayout.R @@ -8,7 +8,7 @@ #'names or the indices of the corresponding input dimensions. It is possible #'to draw a common colour bar at any of the sides of the multi-pannel for all #'the s2dv plots that use a colour bar. Common plotting arguments -#'for all the arrays in 'var' can be specified via the '...' parameter, and +#'for all the arrays in 'data' can be specified via the '...' parameter, and #'specific plotting arguments for each array can be fully adjusted via #''special_args'. It is possible to draw titles for each of the figures, #'layout rows, layout columns and for the whole figure. A number of parameters @@ -19,18 +19,18 @@ #'nested in complex layouts. #' #'@param fun Plot function (or name of the function) to be called on the -#' arrays provided in 'var'. If multiple arrays are provided in 'var', a +#' arrays provided in 'data'. If multiple arrays are provided in 'data', a #' vector of as many function names (character strings!) can be provided in -#' 'fun', one for each array in 'var'. +#' 'fun', one for each array in 'data'. #'@param plot_dims Numeric or character string vector with identifiers of the #' input plot dimensions of the plot function specified in 'fun'. If -#' character labels are provided, names(dim(var)) or attr('dimensions', var) +#' character labels are provided, names(dim(data)) or attr('dimensions', data) #' will be checked to locate the dimensions. As many plots as -#' prod(dim(var)[-plot_dims]) will be generated. If multiple arrays are -#' provided in 'var', 'plot_dims' can be sent a list with a vector of plot +#' prod(dim(data)[-plot_dims]) will be generated. If multiple arrays are +#' provided in 'data', 'plot_dims' can be sent a list with a vector of plot #' dimensions for each. If a single vector is provided, it will be used for -#' all the arrays in 'var'. -#'@param var Multi-dimensional array with at least the dimensions expected by +#' all the arrays in 'data'. +#'@param data Multi-dimensional array with at least the dimensions expected by #' the specified plot function in 'fun'. The dimensions reqired by the #' function must be specified in 'plot_dims'. The dimensions can be #' disordered and will be reordered automatically. Dimensions can optionally @@ -43,8 +43,9 @@ #' applied to each of them. NAs can be passed to the list: a NA will yield a #' blank cell in the layout, which can be populated after #' (see .SwitchToFigure). +#'@param var Deprecated. Use 'data' instead. #'@param \dots Parameters to be sent to the plotting function 'fun'. If -#' multiple arrays are provided in 'var' and multiple functions are provided +#' multiple arrays are provided in 'data' and multiple functions are provided #' in 'fun', the parameters provided through \dots will be sent to all the #' plot functions, as common parameters. To specify concrete arguments for #' each of the plot functions see parameter 'special_args'. @@ -52,13 +53,13 @@ #' arguments for each of the plot functions provided in 'fun'. If you want to #' fix a different value for each plot in the layout you can do so by #' a) splitting your array into a list of sub-arrays (each with the data for -#' one plot) and providing it as parameter 'var', +#' one plot) and providing it as parameter 'data', #' b) providing a list of named sub-lists in 'special_args', where the names #' of each sub-list match the names of the parameters to be adjusted, and #' each value in a sub-list contains the value of the corresponding parameter. #' For example, if the plots are two maps with different arguments, the #' structure would be like:\cr -#' var:\cr +#' data:\cr #' List of 2\cr #' $ : num [1:360, 1:181] 1 3.82 5.02 6.63 8.72 ...\cr #' $ : num [1:360, 1:181] 2.27 2.82 4.82 7.7 10.32 ...\cr @@ -104,22 +105,24 @@ #'@param subplot_titles_scale Scale factor for the subplots top titles. Takes #' 1 by default. #'@param units Title at the top of the colour bar, most commonly the units of -#' the variable provided in parameter 'var'. +#' the variable provided in parameter 'data'. #'@param brks,cols,bar_limits,triangle_ends Usually only providing 'brks' is #' enough to generate the desired colour bar. These parameters allow to #' define n breaks that define n - 1 intervals to classify each of the values -#' in 'var'. The corresponding grid cell of a given value in 'var' will be +#' in 'data'. The corresponding grid cell of a given value in 'data' will be #' coloured in function of the interval it belongs to. These parameters are #' sent to \code{ColorBarContinuous()} to generate the breaks and colours. Additional #' colours for values beyond the limits of the colour bar are also generated #' and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are #' properly provided to do so. See ?ColorBarContinuous for a full explanation. -#'@param col_inf,col_sup Colour identifiers to colour the values in 'var' that +#'@param col_inf,col_sup Colour identifiers to colour the values in 'data' that #' go beyond the extremes of the colour bar and to colour NA values, #' respectively. 'colNA' takes 'white' by default. 'col_inf' and 'col_sup' #' will take the value of 'colNA' if not specified. See ?ColorBarContinuous for a full #' explanation on 'col_inf' and 'col_sup'. -#'@param color_fun,subsampleg,bar_extra_labels,draw_bar_ticks,draw_separators,triangle_ends_scale,bar_label_digits,bar_label_scale,units_scale,bar_tick_scale,bar_extra_margin Set of parameters to control the visual aspect of the drawn colour bar. See ?ColorBarContinuous for a full explanation. +#'@param color_fun,subsampleg,bar_extra_labels,draw_bar_ticks,draw_separators,triangle_ends_scale,bar_label_digits,bar_label_scale,units_scale,bar_tick_scale,bar_extra_margin +#' Set of parameters to control the visual aspect of the drawn colour bar. See +#' ?ColorBarContinuous for a full explanation. #'@param drawleg Where to draw the common colour bar. Can take values TRUE, #' FALSE or:\cr #' 'up', 'u', 'U', 'top', 't', 'T', 'north', 'n', 'N'\cr @@ -138,7 +141,7 @@ #' format c(y1, x1, y2, x2). The units are margin lines. Takes rep(0, 4) #' by default. #'@param layout_by_rows Logical indicating wether the panels should be filled -#' by columns (FALSE) or by raws (TRUE, default). +#' by columns (FALSE) or by rows (TRUE, default). #'@param fileout File where to save the plot. If not specified (default) a #' graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, #' bmp and tiff. @@ -182,12 +185,12 @@ #' \dontrun{ #'ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, #' dat_dim = c('dat', 'member'), memb_dim = 'member') -#'var <- s2dv::MeanDims(ano$exp, "member") -#'lats <- attr(map_temp$exp, "Variables")$common$lat +#'data <- s2dv::MeanDims(ano$exp, "member") +#'lats <- attr(map_temp$exp, "dataiables")$common$lat #'lons <- attr(map_temp$exp, "Variables")$common$lon #' #'VizLayout(fun = VizEquiMap, plot_dims = c('lat', 'lon'), -#' var = var[, 1, 1, 1, , ], lon = lons, lat = lats, +#' data = data[, 1, 1, 1, , ], lon = lons, lat = lats, #' filled.continents = FALSE, #' toptitle = 'Near-surface temperature Nov.', #' titles = paste(2000:2005)) @@ -196,25 +199,24 @@ #'@importFrom grDevices dev.cur dev.new dev.off #'@importFrom s2dv Reorder #'@export -VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, - nrow = NULL, ncol = NULL, toptitle = NULL, - row_titles = NULL, col_titles = NULL, bar_scale = 1, - title_scale = 1, title_margin_scale = 1, - title_left_shift_scale = 1, - subtitle_scale = 1, subtitle_margin_scale = 1, - subplot_titles_scale = 1, - brks = NULL, cols = NULL, drawleg = 'S', titles = NULL, - subsampleg = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = ClimColors, - draw_bar_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, bar_extra_labels = NULL, - units = NULL, units_scale = 1, bar_label_scale = 1, - bar_tick_scale = 1, bar_extra_margin = rep(0, 4), - bar_left_shift_scale = 1, bar_label_digits = 4, - extra_margin = rep(0, 4), layout_by_rows = TRUE, - fileout = NULL, width = NULL, height = NULL, - size_units = 'in', res = 100, close_device = TRUE) { +VizLayout <- function(fun, plot_dims, data, ..., special_args = NULL, + nrow = NULL, ncol = NULL, toptitle = NULL, + row_titles = NULL, col_titles = NULL, bar_scale = 1, + title_scale = 1, title_margin_scale = 1, + title_left_shift_scale = 1, subtitle_scale = 1, + subtitle_margin_scale = 1, subplot_titles_scale = 1, + brks = NULL, cols = NULL, drawleg = 'S', titles = NULL, + subsampleg = NULL, bar_limits = NULL, + triangle_ends = NULL, col_inf = NULL, col_sup = NULL, + color_fun = ClimColors, draw_bar_ticks = TRUE, + draw_separators = FALSE, triangle_ends_scale = 1, + bar_extra_labels = NULL,units = NULL, units_scale = 1, + bar_label_scale = 1,bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), bar_left_shift_scale = 1, + bar_label_digits = 4, extra_margin = rep(0, 4), + layout_by_rows = TRUE, fileout = NULL, width = NULL, + height = NULL, size_units = 'in', res = 100, + close_device = TRUE, var = NULL) { # If there is any filenames to store the graphics, process them # to select the right device if (!is.null(fileout)) { @@ -224,15 +226,26 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } is_single_na <- function(x) ifelse(length(x) > 1, FALSE, is.na(x)) - # Check var - if (!is.list(var) & (is.array(var) || (is_single_na(var)))) { - var <- list(var) - } else if (is.list(var)) { - if (!all(sapply(var, is.array) | sapply(var, is_single_na))) { - stop("Parameter 'var' must be an array or a list of arrays (or NA values).") + + # Check data + if (missing(data) || is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") + } + if (!is.list(data) & (is.array(data) || (is_single_na(data)))) { + data <- list(data) + } else if (is.list(data)) { + if (!all(sapply(data, is.array) | sapply(data, is_single_na))) { + stop("Parameter 'data' must be an array or a list of arrays (or NA values).") } } else { - stop("Parameter 'var' must be an array or a list of arrays.") + stop("Parameter 'data' must be an array or a list of arrays.") } # Check fun @@ -241,29 +254,29 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, fun <- as.character(substitute(fun)) } if (is.character(fun)) { - fun <- rep(fun, length(var)) + fun <- rep(fun, length(data)) } } - if (!is.character(fun) || (length(fun) != length(var))) { - stop("Parameter 'fun' must be a single function or a vector of function names, one for each array provided in parameter 'var'.") + if (!is.character(fun) || (length(fun) != length(data))) { + stop("Parameter 'fun' must be a single function or a vector of function names, one for each array provided in parameter 'data'.") } # Check special_args if (!is.null(special_args)) { if (!is.list(special_args) || any(!sapply(special_args, is.list))) { stop("Parameter 'special_args' must be a list of lists.") - } else if (length(special_args) != length(var)) { - stop("Parameter 'special_args' must contain a list of special arguments for each array provided in 'var'.") + } else if (length(special_args) != length(data)) { + stop("Parameter 'special_args' must contain a list of special arguments for each array provided in 'data'.") } } # Check plot_dims if (is.character(plot_dims) || is.numeric(plot_dims)) { - plot_dims <- replicate(length(var), plot_dims, simplify = FALSE) + plot_dims <- replicate(length(data), plot_dims, simplify = FALSE) } if (!is.list(plot_dims) || !all(sapply(plot_dims, is.character) | sapply(plot_dims, is.numeric)) || - (length(plot_dims) != length(var))) { - stop("Parameter 'plot_dims' must contain a single numeric or character vector with dimension identifiers or a vector for each array provided in parameter 'var'.") + (length(plot_dims) != length(data))) { + stop("Parameter 'plot_dims' must contain a single numeric or character vector with dimension identifiers or a vector for each array provided in parameter 'data'.") } # Check nrow @@ -324,25 +337,33 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } else if (!is.logical(drawleg)) { stop("Parameter 'drawleg' must be either TRUE, FALSE or a valid identifier of a position (see ?PlotMultiMap).") } - if (drawleg != FALSE && all(sapply(var, is_single_na)) && + if (drawleg != FALSE && all(sapply(data, is_single_na)) && (is.null(brks) || length(brks) < 2)) { - stop("Either data arrays in 'var' or breaks in 'brks' must be provided if 'drawleg' is requested.") + stop("Either data arrays in 'data' or breaks in 'brks' must be provided if 'drawleg' is requested.") } # Check the rest of parameters (unless the user simply wants to build an empty layout) - if (!all(sapply(var, is_single_na))) { - tmp <- .create_var_limits(data = unlist(var), brks = brks, + if (!all(sapply(data, is_single_na))) { + tmp <- .create_var_limits(data = unlist(data), brks = brks, bar_limits = bar_limits, drawleg = drawleg) var_limits <- tmp$var_limits drawleg <- tmp$drawleg } - colorbar <- ColorBarContinuous(brks, cols, FALSE, subsampleg, bar_limits, - var_limits, triangle_ends, col_inf, col_sup, color_fun, - plot = FALSE, draw_bar_ticks, - draw_separators, triangle_ends_scale, bar_extra_labels, - units, units_scale, bar_label_scale, bar_tick_scale, - bar_extra_margin, bar_label_digits) + colorbar <- ColorBarContinuous(brks = brks, cols = cols, vertical = FALSE, + subsampleg = subsampleg, bar_limits = bar_limits, + var_limits = var_limits, triangle_ends = triangle_ends, + col_inf = col_inf, col_sup = col_sup, + color_fun = color_fun, plot = FALSE, + draw_bar_ticks = draw_bar_ticks, + draw_separators = draw_separators, + triangle_ends_scale = triangle_ends_scale, + bar_extra_labels = bar_extra_labels, + title = units, title_scale = units_scale, + bar_label_scale = bar_label_scale, + bar_tick_scale = bar_tick_scale, + bar_extra_margin = bar_extra_margin, + bar_label_digits = bar_label_digits) # Check bar_scale if (!is.numeric(bar_scale)) { @@ -426,7 +447,7 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, # Count the total number of maps and reorder each array of maps to have the lat and lon dimensions at the end. n_plots <- 0 plot_array_i <- 1 - for (plot_array in var) { + for (plot_array in data) { if (is_single_na(plot_array)) { n_plots <- n_plots + 1 } else { @@ -440,16 +461,16 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } if (!is.null(dimnames)) { if (any(!sapply(dim_ids, `%in%`, dimnames))) { - stop("All arrays provided in parameter 'var' must have all the dimensions in 'plot_dims'.") + stop("All arrays provided in parameter 'data' must have all the dimensions in 'plot_dims'.") } dim_ids <- sapply(dim_ids, function(x) which(dimnames == x)[1]) - var[[plot_array_i]] <- Reorder(var[[plot_array_i]], c((1:length(dim(plot_array)))[-dim_ids], dim_ids)) + data[[plot_array_i]] <- Reorder(data[[plot_array_i]], c((1:length(dim(plot_array)))[-dim_ids], dim_ids)) } else { - warning(paste0("Assuming the ", plot_array_i, "th array provided in 'var' has 'plot_dims' as last dimensions (right-most).")) + warning(paste0("Assuming the ", plot_array_i, "th array provided in 'data' has 'plot_dims' as last dimensions (right-most).")) dims <- tail(c(rep(1, length(dim_ids)), dim(plot_array)), length(dim_ids)) dim_ids <- tail(1:length(dim(plot_array)), length(dim_ids)) - if (length(dim(var[[plot_array_i]])) < length(dims)) { - dim(var[[plot_array_i]]) <- dims + if (length(dim(data[[plot_array_i]])) < length(dims)) { + dim(data[[plot_array_i]]) <- dims } } } else if (any(dim_ids > length(dim(plot_array)))) { @@ -457,8 +478,8 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } n_plots <- n_plots + prod(dim(plot_array)[-dim_ids]) #n_plots <- n_plots + prod(head(c(rep(1, length(dim_ids)), dim(plot_array)), length(dim(plot_array)))) - if (length(dim(var[[plot_array_i]])) == length(dim_ids)) { - dim(var[[plot_array_i]]) <- c(1, dim(var[[plot_array_i]])) + if (length(dim(data[[plot_array_i]])) == length(dim_ids)) { + dim(data[[plot_array_i]]) <- c(1, dim(data[[plot_array_i]])) dim_ids <- dim_ids + 1 } plot_dims[[plot_array_i]] <- dim_ids @@ -473,7 +494,7 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, } else if (is.null(nrow)) { nrow <- ceiling(n_plots/ncol) } else if (nrow * ncol < n_plots) { - stop("There are more arrays to plot in 'var' than cells defined by 'nrow' x 'ncol'.") + stop("There are more arrays to plot in 'data' than cells defined by 'nrow' x 'ncol'.") } if (is.logical(drawleg) && drawleg) { @@ -538,7 +559,7 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, multi_colorbar <- TRUE cat_dim <- list(...)$cat_dim if (is.null(cat_dim)) cat_dim <- 'bin' # default - nmap <- as.numeric(dim(var[[1]])[cat_dim]) + nmap <- as.numeric(dim(data[[1]])[cat_dim]) minimum_value <- ceiling(1 / nmap * 10 * 1.1) * 10 display_range = c(minimum_value, 100) mat_layout <- mat_layout + nmap @@ -621,14 +642,18 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, label_scale = bar_label_scale, extra_margin = bar_extra_margin) } else { # one colorbar - ColorBarContinuous(brks = colorbar$brks, cols = colorbar$cols, vertical = vertical, subsampleg = subsampleg, - bar_limits = bar_limits, var_limits = var_limits, - triangle_ends = triangle_ends, col_inf = colorbar$col_inf, - col_sup = colorbar$col_sup, color_fun = color_fun, plot = TRUE, draw_ticks = draw_bar_ticks, - draw_separators = draw_separators, triangle_ends_scale = triangle_ends_scale, - extra_labels = bar_extra_labels, - title = units, title_scale = units_scale, label_scale = bar_label_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits) + ColorBarContinuous(brks = colorbar$brks, cols = colorbar$cols, + vertical = vertical, subsampleg = subsampleg, + bar_limits = bar_limits, var_limits = var_limits, + triangle_ends = triangle_ends, col_inf = colorbar$col_inf, + col_sup = colorbar$col_sup, color_fun = color_fun, + plot = TRUE, draw_bar_ticks = draw_bar_ticks, + draw_separators = draw_separators, + triangle_ends_scale = triangle_ends_scale, + bar_extra_labels = bar_extra_labels, title = units, + title_scale = units_scale, bar_label_scale = bar_label_scale, + bar_tick_scale = bar_tick_scale, bar_extra_margin = bar_extra_margin, + bar_label_digits = bar_label_digits) } } @@ -682,10 +707,10 @@ VizLayout <- function(fun, plot_dims, var, ..., special_args = NULL, array_number <- 1 plot_number <- 1 - # For each array provided in var - lapply(var, function(x) { + # For each array provided in data + lapply(data, function(x) { if (is_single_na(x)) { - if (!all(sapply(var[array_number:length(var)], is_single_na))) { + if (!all(sapply(data[array_number:length(data)], is_single_na))) { plot.new() par(new = FALSE) } diff --git a/R/VizMatrix.R b/R/VizMatrix.R index 1fd9ac0201ea5a2ce53f80982851caf0c626d0e3..fdee366ec273f3053959b405314800d2bf691411 100644 --- a/R/VizMatrix.R +++ b/R/VizMatrix.R @@ -4,8 +4,9 @@ #'grid. It is useful for a slide or article to present tabular results as #'colors instead of numbers. #' -#'@param var A numerical matrix containing the values to be displayed in a +#'@param data A numerical matrix containing the values to be displayed in a #' colored image. +#'@param var Deprecated. Use 'data' instead. #'@param brks A vector of the color bar intervals. The length must be one more #' than the parameter 'cols'. Use ColorBarContinuous() to generate default #' values. @@ -18,26 +19,27 @@ #'@param xtitle A string of title of the x-axis. Set NULL as default. #'@param ytitle A string of title of the y-axis. Set NULL as default. #'@param xlabels A vector of labels of the x-axis. The length must be -#' length of the column of parameter 'var'. Set the sequence from 1 to the -#' length of the column of parameter 'var' as default. +#' length of the column of parameter 'data'. Set the sequence from 1 to the +#' length of the column of parameter 'data' as default. #'@param xvert A logical value to decide whether to place x-axis labels #' vertically. Set FALSE as default, which keeps the labels horizontally. #'@param ylabels A vector of labels of the y-axis The length must be -#' length of the row of parameter 'var'. Set the sequence from 1 to the -#' length of the row of parameter 'var' as default. +#' length of the row of parameter 'data'. Set the sequence from 1 to the +#' length of the row of parameter 'data' as default. #'@param line An integer specifying the distance between the title of the #' x-axis and the x-axis. Set 3 as default. Adjust if the x-axis labels #' are long. #'@param figure.width A positive number as a ratio adjusting the width of the #' grids. Set 1 as default. -#'@param legend A logical value to decide to draw the grid color legend or not. +#'@param drawleg A logical value to decide to draw the grid color legend or not. #' Set TRUE as default. +#'@param legend Deprecated. Use 'drawleg' instead. #'@param legend.width A number between 0 and 0.5 to adjust the legend width. #' Set 0.15 as default. #'@param xlab_dist A number specifying the distance between the x labels and -#' the x axis. If not specified, it equals to -1 - (nrow(var) / 10 - 1). +#' the x axis. If not specified, it equals to -1 - (nrow(data) / 10 - 1). #'@param ylab_dist A number specifying the distance between the y labels and -#' the y axis. If not specified, it equals to 0.5 - ncol(var) / 10. +#' the y axis. If not specified, it equals to 0.5 - ncol(data) / 10. #'@param fileout A string of full directory path and file name indicating where #' to save the plot. If not specified (default), a graphics device will pop up. #'@param size_units A string indicating the units of the size of the device @@ -52,7 +54,7 @@ #'@examples #'#Example with random data #' \dontrun{ -#' esviz:::VizMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), +#' esviz:::VizMatrix(data = matrix(rnorm(n = 120, mean = 0.3), 10, 12), #' cols = c('white','#fef0d9','#fdd49e','#fdbb84','#fc8d59', #' '#e34a33','#b30000', '#7f0000'), #' brks = c(-1, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1), @@ -63,18 +65,40 @@ #' } #' #'@importFrom grDevices dev.new dev.off dev.cur -VizMatrix <- function(var, brks = NULL, cols = NULL, - toptitle = NULL, title.color = "royalblue4", - xtitle = NULL, ytitle = NULL, xlabels = NULL, xvert = FALSE, - ylabels = NULL, line = 3, figure.width = 1, legend = TRUE, - legend.width = 0.15, xlab_dist = NULL, ylab_dist = NULL, - fileout = NULL, size_units = 'px', res = 100, ...) { - - # Check variables: - if (!is.matrix(var)) +VizMatrix <- function(data, brks = NULL, cols = NULL, toptitle = NULL, + title.color = "royalblue4", xtitle = NULL, ytitle = NULL, + xlabels = NULL, xvert = FALSE, ylabels = NULL, line = 3, + figure.width = 1, drawleg = TRUE, legend = NULL, + legend.width = 0.15, xlab_dist = NULL, ylab_dist = NULL, + fileout = NULL, size_units = 'px', res = 100, var = NULL, + ...) { + + # Check data: + if (missing(data) || is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") + } + if (!is.matrix(data)) { stop("Input values are not a matrix") - if (!is.numeric(var)) + } + if (!is.numeric(data)){ stop("Input values are not always numbers") + } + + # Check drawleg + if (missing(drawleg) && !missing(legend)) { + warning("The parameter 'legend' is deprecated. Use 'drawleg' instead.") + drawleg <- legend + } + if (!is.logical(drawleg) || length(drawleg) != 1) { + stop("Parameter 'drawleg' must be a single logical value") + } # Build: brks, cols colorbar <- ColorBarContinuous(brks = brks, cols = cols, vertical = FALSE, @@ -87,8 +111,8 @@ VizMatrix <- function(var, brks = NULL, cols = NULL, if (n.brks != n.cols + 1) stop("There must be one break more than the number of colors") - ncols <- ncol(var) ## number of columns of the image - nrows <- nrow(var) ## number of rows of the image + ncols <- ncol(data) ## number of columns of the image + nrows <- nrow(data) ## number of rows of the image if (ncols < 2) stop("Matrix must have at least two columns") if (nrows < 2) @@ -104,7 +128,7 @@ VizMatrix <- function(var, brks = NULL, cols = NULL, if (!is.numeric(legend.width) || legend.width < 0 || legend.width > 0.5) stop("legend.width must be a number from 0 to 0.5") - + # If there is any filenames to store the graphics, process them # to select the right device if (!is.null(fileout)) { @@ -202,7 +226,7 @@ VizMatrix <- function(var, brks = NULL, cols = NULL, # Create an array of colors instead of numbers (it starts all gray): array.colors <- array("gray", c(nrows, ncols)) - for (int in n.cols:1) array.colors[var <= brks[int + 1]] <- cols[int] + for (int in n.cols:1) array.colors[data <= brks[int + 1]] <- cols[int] # fill with colors the cells in the figure: for (p in 1:nrows) { @@ -215,7 +239,7 @@ VizMatrix <- function(var, brks = NULL, cols = NULL, } # Draw color legend: - if (legend) { + if (drawleg) { par(fig = c(1 - legend.width - 0.01, 1 - legend.width + legend.width * min(1, 10 / ncols), 0.3, 0.8), new = TRUE) diff --git a/R/VizPDFsOLE.R b/R/VizPDFsOLE.R index 5ae68e3ea17ad80192cbc5d5418e069fa36e6c12..280f3b0be237c5b9b3ad52ac58feed5b7ee9da41 100644 --- a/R/VizPDFsOLE.R +++ b/R/VizPDFsOLE.R @@ -18,8 +18,9 @@ #' legend ("bottom", "top", "right" or "left")(Default 'bottom'). #'@param legendSize (optional) A numeric value for setting the size of the #' legend text. (Default 1.0). -#'@param plotfile (optional) A filename where the plot will be saved. +#'@param fileout (optional) A filename where the plot will be saved. #' (Default: the plot is not saved). +#'@param plotfile Deprecated. Use 'fileout' instead #'@param width (optional) A numeric value indicating the plot width in #' units ("in", "cm", or "mm"). (Default width = 30). #'@param height (optional) A numeric value indicating the plot height. @@ -44,11 +45,11 @@ #'} #'@import ggplot2 stats VizPDFsOLE <- function(pdf_1, pdf_2, nsigma = 3, legendPos = 'bottom', - legendSize = 1.0, plotfile = NULL, width = 30, - height = 15, units = "cm", dpi = 300) { + legendSize = 1.0, fileout = NULL, plotfile = NULL, + width = 30, height = 15, units = "cm", dpi = 300) { y <- type <- NULL - if(!is.null(plotfile)){ + if(!is.null(fileout)){ if (!is.numeric(dpi)) { stop("Parameter 'dpi' must be numeric.") } @@ -84,8 +85,12 @@ VizPDFsOLE <- function(pdf_1, pdf_2, nsigma = 3, legendPos = 'bottom', "only the first element will be used.") width <- width[1] } - if (!is.character(plotfile)) { - stop("Parameter 'plotfile' must be a character string ", + if (missing(fileout) && !missing(plotfile)) { + warning("The parameter 'plotfile' is deprecated. Use 'fileout' instead.") + fileout <- plotfile + } + if (!is.character(fileout)) { + stop("Parameter 'fileout' must be a character string ", "indicating the path and name of output png file.") } } @@ -229,10 +234,10 @@ VizPDFsOLE <- function(pdf_1, pdf_2, nsigma = 3, legendPos = 'bottom', #----------------------------------------------------------------------------- - # Save to plotfile if needed, and return plot + # Save to fileout if needed, and return plot #----------------------------------------------------------------------------- - if (!is.null(plotfile)) { - ggsave(plotfile, g, width = width, height = height, units = units, dpi = dpi) + if (!is.null(fileout)) { + ggsave(fileout, g, width = width, height = height, units = units, dpi = dpi) } return(g) } diff --git a/R/VizRobinson.R b/R/VizRobinson.R index 63f5c7faa773e2fbf4d4ce8982362413771f7868..9134151f081a315bf01512420ec223072666fc4e 100644 --- a/R/VizRobinson.R +++ b/R/VizRobinson.R @@ -65,7 +65,7 @@ #'@param vertical A logical value indicating the direction of colorbar if #' 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'. +#' with parameter 'title_scale'. #'@param caption A character string of the caption located at left-bottom of the #' plot. #'@param units A character string of the data units, which is the title of the @@ -75,11 +75,16 @@ #' cannot exceed 180 degrees. #'@param point_size A number of the size of the data points if "style = 'point'". #' The default is 'auto' and the function tries to find the appropriate size. -#'@param title_size A number of the size of the top title. The default is 16. -#'@param dots_size A number of the size of the dots. The default is 0.5. -#'@param dots_shape A number indicating the dot shape recognized by parameter +#'@param title_scale A number of the size of the top title. The default is 16. +#'@param title_size Deprecated. Use 'title_scale' instead. +#'@param dot_size A number of the size of the dots. The default is 0.5. +#'@param dots_size Deprecated. Use 'dot_size' instead. +#'@param dot_symbol A number indicating the dot shape recognized by parameter #' 'shape' in \code{geom_point()}. -#'@param coastlines_width A number indicating the width of the coastlines. +#'@param dots_shape Deprecated. Use 'dot_symbol' instead. +#'@param coast_width A number indicating the width of the coastlines. Default is +#' 0.3. +#'@param coastlines_width Deprecated. Use 'coast_width' instead. #'@param fileout A character string of the path to save the plot. If not #' specified (default), a graphic device will pop up. The extension should be #' accepted by \code{ggsave()}. @@ -110,26 +115,29 @@ #' 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, 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', -#' width = 8, height = 6) +#' target_proj = "+proj=moll", brks = seq(-10, 10, length.out = 11), +#' color_fun = ClimPalette("purpleorange"), colNA = 'green', +#' toptitle = 'synthetic example', caption = 'Mollweide Projection', +#' width = 8, height = 6) #' } #'@import sf ggplot2 rnaturalearth cowplot utils #'@importFrom dplyr mutate group_by summarise #'@importFrom ClimProjDiags Subset -#' @importFrom rlang .data +#'@importFrom rlang .data #'@export VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, target_proj = NULL, 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, - toptitle = NULL, caption = NULL, units = NULL, crop_coastlines = NULL, - point_size = "auto", title_size = 16, dots_size = 0.5, - dots_shape = 47, coastlines_width = 0.3, - fileout = NULL, width = 8, height = 4, size_units = "in", - res = 300) { + 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, + toptitle = NULL, caption = NULL, units = NULL, + crop_coastlines = NULL, point_size = "auto", + title_scale = 16, title_size = NULL, dot_size = 0.5, + dots_size = NULL, dot_symbol = 47, dots_shape = NULL, + coast_width = 0.3, coastlines_width = NULL, + fileout = NULL, width = 8, height = 4, + size_units = "in", res = 300) { # Sanity check # data @@ -261,6 +269,14 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, stop("Parameter 'mask' must be a logical or numerical array.") } } + # Check title_scale + if (missing(title_scale) && !missing(title_size)) { + warning("The parameter 'title_size' is deprecated. Use 'title_scale' instead.") + title_scale <- title_size + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } tmp <- .create_var_limits(data = data, brks = brks, bar_limits = bar_limits, drawleg = drawleg) @@ -273,11 +289,11 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, 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, - plot = FALSE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, + plot = FALSE, draw_bar_ticks = TRUE, draw_separators = FALSE, + triangle_ends_scale = 1, bar_extra_labels = NULL, title = units, title_scale = 1, # units_scale - label_scale = 1, tick_scale = 1, #bar_tick_scale - extra_margin = bar_extra_margin, label_digits = 4) + bar_label_scale = 1, bar_tick_scale = 1, + bar_extra_margin = bar_extra_margin, bar_label_digits = 4) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf @@ -319,9 +335,35 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, # 360x181 with default setting, 0.05 point_size <- round(0.05 * (360 * 181) / (length(lon) * length(lat)), 2) } else if (!is.numeric(point_size)) { - stop("Parameter 'point_size' must be a number.") + stop("Parameter 'point_size' must be a numerical value.") + } + + # dot_symbol + if (missing(dot_symbol) && !missing(dots_shape)) { + warning("The parameter 'dots_shape' is deprecated. Use 'dot_symbol' instead.") + dot_symbol <- dots_shape + } + if (!is.numeric(dot_symbol)) { + stop("Parameter 'dot_symbol' must be a numerical value.") + } + + # dot_size + if (missing(dot_size) && !missing(dots_size)) { + warning("The parameter 'dots_size' is deprecated. Use 'dot_size' instead.") + dot_size <- dots_size + } + if (!is.numeric(dot_size)) { + stop("Parameter 'dot_size' must be a numerical value.") + } + + # coast_width + if (missing(coast_width) && !missing(coastlines_width)) { + warning("The parameter 'coastlines_width' is deprecated. Use 'coast_width' instead.") + coast_width <- coastlines_width + } + if (!is.numeric(coast_width)) { + stop("Parameter 'coast_width' must be a numerical value.") } - # #================================================================= @@ -480,7 +522,7 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, coord_sf_lim <- c(range(lonlat_df_ori$long), range(lonlat_df_ori$lat)) } res_p <- res_p + - geom_sf(data = coastlines, colour ='black', size = coastlines_width) + + geom_sf(data = coastlines, colour ='black', size = coast_width) + # Remove background grid and lat/lon label; add white background theme_void() + theme(plot.background = element_rect(fill = 'white', colour = 'white')) + # crop the projection @@ -489,9 +531,9 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, if (!is.null(dots)) { res_p <- res_p + geom_point(data = dots_df, aes(x = .data$long, y = .data$lat), - shape = dots_shape, size = dots_size) + shape = dot_symbol, size = dot_size) #NOTE: This line makes point size vary with lat - #size = dots_size / (dots_df$lat / min(dots_df$lat))) + #size = dot_size / (dots_df$lat / min(dots_df$lat))) } if (identical(drawleg, 'ggplot2')) { @@ -522,7 +564,7 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, if (!is.null(toptitle)) { res_p <- res_p + ggtitle(toptitle) + - theme(plot.title = element_text(size = title_size, hjust = 0.5, vjust = 3)) + theme(plot.title = element_text(size = title_scale, hjust = 0.5, vjust = 3)) } if (!is.null(caption)) { res_p <- res_p + labs(caption = caption) + @@ -540,11 +582,11 @@ VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, 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, - plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, + plot = TRUE, draw_bar_ticks = TRUE, draw_separators = FALSE, + triangle_ends_scale = 1, bar_extra_labels = NULL, title = units, title_scale = 1, # units_scale - label_scale = 1, tick_scale = 1, #bar_tick_scale - extra_margin = bar_extra_margin, label_digits = 4) + bar_label_scale = 1, bar_tick_scale = 1, + bar_extra_margin = bar_extra_margin, bar_label_digits = 4) } if (vertical) { res_p <- cowplot::plot_grid(res_p, fun_legend, rel_widths = c(6, 1)) diff --git a/R/VizScorecard.R b/R/VizScorecard.R index ab2e415f50bd9eeb886879380b3e05147510bc67..85b06f4451d1e4c6a8a30a357633ab41a497a358 100644 --- a/R/VizScorecard.R +++ b/R/VizScorecard.R @@ -35,6 +35,8 @@ #' as NULL by default. #'@param subrow_title A character string for the title of the sub-row names. It #' is set as NULL by default. +#'@param col_title A character string for the title of the column names. It is +#' set as NULL by default. #'@param table_title A character string for the title of the plot. It is set as #' NULL by default. #'@param table_subtitle A character string for the sub-title of the plot. It is diff --git a/R/VizSection.R b/R/VizSection.R index f77233365cbb1260d151078f282893a78a7a2e58..8742ef6fb5a00252c9f00d168f015fc7e68622af 100644 --- a/R/VizSection.R +++ b/R/VizSection.R @@ -2,11 +2,13 @@ #' #'Plot a (longitude,depth) or (latitude,depth) section. #' -#'@param var Matrix to plot with (longitude/latitude, depth) dimensions. +#'@param data Matrix to plot with (longitude/latitude, depth) dimensions. +#'@param var Deprecated. Use 'data' instead. #'@param horiz Array of longitudes or latitudes. #'@param depth Array of depths. #'@param toptitle Title, optional. -#'@param sizetit Multiplicative factor to increase title size, optional. +#'@param title_scale Scale factor for the figure top title. Defaults to 1. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param units Units, optional. #'@param brks Colour levels, optional. #'@param cols List of colours, optional. @@ -43,11 +45,11 @@ #'esviz:::VizSection(data, horiz = 0:20, depth = seq(0, 300, length.out = 7), #' toptitle = 'Temperature cross-section', units = "degC") #'@importFrom grDevices dev.cur dev.new dev.off rainbow -VizSection <- function(var, horiz, depth, toptitle = '', sizetit = 1, - units = '', brks = NULL, cols = NULL, axelab = TRUE, - intydep = 200, intxhoriz = 20, drawleg = TRUE, - fileout = NULL, width = 10, height = 8, - size_units = 'in', res = 100, ...) { +VizSection <- function(data, horiz, depth, toptitle = '', title_scale = 1, + sizetit = NULL, units = '', brks = NULL, cols = NULL, + axelab = TRUE, intydep = 200, intxhoriz = 20, + drawleg = TRUE, fileout = NULL, width = 10, height = 8, + size_units = 'in', res = 100, var = NULL, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.axis", "cex.main", "col", "lab", "las", "mai", "mar", "mgp", "new", "ps", "tck") @@ -65,18 +67,37 @@ VizSection <- function(var, horiz, depth, toptitle = '', sizetit = 1, # Input arguments # ~~~~~~~~~~~~~~~~~ # - dims <- dim(var) + if (missing(data) || is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") + } + dims <- dim(data) if (length(dims) > 2) { - stop("Only 2 dimensions expected for var : (lon,depth) or (lat,depth)") + stop("Only 2 dimensions expected for data : (lon,depth) or (lat,depth)") } if (dims[1] != length(horiz) | dims[2] != length(depth)) { if (dims[1] == length(depth) & dims[2] == length(horiz)) { - var <- t(var) - dims <- dim(var) + data <- t(data) + dims <- dim(data) } else { - stop("Inconsistent var dimensions and longitudes/latitudes + depth") + stop("Inconsistent data dimensions and longitudes/latitudes + depth") } } + # Check title_scale + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } + dhoriz <- horiz[2:dims[1]] - horiz[1:(dims[1] - 1)] wher <- which(dhoriz > (mean(dhoriz) + 5)) if (length(wher) > 0) { @@ -89,8 +110,8 @@ VizSection <- function(var, horiz, depth, toptitle = '', sizetit = 1, depmin <- min(depth) depmax <- max(depth) if (is.null(brks) == TRUE) { - ll <- signif(min(var, na.rm = TRUE), 4) - ul <- signif(max(var, na.rm = TRUE), 4) + ll <- signif(min(data, na.rm = TRUE), 4) + ul <- signif(max(data, na.rm = TRUE), 4) if (is.null(cols) == TRUE) { cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", "white", "yellow", "orange", "red", "saddlebrown") @@ -107,11 +128,11 @@ VizSection <- function(var, horiz, depth, toptitle = '', sizetit = 1, } } } + # # Plotting the section # ~~~~~~~~~~~~~~~~~~ # - # Open connection to graphical device if (!is.null(fileout)) { saveToFile(fileout) @@ -140,8 +161,8 @@ VizSection <- function(var, horiz, depth, toptitle = '', sizetit = 1, mgp = c(2.5, 0.5, 0), las = 1) image(horizb$x, depthb$x, array(0, dims), col = 'grey', breaks = c(-1, 1), axes = FALSE, xlab = "", ylab = "", main = toptitle, - cex.main = 1.5 * sizetit) - image(horizb$x, depthb$x, var[horizb$ix, depthb$ix], col = cols, + cex.main = 1.5 * title_scale) + image(horizb$x, depthb$x, data[horizb$ix, depthb$ix], col = cols, breaks = brks, axes = FALSE, xlab = "", ylab = "", add = TRUE) if (axelab) { minhoriz <- ceiling(round(min(horizb$x), 0) / 10) * 10 diff --git a/R/VizStereoMap.R b/R/VizStereoMap.R index 047c54563bd7350b823c86400a00e3a9d494eac6..5c7321005c4de4b10cffd65f65e6db6b2b289421 100644 --- a/R/VizStereoMap.R +++ b/R/VizStereoMap.R @@ -8,26 +8,27 @@ #'adjust the position, size and colour of the components. This plot function is #'compatible with figure layouts if colour bar is disabled. #' -#'@param var Array with the values at each cell of a grid on a regular +#'@param data Array with the values at each cell of a grid on a regular #' rectangular or gaussian grid. The array is expected to have two dimensions: #' c(latitude, longitude). Longitudes can be in ascending or descending order #' and latitudes in any order. It can contain NA values (coloured with #' 'colNA'). Arrays with dimensions c(longitude, latitude) will also be #' accepted but 'lon' and 'lat' will be used to disambiguate so this #' alternative is not appropriate for square arrays. +#'@param var Deprecated. Use 'data' instead. #'@param lon Numeric vector of longitude locations of the cell centers of the -#' grid of 'var', in ascending or descending order (same as 'var'). Expected +#' grid of 'data', in ascending or descending order (same as 'data'). Expected #' to be regularly spaced, within either of the ranges [-180, 180] or #' [0, 360]. Data for two adjacent regions split by the limits of the #' longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)} -#' ('var' must be provided consitently). +#' ('data' must be provided consitently). #'@param lat Numeric vector of latitude locations of the cell centers of the -#' grid of 'var', in any order (same as 'var'). Expected to be from a regular +#' grid of 'data', in any order (same as 'data'). Expected to be from a regular #' rectangular or gaussian grid, within the range [-90, 90]. #'@param varu Array of the zonal component of wind/current/other field with -#' the same dimensions as 'var'. +#' the same dimensions as 'data'. #'@param varv Array of the meridional component of wind/current/other field -#' with the same dimensions as 'var'. +#' with the same dimensions as 'data'. #'@param latlims Latitudinal limits of the figure.\cr #' Example : c(60, 90) for the North Pole\cr #' c(-90,-60) for the South Pole @@ -36,18 +37,18 @@ #'@param sizetit Scale factor for the figure top title provided in parameter #' 'toptitle'. Deprecated. Use 'title_scale' instead. #'@param units Title at the top of the colour bar, most commonly the units of -#' the variable provided in parameter 'var'. +#' the variable provided in parameter 'data'. #'@param brks,cols,bar_limits,triangle_ends Usually only providing 'brks' is #' enough to generate the desired colour bar. These parameters allow to #' define n breaks that define n - 1 intervals to classify each of the values -#' in 'var'. The corresponding grid cell of a given value in 'var' will be +#' in 'data'. The corresponding grid cell of a given value in 'data' will be #' coloured in function of the interval it belongs to. These parameters are #' sent to \code{ColorBarContinuous()} to generate the breaks and colours. Additional #' colours for values beyond the limits of the colour bar are also generated #' and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are #' properly provided to do so. See ?ColorBarContinuous for a full explanation. #'@param col_inf,col_sup,colNA Colour identifiers to colour the values in -#' 'var' that go beyond the extremes of the colour bar and to colour NA +#' 'data' that go beyond the extremes of the colour bar and to colour NA #' values, respectively. 'colNA' takes attr(cols, 'na_color') if available by #' default, where cols is the parameter 'cols' if provided or the vector of #' colors returned by 'color_fun'. If not available, it takes 'pink' by @@ -62,7 +63,7 @@ #' continents. Takes the value gray(0.5) by default. #'@param coast_width Line width of the coast line of the drawn projected #' continents. Takes the value 1 by default. -#'@param contours Array of same dimensions as 'var' to be added to the plot +#'@param contours Array of same dimensions as 'data' to be added to the plot #' and displayed with contours. Parameter 'brks2' is required to define the #' magnitude breaks for each contour curve. #'@param brks2 A numeric value or vector of magnitude breaks where to draw @@ -75,13 +76,14 @@ #' and 'brks2'. #'@param contour_lty Line type of the contour curves. Takes 1 (solid) by #' default. See help on 'lty' in par() for other accepted values. -#'@param contour_label_draw A logical value indicating whether to draw the +#'@param contour_draw_label A logical value indicating whether to draw the #' contour labels (TRUE) or not (FALSE) when 'contours' is used. The default #' value is TRUE. +#'@param contour_label_draw Deprecated. Use 'contour_draw_label' instead. #'@param contour_label_scale Scale factor for the superimposed labels when #' drawing contour levels. The default value is 0.6. -#'@param dots Array of same dimensions as 'var' or with dimensions -#' c(n, dim(var)), where n is the number of dot/symbol layers to add to the +#'@param dots Array of same dimensions as 'data' or with dimensions +#' c(n, dim(data)), where n is the number of dot/symbol layers to add to the #' plot. A value of TRUE at a grid cell will draw a dot/symbol on the #' corresponding square of the plot. By default all layers provided in 'dots' #' are plotted with dots, but a symbol can be specified for each of the @@ -170,39 +172,38 @@ #'data <- matrix(rnorm(100 * 50), 100, 50) #'x <- seq(from = 0, to = 360, length.out = 100) #'y <- seq(from = -90, to = 90, length.out = 50) -#'VizStereoMap(data, x, y, latlims = c(60, 90), brks = 50, +#'VizStereoMap(data = data, lon = x, lat = y, latlims = c(60, 90), brks = 50, #' toptitle = "This is the title") #'@import mapproj utils #'@importFrom grDevices dev.cur dev.new dev.off gray #'@importFrom stats median -#' @importFrom s2dv InsertDim +#'@importFrom s2dv InsertDim #'@export -VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60, 90), - toptitle = NULL, sizetit = NULL, units = NULL, - brks = NULL, cols = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - colNA = NULL, color_fun = ClimPalette(), - filled.continents = FALSE, coast_color = NULL, - coast_width = 1, - contours = NULL, brks2 = NULL, contour_lwd = 0.5, - contour_color = 'black', contour_lty = 1, - contour_label_draw = TRUE, contour_label_scale = 0.6, - dots = NULL, dot_symbol = 4, dot_size = 0.8, - intlat = 10, - arr_subsamp = floor(length(lon) / 30), arr_scale = 1, - arr_ref_len = 15, arr_units = "m/s", - arr_scale_shaft = 1, arr_scale_shaft_angle = 1, - drawleg = TRUE, subsampleg = NULL, - bar_extra_labels = NULL, draw_bar_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, - bar_label_digits = 4, bar_label_scale = 1, - units_scale = 1, bar_tick_scale = 1, - bar_extra_margin = rep(0, 4), - boxlim = NULL, boxcol = "purple2", boxlwd = 5, - margin_scale = rep(1, 4), title_scale = 1, - numbfig = NULL, fileout = NULL, - width = 6, height = 5, size_units = 'in', - res = 100, ...) { +VizStereoMap <- function(data = NULL, lon, lat, varu = NULL, varv = NULL, + latlims = c(60, 90), toptitle = NULL, sizetit = NULL, + units = NULL, brks = NULL, cols = NULL, + bar_limits = NULL, triangle_ends = NULL, + col_inf = NULL, col_sup = NULL, colNA = NULL, + color_fun = ClimPalette(), filled.continents = FALSE, + coast_color = NULL, coast_width = 1, + contours = NULL, brks2 = NULL, contour_lwd = 0.5, + contour_color = 'black', contour_lty = 1, + contour_draw_label = TRUE, contour_label_draw = NULL, + contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, + dot_size = 0.8, intlat = 10, + arr_subsamp = floor(length(lon) / 30), arr_scale = 1, + arr_ref_len = 15, arr_units = "m/s", + arr_scale_shaft = 1, arr_scale_shaft_angle = 1, + drawleg = TRUE, subsampleg = NULL, + bar_extra_labels = NULL, draw_bar_ticks = TRUE, + draw_separators = FALSE, triangle_ends_scale = 1, + bar_label_digits = 4, bar_label_scale = 1, + units_scale = 1, bar_tick_scale = 1, + bar_extra_margin = rep(0, 4), boxlim = NULL, + boxcol = "purple2", boxlwd = 5, + margin_scale = rep(1, 4), title_scale = 1, + numbfig = NULL, fileout = NULL, width = 6, height = 5, + size_units = 'in', res = 100, var = NULL, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.main", "col", "fin", "lab", "las", "lwd", "mai", "mar", "mgp", "new", "pch", "ps") @@ -229,20 +230,30 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 stop("Parameters 'lon' and 'lat' must be numeric vectors.") } - # Check var - if (!is.array(var)) { - stop("Parameter 'var' must be a numeric array.") + # Check data + if (is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") } - if (length(dim(var)) > 2) { - var <- drop(var) - dim(var) <- head(c(dim(var), 1, 1), 2) + if (!is.array(data)) { + stop("Parameter 'data' must be a numeric array.") } - if (length(dim(var)) > 2) { - stop("Parameter 'var' must be a numeric array with two dimensions. See PlotMultiMap() for multi-pannel maps or AnimateMap() for animated maps.") - } else if (length(dim(var)) < 2) { - stop("Parameter 'var' must be a numeric array with two dimensions.") + if (length(dim(data)) > 2) { + data <- drop(data) + dim(data) <- head(c(dim(data), 1, 1), 2) } - dims <- dim(var) + if (length(dim(data)) > 2) { + stop("Parameter 'data' must be a numeric array with two dimensions. See PlotMultiMap() for multi-pannel maps or AnimateMap() for animated maps.") + } else if (length(dim(data)) < 2) { + stop("Parameter 'data' must be a numeric array with two dimensions.") + } + dims <- dim(data) # Check varu and varv if (!is.null(varu) && !is.null(varv)) { @@ -258,10 +269,10 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 if (!is.null(varu) && !is.null(varv)) { if (dim(varu)[1] != dims[1] || dim(varu)[2] != dims[2]) { - stop("Parameter 'varu' must have same number of longitudes and latitudes as 'var'.") + stop("Parameter 'varu' must have same number of longitudes and latitudes as 'data'.") } if (dim(varv)[1] != dims[1] || dim(varv)[2] != dims[2]) { - stop("Parameter 'varv' must have same number of longitudes and latitudes as 'var'.") + stop("Parameter 'varv' must have same number of longitudes and latitudes as 'data'.") } } @@ -269,22 +280,22 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 # with dimensions c(lon, lat). if (dims[1] != length(lon) || dims[2] != length(lat)) { if (dims[1] == length(lat) && dims[2] == length(lon)) { - var <- t(var) + data <- t(data) if (!is.null(varu)) varu <- t(varu) if (!is.null(varv)) varv <- t(varv) if (!is.null(dots)) dots <- aperm(dots, c(1, 3, 2)) - dims <- dim(var) + dims <- dim(data) } } # Check lon if (length(lon) != dims[1]) { - stop("Parameter 'lon' must have as many elements as the number of cells along longitudes in the input array 'var'.") + stop("Parameter 'lon' must have as many elements as the number of cells along longitudes in the input array 'data'.") } # Check lat if (length(lat) != dims[2]) { - stop("Parameter 'lat' must have as many elements as the number of cells along longitudes in the input array 'var'.") + stop("Parameter 'lat' must have as many elements as the number of cells along longitudes in the input array 'data'.") } # Prepare sorted lon/lat and other arguments @@ -331,23 +342,23 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 title_scale <- sizetit } - tmp <- .create_var_limits(data = var, brks = brks, + tmp <- .create_var_limits(data = data, 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, + # draw_separators, triangle_ends_scale, bar_label_scale, units, units_scale, # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup 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, + bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks, draw_separators = draw_separators, 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) + bar_label_scale = bar_label_scale, title = units, + title_scale = units_scale, bar_tick_scale = bar_tick_scale, + bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf @@ -413,7 +424,7 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 if (dim(contours)[1] == dims[2] & dim(contours)[2] == dims[1]) { contours <- t(contours) } else { - stop("Parameter 'contours' must have the same number of longitudes and latitudes as 'var'.") + stop("Parameter 'contours' must have the same number of longitudes and latitudes as 'data'.") } } @@ -448,9 +459,13 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 stop("Parameter 'contour_lty' must be either a number or a character string.") } - # Check contour_label_draw - if (!is.logical(contour_label_draw)) { - stop("Parameter 'contour_label_draw' must be a logical value.") + # Check contour_draw_label + if (missing(contour_draw_label) && !missing(contour_label_draw)) { + contour_draw_label <- contour_label_draw + warning("The parameter 'contour_label_draw' is deprecated. Use 'contour_draw_label' instead.") + } + if (!is.logical(contour_draw_label)) { + stop("Parameter 'contour_draw_label' must be a logical value.") } # Check contour_label_scale @@ -461,7 +476,7 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 # Check dots, dot_symbol and dot_size if (!is.null(dots)) { if (dim(dots)[2] != dims[1] || dim(dots)[3] != dims[2]) { - stop("Parameter 'dots' must have the same number of longitudes and latitudes as 'var'.") + stop("Parameter 'dots' must have the same number of longitudes and latitudes as 'data'.") } if (!is.numeric(dot_symbol) && !is.character(dot_symbol)) { stop("Parameter 'dot_symbol' must be a numeric or character string vector.") @@ -642,14 +657,14 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 lon[jx] + dlon, lon[jx] - dlon), c(lat[lat_plot_ind][jy] - dlat, lat[lat_plot_ind][jy] - dlat, lat[lat_plot_ind][jy] + dlat, lat[lat_plot_ind][jy] + dlat)) - if (is.na(var[jx, lat_plot_ind[jy]] > 0)) { + if (is.na(data[jx, lat_plot_ind[jy]] > 0)) { col <- colNA - } else if (var[jx, lat_plot_ind[jy]] <= brks[1]) { + } else if (data[jx, lat_plot_ind[jy]] <= brks[1]) { col <- col_inf_image - } else if (var[jx, lat_plot_ind[jy]] >= tail(brks, 1)) { + } else if (data[jx, lat_plot_ind[jy]] >= tail(brks, 1)) { col <- col_sup_image } else { - ind <- which(brks[-1] >= var[jx, lat_plot_ind[jy]] & var[jx, lat_plot_ind[jy]] > brks[-length(brks)]) + ind <- which(brks[-1] >= data[jx, lat_plot_ind[jy]] & data[jx, lat_plot_ind[jy]] > brks[-length(brks)]) col <- cols[ind] } polygon(coord, col = col, border = NA) @@ -672,7 +687,7 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 lines(xc, yc, col = contour_color, lwd = contour_lwd, lty = contour_lty) # draw label - if (contour_label_draw) { + if (contour_draw_label) { label_char <- as.character(signif(brks2[n_brks2], 2)) ## Check if the label has enough space to draw first. last_slope <- Inf @@ -719,7 +734,7 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 if (!is.null(dots)) { numbfig <- 1 # for compatibility with PlotEquiMap code dots <- dots[, , lat_plot_ind, drop = FALSE] - data_avail <- !is.na(var[, lat_plot_ind, drop = FALSE]) + data_avail <- !is.na(data[, lat_plot_ind, drop = FALSE]) for (counter in 1:(dim(dots)[1])) { points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE) points_proj <- mapproj::mapproject(lon[points[, 1]], lat[lat_plot_ind][points[, 2]]) @@ -853,11 +868,11 @@ VizStereoMap <- function(var, lon, lat, varu = NULL, varv = NULL, latlims = c(60 if (drawleg) { ColorBarContinuous(brks, cols, TRUE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup, - extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, + bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks, 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) + bar_label_scale = bar_label_scale, bar_tick_scale = bar_tick_scale, + bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits) } # If the graphic was saved to file, close the connection with the device diff --git a/R/VizTriangles4Categories.R b/R/VizTriangles4Categories.R index 15a9dd7d334efd276f2be613d9bc666a0f67ee14..ca48f5f6901c347dc62df85dd48ec18c2ac87c9d 100644 --- a/R/VizTriangles4Categories.R +++ b/R/VizTriangles4Categories.R @@ -32,8 +32,9 @@ #' length of the row of parameter 'data'. Set the sequence from 1 to the #' length of the row of parameter 'data' as default. #'@param ytitle A string of title of the y-axis. Set NULL as default. -#'@param legend A logical value to decide to draw the color bar legend or not. +#'@param drawleg A logical value to decide to draw the color bar legend or not. #' Set TRUE as default. +#'@param legend Deprecated. Use 'drawleg' instead. #'@param lab_legend A vector of labels indicating what is represented in each #'category (i.e. triangle). Set the sequence from 1 to the length of #' the categories (2 or 4). @@ -83,11 +84,12 @@ VizTriangles4Categories <- function(data, brks = NULL, cols = NULL, cex_sig = 1, xlab = TRUE, ylab = TRUE, xlabels = NULL, xtitle = NULL, ylabels = NULL, ytitle = NULL, - legend = TRUE, lab_legend = NULL, - cex_leg = 1, col_leg = 'black', - cex_axis = 1.5, mar = c(5, 4, 0, 0), - fileout = NULL, size_units = 'px', - res = 100, figure.width = 1, ...) { + drawleg = TRUE, legend = NULL, + lab_legend = NULL, cex_leg = 1, + col_leg = 'black', cex_axis = 1.5, + mar = c(5, 4, 0, 0), fileout = NULL, + size_units = 'px', res = 100, + figure.width = 1, ...) { # Checking the dimensions if (length(dim(data)) != 3) { stop("Parameter 'data' must be an array with three dimensions.") @@ -125,7 +127,16 @@ VizTriangles4Categories <- function(data, brks = NULL, cols = NULL, stop( "Parameter 'data' should contain a dimcat dimension with length equals to two or four as only two or four categories can be plotted.") - } + } + + # Check drawleg + if (missing(drawleg) && !missing(legend)) { + warning("The parameter 'legend' is deprecated. Use 'drawleg' instead.") + drawleg <- legend + } + if (!is.logical(drawleg) || length(drawleg) != 1) { + stop("Parameter 'drawleg' must be a single logical value.") + } # Checking what is available and generating missing information if (!is.null(lab_legend) && @@ -183,7 +194,7 @@ VizTriangles4Categories <- function(data, brks = NULL, cols = NULL, data_cat[data < brks[i + 1]] <- cols[i] } - if(legend){ + if(drawleg){ layout(matrix(c(1, 2, 1, 3), 2, 2, byrow = T), widths = c(10, 3.4), heights = c(10, 3.5)) par(oma = c(1, 1, 1, 1), mar = mar) @@ -255,7 +266,7 @@ VizTriangles4Categories <- function(data, brks = NULL, cols = NULL, # legend - if(legend){ + if(drawleg){ # Colorbar par(mar=c(0,0,0,0)) ColorBarContinuous(brks = brks, cols = cols, vertical = T, draw_ticks = T, draw_separators = T, diff --git a/R/VizVsLTime.R b/R/VizVsLTime.R index 7fde22699f45bebcd3b501dba3fc4ef70bea98cd..9fac301acad7e3838f82f1039cb2e9bd32e14b04 100644 --- a/R/VizVsLTime.R +++ b/R/VizVsLTime.R @@ -9,9 +9,10 @@ #'along the forecast time for all the input experiments on the same figure #'with their confidence intervals. #' -#'@param var Matrix containing any Prediction Score with dimensions:\cr +#'@param data Matrix containing any Prediction Score with dimensions:\cr #' (nexp/nmod, 3/4 ,nltime)\cr #' or (nexp/nmod, nobs, 3/4 ,nltime). +#'@param var Deprecated. Use 'data' instead. #'@param toptitle Main title, optional. #'@param ytitle Title of Y-axis, optional. #'@param monini Starting month between 1 and 12. Default = 1. @@ -23,12 +24,14 @@ #'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. #'@param hlines c(a,b, ..) Add horizontal black lines at Y-positions a,b, ...\cr #' Default = NULL. -#'@param leg TRUE/FALSE if legend should be added or not to the plot. +#'@param drawleg TRUE/FALSE if legend should be added or not to the plot. #' Default = TRUE. +#'@param leg Deprecated. Use 'drawleg' instead. #'@param siglev TRUE/FALSE if significance level should replace confidence #' interval.\cr #' Default = FALSE. -#'@param sizetit Multiplicative factor to change title size, optional. +#'@param title_scale Scale factor for the figure top title. Defaults to 1. +#'@param sizetit Deprecated. Use 'title_scale' instead. #'@param show_conf TRUE/FALSE to show/not confidence intervals for input #' variables. #'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, @@ -84,13 +87,15 @@ #'@importFrom grDevices dev.cur dev.new dev.off #'@importFrom stats ts #'@importFrom s2dv InsertDim -VizVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, - nticks = NULL, limits = NULL, - listexp = c('exp1', 'exp2', 'exp3'), - listobs = c('obs1', 'obs2', 'obs3'), biglab = FALSE, hlines = NULL, - leg = TRUE, siglev = FALSE, sizetit = 1, show_conf = TRUE, - fileout = NULL, - width = 8, height = 5, size_units = 'in', res = 100, ...) { +VizVsLTime <- function(data, toptitle = '', ytitle = '', monini = 1, + freq = 12, nticks = NULL, limits = NULL, + listexp = c('exp1', 'exp2', 'exp3'), + listobs = c('obs1', 'obs2', 'obs3'), + biglab = FALSE, hlines = NULL, drawleg = TRUE, + leg = NULL, siglev = FALSE, title_scale = 1, + sizetit = NULL, show_conf = TRUE, fileout = NULL, + width = 8, height = 5, size_units = 'in', res = 100, + var = 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", "fin", "lab", "las", "lend", "lty", "lwd", "mai", "mgp", "new", "pin", "ps", "pty") @@ -108,20 +113,47 @@ VizVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, # Get some arguments # ~~~~~~~~~~~~~~~~~~~~ # - if (length(dim(var)) == 3) { - var <- s2dv::InsertDim(var, posdim = 2, lendim = 1, name = 'stats') - } else if (length(dim(var)) != 4) { - stop("Parameter 'var' should have 3 or 4 dimensions: c(n. exp[, n. obs], 3/4, n. lead-times)") - } - nleadtime <- dim(var)[4] - nexp <- dim(var)[1] - nobs <- dim(var)[2] + if (missing(data) || is.null(data)) { + if (!is.null(var)) { + data <- var + warning("The parameter 'var' is deprecated. Use 'data' instead.") + } else { + stop("Parameter 'data' cannot be NULL.") + } + } else if (!is.null(var)) { + warning("The parameter 'var' is deprecated. 'data' will be used instead.") + } + if (length(dim(data)) == 3) { + data <- s2dv::InsertDim(data, posdim = 2, lendim = 1, name = 'stats') + } else if (length(dim(data)) != 4) { + stop("Parameter 'data' should have 3 or 4 dimensions: c(n. exp[, n. obs], 3/4, n. lead-times)") + } + # Check title_scale + if (missing(title_scale) && !missing(sizetit)) { + warning("The parameter 'sizetit' is deprecated. Use 'title_scale' instead.") + title_scale <- sizetit + } + if (!is.numeric(title_scale) || length(title_scale) != 1) { + stop("Parameter 'title_scale' must be a single numerical value.") + } + # Check drawleg + if (missing(drawleg) && !missing(leg)) { + warning("The parameter 'leg' is deprecated. Use 'drawleg' instead.") + drawleg <- leg + } + if (!is.logical(drawleg) || length(drawleg) != 1) { + stop("Parameter 'drawleg' must be a single logical value") + } + + nleadtime <- dim(data)[4] + nexp <- dim(data)[1] + nobs <- dim(data)[2] if (is.null(limits) == TRUE) { - if (all(is.na(var > 0))) { + if (all(is.na(data > 0))) { ll <- ul <- 0 } else { - ll <- min(var, na.rm = TRUE) - ul <- max(var, na.rm = TRUE) + ll <- min(data, na.rm = TRUE) + ul <- max(data, na.rm = TRUE) } if (biglab) { ul <- ul + 0.4 * (ul - ll) @@ -200,7 +232,7 @@ VizVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, legsize <- 1 } plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, - main = toptitle, cex.main = cexmain*sizetit, axes = FALSE) + main = toptitle, cex.main = cexmain*title_scale, axes = FALSE) axis(1, at = labind, labels = labmonth) axis(2) box() @@ -220,7 +252,7 @@ VizVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, legendcol <- array(dim = nobs * nexp) ind <- 1 if (show_conf == TRUE) { - start_line <- dim(var)[3] + start_line <- dim(data)[3] end_line <- 1 } else { start_line <- 2 @@ -231,7 +263,7 @@ VizVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, for (jexp in 1:nexp) { for (jobs in 1:nobs) { par(new = TRUE) - plot(var[jexp, jobs, jt, ], type = lines[jt], ylim = c(ll, ul), + plot(data[jexp, jobs, jt, ], type = lines[jt], ylim = c(ll, ul), col = color[jexp], lty = type[jobs], lwd = thickness[jobs, jt], ylab = "", xlab = "", axes = FALSE) legendnames[ind] <- paste(listexp[jexp], 'vs', listobs[jobs]) @@ -242,7 +274,7 @@ VizVsLTime <- function(var, toptitle = '', ytitle = '', monini = 1, freq = 12, } } } - if (leg) { + if (drawleg) { if (nobs == 1) { legendnames <- listexp[1:nexp] } diff --git a/R/VizWeeklyClim.R b/R/VizWeeklyClim.R index 9615c3b9fa0dcedd5567fc927b1ec78a6273a66b..3805a963d77ae648e3fd1b2544ed4964df2a1857 100644 --- a/R/VizWeeklyClim.R +++ b/R/VizWeeklyClim.R @@ -36,7 +36,8 @@ #'@param ylim A numeric vector of length two providing limits of the scale. #' Use NA to refer to the existing minimum or maximum. For more information, #' see 'ggplot2' documentation of 'scale_y_continuous' parameter. -#'@param title The text for the top title of the plot. It is NULL by default. +#'@param toptitle The text for the top title of the plot. It is NULL by default. +#'@param title Deprecated. Use 'toptitle' instead. #'@param subtitle The text for the subtitle of the plot. It is NULL bu default. #'@param ytitle Character string to be drawn as y-axis title. It is NULL by #' default. @@ -66,7 +67,7 @@ #'VizWeeklyClim(data = data, first_date = '2002-08-09', #' last_date = '2002-09-15', ref_period = 2010:2019, #' data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', -#' title = "Observed weekly means and climatology", +#' toptitle = "Observed weekly means and climatology", #' subtitle = "Target years: 2010 to 2019", #' ytitle = paste0('tas', " (", "deg.C", ")")) #' @@ -78,12 +79,12 @@ #' @importFrom rlang .data #'@export VizWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, - data_years = NULL, time_dim = 'time', - sdate_dim = 'sdate', ylim = NULL, - title = NULL, subtitle = NULL, - ytitle = NULL, legend = TRUE, - palette = "Blues", fileout = NULL, device = NULL, - width = 8, height = 6, units = 'in', dpi = 300) { + data_years = NULL, time_dim = 'time', + sdate_dim = 'sdate', ylim = NULL, toptitle = NULL, + title = NULL, subtitle = NULL, ytitle = NULL, + legend = TRUE, palette = "Blues", fileout = NULL, + device = NULL, width = 8, height = 6, units = 'in', + dpi = 300) { ## Check input arguments # data if (is.array(data)) { @@ -201,7 +202,17 @@ VizWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, warning("Parameter 'ylim' can't be a character string, it will not be used.") ylim <- NULL } - + # toptitle + if (missing(toptitle) && !missing(title)) { + warning("The parameter 'title' is deprecated. Use 'toptitle' instead.") + toptitle <- title + } + if (!is.null(toptitle)) { + if (!is.character(toptitle)) { + stop("Parameter 'toptitle' must be a character string.") + } + } + index_first_date <- which(dates == first_date) index_last_date <- length(dates) - (length(dates) %% 7) last_date <- dates[index_last_date] @@ -296,7 +307,7 @@ VizWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, alpha = 1, linewidth = 0.7, show.legend = legend) } p = p + theme_bw() + ylab(ytitle) + xlab(NULL) + - ggtitle(title, subtitle = subtitle) + + ggtitle(toptitle, subtitle = subtitle) + scale_x_date(breaks = seq(min(all$day), max(all$day), by = "7 days"), minor_breaks = NULL, expand = c(0.03, 0.03), labels = scales::date_format("%d %b %Y")) + diff --git a/man/ColorBarContinuous.Rd b/man/ColorBarContinuous.Rd index f4dee97e0dd926b5c2de2fee3af25e5a09f26f50..df6e0a2510dfd8c6f730bb5601ea55701f1cae55 100644 --- a/man/ColorBarContinuous.Rd +++ b/man/ColorBarContinuous.Rd @@ -16,16 +16,21 @@ ColorBarContinuous( col_sup = NULL, color_fun = ClimPalette(), plot = TRUE, - draw_ticks = TRUE, + draw_bar_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, + bar_extra_labels = NULL, extra_labels = NULL, title = NULL, title_scale = 1, - label_scale = 1, - tick_scale = 1, - extra_margin = rep(0, 4), - label_digits = 4, + bar_label_scale = 1, + label_scale = NULL, + bar_tick_scale = 1, + tick_scale = NULL, + bar_extra_margin = rep(0, 4), + extra_margin = NULL, + bar_label_digits = 4, + label_digits = NULL, ... ) } @@ -63,7 +68,7 @@ ends the colours have been provided for.} colorbar. Takes by default an approximation of a value that yields a readable tick arrangement (extreme breaks always ticked). If set to 0 or lower, no labels are drawn. See the code of the function for details or -use 'extra_labels' for customized tick arrangements.} +use 'bar_extra_labels' for customized tick arrangements.} \item{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 @@ -108,7 +113,7 @@ parameter is set by default to ClimPalette().} \item{plot}{Logical value indicating whether to only compute its breaks and colours (FALSE) or to also draw it on the current device (TRUE).} -\item{draw_ticks}{Whether to draw ticks for the labels along the colour bar +\item{draw_bar_ticks}{Whether to draw ticks for the labels along the colour bar (TRUE) or not (FALSE). TRUE by default. Disregarded if 'plot = FALSE'.} \item{draw_separators}{Whether to draw black lines in the borders of each of @@ -120,30 +125,40 @@ colour bar, if drawn at all. Takes 1 by default (rectangle triangle proportional to the thickness of the colour bar). Disregarded if 'plot = FALSE'.} -\item{extra_labels}{Numeric vector of extra labels to draw along axis of +\item{bar_extra_labels}{Numeric vector of extra labels to draw along axis of the colour bar. The number of provided decimals will be conserved. Disregarded if 'plot = FALSE'.} +\item{extra_labels}{Deprecated. Use 'bar_extra_labels' instead.} + \item{title}{Title to draw on top of the colour bar, most commonly with the units of the represented field in the neighbour figures. Empty by default.} \item{title_scale}{Scale factor for the 'title' of the colour bar. Takes 1 by default.} -\item{label_scale}{Scale factor for the labels of the colour bar. +\item{bar_label_scale}{Scale factor for the labels of the colour bar. Takes 1 by default.} -\item{tick_scale}{Scale factor for the length of the ticks of the labels +\item{label_scale}{Deprecated. Use 'bar_label_scale' instead.} + +\item{bar_tick_scale}{Scale factor for the length of the ticks of the labels along the colour bar. Takes 1 by default.} -\item{extra_margin}{Extra margins to be added around the colour bar, +\item{tick_scale}{Deprecated. Use 'bar_tick_scale' instead.} + +\item{bar_extra_margin}{Extra margins to be added around the colour bar, in the format c(y1, x1, y2, x2). The units are margin lines. Takes rep(0, 4) by default.} -\item{label_digits}{Number of significant digits to be displayed in the +\item{extra_margin}{Deprecated. Use 'bar_extra_margin' instead.} + +\item{bar_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 'bar_extra_labels'. Takes 4 by default.} + +\item{label_digits}{Deprecated. Use 'bar_label_digits' instead.} \item{...}{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 diff --git a/man/ColorBarDiscrete.Rd b/man/ColorBarDiscrete.Rd index 14c5ab67ae7a9b1e3bdd2cf0a44fbb6804bc3c08..3809bfd2cf1148629afd3913fe27ab09fa44b1d0 100644 --- a/man/ColorBarDiscrete.Rd +++ b/man/ColorBarDiscrete.Rd @@ -13,16 +13,21 @@ ColorBarDiscrete( var_limits = NULL, color_fun = ClimPalette(), plot = TRUE, - draw_ticks = FALSE, + draw_bar_ticks = FALSE, draw_separators = TRUE, labels = NULL, + bar_extra_labels = NULL, extra_labels = NULL, title = NULL, title_scale = 1, - label_scale = 1, - tick_scale = 1, - extra_margin = rep(0, 4), - label_digits = 4, + bar_label_scale = 1, + label_scale = NULL, + bar_tick_scale = 1, + tick_scale = NULL, + bar_extra_margin = rep(0, 4), + extra_margin = NULL, + bar_label_digits = 4, + label_digits = NULL, ... ) } @@ -60,7 +65,7 @@ ends the colours have been provided for.} colorbar. Takes by default an approximation of a value that yields a readable tick arrangement (extreme breaks always ticked). If set to 0 or lower, no labels are drawn. See the code of the function for details or -use 'extra_labels' for customized tick arrangements.} +use 'bar_extra_labels' for customized tick arrangements.} \item{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 @@ -86,7 +91,7 @@ parameter is set by default to ClimPalette().} \item{plot}{Logical value indicating whether to only compute its breaks and colours (FALSE) or to also draw it on the current device (TRUE).} -\item{draw_ticks}{Whether to draw ticks for the labels along the colour bar +\item{draw_bar_ticks}{Whether to draw ticks for the labels along the colour bar (TRUE) or not (FALSE). TRUE by default. Disregarded if 'plot = FALSE'.} \item{draw_separators}{Whether to draw black lines in the borders of each of @@ -96,30 +101,40 @@ default. Disregarded if 'plot = FALSE'.} \item{labels}{A charater string vector of the names of colors. Must be the same length as 'cols'.} -\item{extra_labels}{Numeric vector of extra labels to draw along axis of +\item{bar_extra_labels}{Numeric vector of extra labels to draw along axis of the colour bar. The number of provided decimals will be conserved. Disregarded if 'plot = FALSE'.} +\item{extra_labels}{Deprecated. Use 'bar_extra_labels' instead.} + \item{title}{Title to draw on top of the colour bar, most commonly with the units of the represented field in the neighbour figures. Empty by default.} \item{title_scale}{Scale factor for the 'title' of the colour bar. Takes 1 by default.} -\item{label_scale}{Scale factor for the labels of the colour bar. +\item{bar_label_scale}{Scale factor for the labels of the colour bar. Takes 1 by default.} -\item{tick_scale}{Scale factor for the length of the ticks of the labels +\item{label_scale}{Deprecated. Use 'bar_label_scale' instead.} + +\item{bar_tick_scale}{Scale factor for the length of the ticks of the labels along the colour bar. Takes 1 by default.} -\item{extra_margin}{Extra margins to be added around the colour bar, +\item{tick_scale}{Deprecated. Use 'bar_tick_scale' instead.} + +\item{bar_extra_margin}{Extra margins to be added around the colour bar, in the format c(y1, x1, y2, x2). The units are margin lines. Takes rep(0, 4) by default.} -\item{label_digits}{Number of significant digits to be displayed in the +\item{extra_margin}{Deprecated. Use 'bar_extra_margin' instead.} + +\item{bar_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 'bar_extra_labels'. Takes 4 by default.} + +\item{label_digits}{Deprecated. Use 'bar_label_digits' instead.} \item{...}{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 @@ -154,7 +169,7 @@ belongs to.\cr\cr \examples{ cb <- ColorBarDiscrete( brks = 0:4, cols = c("green1", "green2", "green3", "green4"), - vertical = FALSE, labels = paste0('lev ', 1:4), label_scale = 1.5, - extra_margin = c(0.5, 2, 0.5, 2), plot = FALSE) + vertical = FALSE, labels = paste0('lev ', 1:4), bar_label_scale = 1.5, + bar_extra_margin = c(0.5, 2, 0.5, 2), plot = FALSE) } diff --git a/man/Viz2VarsVsLTime.Rd b/man/Viz2VarsVsLTime.Rd index 8b476183b23da0b56d04ce9213da7c2d6ce4b5f2..031733127a43b14ae3eaac89d6508be1dc809bdd 100644 --- a/man/Viz2VarsVsLTime.Rd +++ b/man/Viz2VarsVsLTime.Rd @@ -17,9 +17,11 @@ Viz2VarsVsLTime( listvars = c("var1", "var2"), biglab = FALSE, hlines = NULL, - leg = TRUE, + drawleg = TRUE, + leg = NULL, siglev = FALSE, - sizetit = 1, + title_scale = 1, + sizetit = NULL, show_conf = TRUE, fileout = NULL, width = 8, @@ -55,14 +57,18 @@ Viz2VarsVsLTime( \item{hlines}{c(a, b, ...) Add horizontal black lines at Y-positions a, b, ... The default value is NULL.} -\item{leg}{TRUE/FALSE if legend should be added or not to the plot. +\item{drawleg}{TRUE/FALSE if legend should be added or not to the plot. Default = TRUE.} +\item{leg}{Deprecated. Use 'drawleg' instead.} + \item{siglev}{TRUE/FALSE if significance level should replace confidence interval.\cr Default = FALSE.} -\item{sizetit}{Multiplicative factor to change title size, optional.} +\item{title_scale}{Multiplicative factor to change title size, optional.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{show_conf}{TRUE/FALSE to show/not confidence intervals for input variables.} @@ -117,7 +123,7 @@ input_rms[, 2, ] <- rms_ano$rms[, 1, 1, ] input_rms[, 3, ] <- rms_ano$conf.upper[, 1, 1, ] esviz:::Viz2VarsVsLTime(input_cor, input_rms, toptitle = "Time correlation and RMSE with ERA5", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, limits = c(-1, 5), listexp = c('SEAS5'), listvars = c('Corr', 'RMSE'), fileout = NULL) diff --git a/man/VizACC.Rd b/man/VizACC.Rd index 51ff6e65a38ff16085cb824af4c978de6085b137..410ef2a2231d35c395c0144db2d763df3646f39e 100644 --- a/man/VizACC.Rd +++ b/man/VizACC.Rd @@ -8,7 +8,8 @@ VizACC( ACC, sdates, toptitle = "", - sizetit = 1, + title_scale = 1, + sizetit = NULL, ytitle = "", limits = NULL, legends = NULL, @@ -37,7 +38,9 @@ interval and the 95\% significance level.} \item{toptitle}{A character string of the main title, optional.} -\item{sizetit}{A multiplicative factor to scale title size, optional.} +\item{title_scale}{A multiplicative factor to scale title size, optional.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{ytitle}{A character string of the title of Y-axis for each experiment: c('', ''), optional.} @@ -110,7 +113,7 @@ input_acc[, , , , 4] <- acc$p.val sdates <- paste0(2000:2005, '1101') esviz:::VizACC(input_acc, sdates, toptitle = "Spatial anomaly corr. coeff. with ERA5", - ytitle = "K", sizetit = 0.7, freq = 12, + ytitle = "K", title_scale = 0.7, freq = 12, legends = 'SEAS5', fileout = NULL) } } diff --git a/man/VizAnimateMap.Rd b/man/VizAnimateMap.Rd index 29b8effe6d93e0cc2dda169263e82659febdcfdd..fa28cd7f2c22fa62e16bae697c79ee054f312f73 100644 --- a/man/VizAnimateMap.Rd +++ b/man/VizAnimateMap.Rd @@ -5,11 +5,12 @@ \title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} \usage{ VizAnimateMap( - var, + data, lon, lat, toptitle = rep("", 11), - sizetit = 1, + title_scale = 1, + sizetit = NULL, units = "", monini = 1, freq = 12, @@ -29,11 +30,12 @@ VizAnimateMap( equi = TRUE, fileout = c("output1_animvsltime.gif", "output2_animvsltime.gif", "output3_animvsltime.gif"), + var = NULL, ... ) } \arguments{ -\item{var}{Matrix of dimensions (nltime, nlat, nlon) or +\item{data}{Matrix of dimensions (nltime, nlat, nlon) or (nexp/nmod, nltime, nlat, nlon) or (nexp/nmod, 3/4, nltime, nlat, nlon) or (nexp/nmod, nobs, 3/4, nltime, nlat, nlon).} @@ -45,7 +47,9 @@ VizAnimateMap( optional. If RMS, RMSSS, correlations: first exp with successive obs, then second exp with successive obs, etc ...} -\item{sizetit}{Multiplicative factor to increase title size, optional.} +\item{title_scale}{Scale factor for the figure top title. Defaults to 1.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{units}{Units, optional.} @@ -57,7 +61,7 @@ second exp with successive obs, etc ...} reached. Default = FALSE.} \item{brks}{Limits of colour levels, optional. For example: -seq(min(var), max(var), (max(var) - min(var)) / 10).} +seq(min(data), max(data), (max(data) - min(data)) / 10).} \item{cols}{Vector of colours of length(brks) - 1, optional.} @@ -97,6 +101,8 @@ Default: TRUE.} If RMS, RMSSS, correlations : first exp with successive obs, then second exp with successive obs, etc ...} +\item{var}{Deprecated. Use 'data' instead.} + \item{...}{Arguments to be passed to the method. Only accepts the following graphical parameters:\cr adj ann ask bty cex cex.axis cex.lab cex.main cex.sub @@ -125,9 +131,9 @@ Examples of input: \item{ Model output from load/ano/smoothing: (nmod, nmemb, sdate, nltime, nlat, nlon) - then passed through spread(var, posdim = 2, narm = TRUE) - & mean1dim(var, posdim = 3, narm = TRUE) - or through trend(mean1dim(var, 2), posTR = 2): + then passed through spread(data, posdim = 2, narm = TRUE) + & mean1dim(data, posdim = 3, narm = TRUE) + or through trend(mean1dim(data, 2), posTR = 2): (nmod, 3, nltime, nlat, nlon) animates average along start dates of IQR/MaxMin/SD/MAD across members or trends of the ensemble-mean computed accross the start dates. @@ -153,7 +159,7 @@ lats <- attr(map_temp$exp, "Variables")$common$lat lons <- attr(map_temp$exp, "Variables")$common$lon \dontrun{ esviz:::VizAnimateMap(clim$clim_exp[1, 1, , , ], lon = lons, lat = lats, - toptitle = "climatology of decadal prediction", sizetit = 1, + toptitle = "climatology of decadal prediction", title_scale = 1, units = "K", brks = seq(270, 300, 3), monini = 11, freq = 12, msk95lev = FALSE, filled.continents = FALSE, intlon = 10, intlat = 10) } diff --git a/man/VizAno.Rd b/man/VizAno.Rd index 36f27737a8764688b9057a0374cfd350ca877bed..817d0a3c552a535c261a6705a31c4d231114e3e4 100644 --- a/man/VizAno.Rd +++ b/man/VizAno.Rd @@ -20,7 +20,8 @@ VizAno( linezero = FALSE, points = FALSE, vlines = NULL, - sizetit = 1, + title_scale = 1, + sizetit = NULL, fileout = NULL, width = 8, height = 5, @@ -69,7 +70,9 @@ Default = FALSE.} \item{vlines}{List of x location where to add vertical black lines, optional.} -\item{sizetit}{Multiplicative factor to scale title size, optional.} +\item{title_scale}{Multiplicative factor to scale title size, optional.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{fileout}{Name of the output file for each experiment: c('',''). Extensions allowed: eps/ps, jpeg, png, pdf, bmp and tiff. If filenames diff --git a/man/VizClim.Rd b/man/VizClim.Rd index b207aaab2b3775bbaf3d348ccc297ca7b6f58d94..5ed33f71dab66270f29552752855acf72ce13b8c 100644 --- a/man/VizClim.Rd +++ b/man/VizClim.Rd @@ -15,8 +15,10 @@ VizClim( listexp = c("exp1", "exp2", "exp3"), listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, - leg = TRUE, - sizetit = 1, + drawleg = TRUE, + leg = NULL, + title_scale = 1, + sizetit = NULL, fileout = NULL, width = 8, height = 5, @@ -49,9 +51,13 @@ c(nobs, nmemb, nltime) or c(nobs, nltime)} \item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} -\item{leg}{TRUE/FALSE to plot the legend or not.} +\item{drawleg}{TRUE/FALSE to plot the legend or not. Default = TRUE.} -\item{sizetit}{Multiplicative factor to scale title size, optional.} +\item{leg}{Deprecated. Use 'drawleg' instead.} + +\item{title_scale}{Multiplicative factor to scale title size, optional.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, pdf, bmp and tiff. The default value is NULL, which the figure is shown diff --git a/man/VizCombinedMap.Rd b/man/VizCombinedMap.Rd index fc5926706290a7f2beee751fb72e1acc33d74d67..d6278fe48fa85d16a7ba3f63a19f20295b9d61f6 100644 --- a/man/VizCombinedMap.Rd +++ b/man/VizCombinedMap.Rd @@ -19,11 +19,13 @@ VizCombinedMap( col_sup = NULL, col_unknown_map = "white", mask = NULL, - col_mask = "grey", + mask_color = "grey", + col_mask = NULL, dots = NULL, bar_titles = NULL, - legend_scale = 1, + bar_label_scale = 1, cex_bar_titles = 1.5, + margin_scale = NULL, plot_margin = NULL, bar_extra_margin = c(2, 0, 2, 0), fileout = NULL, @@ -93,11 +95,13 @@ values that go beyond 'display_range'. Takes the value 'white' by default.} \item{mask}{Optional numeric array with dimensions (latitude, longitude), with values in the range [0, 1], indicating the opacity of the mask over each grid point. Cells with a 0 will result in no mask, whereas cells with a 1 -will result in a totally opaque superimposed pixel coloured in 'col_mask'.} +will result in a totally opaque superimposed pixel coloured in 'mask_color'.} -\item{col_mask}{Colour to be used for the superimposed mask (if specified in +\item{mask_color}{Colour to be used for the superimposed mask (if specified in 'mask'). Takes the value 'grey' by default.} +\item{col_mask}{Deprecated. Use 'mask_color' instead.} + \item{dots}{Array of same dimensions as 'var' or with dimensions c(n, dim(var)), where n is the number of dot/symbol layers to add to the plot. A value of TRUE at a grid cell will draw a dot/symbol on the @@ -108,16 +112,17 @@ layers via the parameter 'dot_symbol'.} \item{bar_titles}{Optional vector of character strings providing the titles to be shown on top of each of the colour bars.} -\item{legend_scale}{Scale factor for the size of the colour bar labels. Takes +\item{bar_label_scale}{Scale factor for the size of the colour bar labels. Takes 1 by default.} \item{cex_bar_titles}{Scale factor for the sizes of the bar titles. Takes 1.5 by default.} -\item{plot_margin}{Numeric vector of length 4 for the margin sizes in the -following order: bottom, left, top, and right. If not specified, use the -default of par("mar"), c(5.1, 4.1, 4.1, 2.1). Used as 'margin_scale' in -VizEquiMap.} +\item{margin_scale}{Numeric vector of length 4 for the margin sizes in the +following order: bottom, left, top, and right. If not specified (NULL), the +default of par("mar"), c(5.1, 4.1, 4.1, 2.1), is used. Default is NULL.} + +\item{plot_margin}{Deprecated. Use 'margin_scale' instead.} \item{bar_extra_margin}{A numeric vector of 4 indicating the extra margins to be added around the color bar, in the format c(y1, x1, y2, x2). The units @@ -127,10 +132,10 @@ are margin lines. The default values are c(2, 0, 2, 0).} graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, bmp and tiff} -\item{width}{File width, in the units specified in the parameter size_units +\item{width}{File width, in the units specified in the parameter 'size_units' (inches by default). Takes 8 by default.} -\item{height}{File height, in the units specified in the parameter size_units +\item{height}{File height, in the units specified in the parameter 'size_units' (inches by default). Takes 5 by default.} \item{size_units}{Units of the size of the device (file or window) to plot in. diff --git a/man/VizEquiMap.Rd b/man/VizEquiMap.Rd index efb921b1e82744e11d5bab52de91aeb10c06f08a..90f44eb185b189ed37026412b4b16d12d12141f9 100644 --- a/man/VizEquiMap.Rd +++ b/man/VizEquiMap.Rd @@ -5,7 +5,7 @@ \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ VizEquiMap( - var, + data, lon, lat, varu = NULL, @@ -75,6 +75,14 @@ VizEquiMap( units_scale = 1, bar_tick_scale = 1, bar_extra_margin = rep(0, 4), + include_lower_boundary = TRUE, + include_upper_boundary = TRUE, + hatching_mask = NULL, + hatching_density = 10, + hatching_angle = 45, + hatching_color = "#252525", + hatching_lwd = 0.5, + hatching_cross = FALSE, boxlim = NULL, boxcol = "purple2", boxlwd = 5, @@ -87,19 +95,12 @@ VizEquiMap( height = 5, size_units = "in", res = 100, - include_lower_boundary = TRUE, - include_upper_boundary = TRUE, - hatching_mask = NULL, - hatching_density = 10, - hatching_angle = 45, - hatching_color = "#252525", - hatching_lwd = 0.5, - hatching_cross = FALSE, + var = NULL, ... ) } \arguments{ -\item{var}{Array with the values at each cell of a grid on a regular +\item{data}{Array with the values at each cell of a grid on a regular rectangular or gaussian grid. The array is expected to have two dimensions: c(latitude, longitude). Longitudes can be in ascending or descending order and latitudes in any order. It can contain NA values @@ -110,22 +111,22 @@ the positions of the longitudinal and latitudinal coordinate dimensions are interchanged.} \item{lon}{Numeric vector of longitude locations of the cell centers of the -grid of 'var', in ascending or descending order (same as 'var'). Expected +grid of 'data', in ascending or descending order (same as 'data'). Expected to be regularly spaced, within either of the ranges [-180, 180] or [0, 360]. Data for two adjacent regions split by the limits of the longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)} -('var' must be provided consitently).} +('data' must be provided consitently).} \item{lat}{Numeric vector of latitude locations of the cell centers of the -grid of 'var', in any order (same as 'var'). Expected to be from a regular +grid of 'data', in any order (same as 'data'). Expected to be from a regular rectangular or gaussian grid, within the range [-90, 90].} \item{varu}{Array of the zonal component of wind/current/other field with -the same dimensions as 'var'. It is allowed that the positions of the +the same dimensions as 'data'. It is allowed that the positions of the longitudinal and latitudinal coordinate dimensions are interchanged.} \item{varv}{Array of the meridional component of wind/current/other field -with the same dimensions as 'var'. It is allowed that the positions of the +with the same dimensions as 'data'. It is allowed that the positions of the longitudinal and latitudinal coordinate dimensions are interchanged.} \item{toptitle}{Top title of the figure, scalable with parameter @@ -140,12 +141,12 @@ manipulation functions like \code{paste()} or \code{paste0()}, using \code{"\n"} to indicate line breaks.} \item{units}{Title at the top of the colour bar, most commonly the units of -the variable provided in parameter 'var'.} +the variable provided in parameter 'data'.} \item{brks, cols, bar_limits, triangle_ends}{Usually only providing 'brks' is enough to generate the desired colour bar. These parameters allow to define n breaks that define n - 1 intervals to classify each of the values -in 'var'. The corresponding grid cell of a given value in 'var' will be +in 'data'. The corresponding grid cell of a given value in 'data' will be coloured in function of the interval it belongs to. These parameters are sent to \code{ColorBar()} to generate the breaks and colours. Additional colours for values beyond the limits of the colour bar are also generated @@ -153,7 +154,7 @@ and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are properly provided to do so. See ?ColorBar for a full explanation.} \item{col_inf, col_sup, colNA}{Colour identifiers to colour the values in -'var' that go beyond the extremes of the colour bar and to colour NA +'data' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes attr(cols, 'na_color') if available by default, where cols is the parameter 'cols' if provided or the vector of colors returned by 'color_fun'. If not available, it takes 'pink' by @@ -165,7 +166,7 @@ parameters to control the visual aspect of the drawn colour bar (1/3). See ?ColorBar for a full explanation.} \item{square}{Logical value to choose either to draw a coloured square for -each grid cell in 'var' (TRUE; default) or to draw contour lines and fill +each grid cell in 'data' (TRUE; default) or to draw contour lines and fill the spaces in between with colours (FALSE). In the latter case, 'filled.continents' will take the value FALSE if not specified.} @@ -199,7 +200,7 @@ location of the shape. The default value is NULL.} \item{shapefile_lwd}{Line width of the shapefile. The default value is 1.} -\item{contours}{Array of same dimensions as 'var' to be added to the plot +\item{contours}{Array of same dimensions as 'data' to be added to the plot and displayed with contours. Parameter 'brks2' is required to define the magnitude breaks for each contour curve. Disregarded if 'square = FALSE'. It is allowed that the positions of the longitudinal and latitudinal @@ -223,8 +224,8 @@ contour labels or not. The default value is TRUE.} \item{contour_label_scale}{Scale factor for the superimposed labels when drawing contour levels.} -\item{dots}{Array of same dimensions as 'var' or with dimensions -c(n, dim(var)), where n is the number of dot/symbol layers to add to the +\item{dots}{Array of same dimensions as 'data' or with dimensions +c(n, dim(data)), where n is the number of dot/symbol layers to add to the plot. A value of TRUE at a grid cell will draw a dot/symbol on the corresponding square of the plot. By default all layers provided in 'dots' are plotted with dots, but a symbol can be specified for each of the @@ -241,7 +242,7 @@ additional accepted options.} in 'dots'. If a single value is specified, it will be applied to all layers in 'dots'. Takes 1 by default.} -\item{mask}{An array with the same dimensions as 'var' of [0, 1] or logical +\item{mask}{An array with the same dimensions as 'data' of [0, 1] or logical indicating the grids to not plot data. The value 0 or FALSE is the point not to be plotted.} @@ -330,6 +331,39 @@ parameters to control the visual aspect of the drawn colour bar parameters to control the visual aspect of the drawn colour bar (3/3). See ?ColorBar for a full explanation.} +\item{include_lower_boundary}{Logical value indicating whether to include +the minimum value of the field. Takes TRUE by default.} + +\item{include_upper_boundary}{Logical value indicating whether to include +the maximum value of the field. Takes TRUE by default.} + +\item{hatching_mask}{Logical or binary (0/1) array with two named dimensions: +c(latitude, longitude). Hatching is applied to grid cells where +'hatching_mask' is TRUE (or 1). Arrays with dimensions c(longitude, latitude) +are also accepted, but the resulting hatching may appear transposed. To +ensure correct alignment with the map, provide 'data'. The function will +compare the dimension order of 'hatching_mask' and 'data', and automatically +transpose 'hatching_mask' if the latitude and longitude dimensions appear to +be reversed.} + +\item{hatching_density}{The density of shading lines, in lines per inch. A +zero value of density means no shading nor filling, whereas negative values +and NA suppress shading (and so allow color filling). NULL means that no +shading lines are drawn. Default is 10.} + +\item{hatching_angle}{The slope of shading lines, given as an angle in degrees +(counter-clockwise). Default is 45.} + +\item{hatching_color}{Color of the hatching lines. Default is +\code{"#252525"}.} + +\item{hatching_lwd}{The line width, a positive number. The interpretation is +device-specific, and some devices do not implement line widths less than +one. Default is 0.5.} + +\item{hatching_cross}{A logical value indicating crosshatching. If TRUE, adds +a second set of lines in the opposite angle. Default is FALSE.} + \item{boxlim}{Limits of a box to be added to the plot, in degrees: c(x1, y1, x2, y2). A list with multiple box specifications can also be provided.} @@ -357,11 +391,11 @@ axe labels, ticks, thinner lines, ... Defaults to 1.} graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, bmp and tiff.} -\item{width}{File width, in the units specified in the parameter size_units +\item{width}{File width, in the units specified in the parameter 'size_units' (inches by default). Takes 8 by default.} \item{height}{File height, in the units specified in the parameter -size_units (inches by default). Takes 5 by default.} +'size_units' (inches by default). Takes 5 by default.} \item{size_units}{Units of the size of the device (file or window) to plot in. Inches ('in') by default. See ?Devices and the creator function of @@ -370,38 +404,7 @@ the corresponding device.} \item{res}{Resolution of the device (file or window) to plot in. See ?Devices and the creator function of the corresponding device.} -\item{include_lower_boundary}{Logical value indicating whether to include -the minimum value of the field. Takes TRUE by default.} - -\item{include_upper_boundary}{Logical value indicating whether to include -the maximum value of the field. Takes TRUE by default.} - -\item{hatching_mask}{Logical or binary (0/1) array with two named dimensions: -c(latitude, longitude). Hatching is applied to grid cells where -'hatching_mask' is TRUE (or 1). Arrays with dimensions c(longitude, latitude) -are also accepted, but the resulting hatching may appear transposed. To -ensure correct alignment with the map, provide 'data'. The function will -compare the dimension order of 'hatching_mask' and 'data', and automatically -transpose 'hatching_mask' if the latitude and longitude dimensions appear to -be reversed.} - -\item{hatching_density}{The density of shading lines, in lines per inch. A -zero value of density means no shading nor filling, whereas negative values -and NA suppress shading (and so allow color filling). NULL means that no -shading lines are drawn. Default is 10.} - -\item{hatching_angle}{The slope of shading lines, given as an angle in degrees -(counter-clockwise). Default is 45.} - -\item{hatching_color}{Color of the hatching lines. Default is -\code{"#252525"}.} - -\item{hatching_lwd}{The line width, a positive number. The interpretation is -device-specific, and some devices do not implement line widths less than -one. Default is 0.5.} - -\item{hatching_cross}{A logical value indicating crosshatching. If TRUE, adds -a second set of lines in the opposite angle. Default is FALSE.} +\item{var}{Deprecated. Use 'data' instead.} \item{\dots}{Arguments to be passed to the method. Only accepts the following graphical parameters:\cr @@ -443,11 +446,11 @@ figure layouts if colour bar is disabled. \dontrun{ ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, dat_dim = c('dat', 'member'), memb_dim = 'member') -var <- s2dv::MeanDims(ano$exp, "member") +data <- s2dv::MeanDims(ano$exp, "member") lats <- attr(map_temp$exp, "Variables")$common$lat lons <- attr(map_temp$exp, "Variables")$common$lon -VizEquiMap(var[1, 1, 1, 1, , ], lon = lons, lat = lats, +VizEquiMap(data[1, 1, 1, 1, , ], lon = lons, lat = lats, toptitle = 'Near-surface temperature anomaly, Nov. 2000', filled.continents = FALSE, title_scale = 0.7, caption = paste0("This is a test caption.", "\n", diff --git a/man/VizForecastPDF.Rd b/man/VizForecastPDF.Rd index cec38a5e279ce20eca081ce74d7da5ecfb850640..a0d05605f1679d9f632d31147eedf6da6b993493 100644 --- a/man/VizForecastPDF.Rd +++ b/man/VizForecastPDF.Rd @@ -9,13 +9,31 @@ VizForecastPDF( tercile.limits, extreme.limits = NULL, obs = NULL, - plotfile = NULL, - title = "Set a title", + toptitle = "Set a title", + title = NULL, var.name = "Varname (units)", + title.legend = "Probability of terciles", + ensemble.legend = "Ensemble members", + obs.title = "Observations", + title.extremes = "Probability of extremes", + strings.extremes = c("Below p10", "Above p90"), + strings.legend = c("Below normal", "Near normal", "Above normal"), + strings.obs = NULL, + xlab.title = "Probability density", + title.cex = 1, + labs.cex = 1, fcst.names = NULL, + fcst.names.cex = 1, + obs.lines = TRUE, + obs.size = 3, add.ensmemb = c("above", "below", "no"), color.set = c("ggplot", "s2s4e", "hydro", "vitigeoss"), - memb_dim = "member" + memb_dim = "member", + width = 6, + height = 5, + res = 300, + fileout = NULL, + plotfile = NULL ) } \arguments{ @@ -41,10 +59,9 @@ forecast panels. (Default: extreme categories are not shown).} panel or a single value that will be reused for all forecast panels. (Default: observation is not shown).} -\item{plotfile}{(optional) A filename (pdf, png...) where the plot will be -saved. (Default: the plot is not saved).} +\item{toptitle}{A string with the plot title.} -\item{title}{A string with the plot title.} +\item{title}{Deprecated. Use 'toptitle' instead.} \item{var.name}{A string with the variable name and units.} @@ -60,7 +77,18 @@ or \code{'below'} the pdf, or not (\code{'no'}).} inflows) or the \code{"vitigeoss"} color set.} \item{memb_dim}{A character string indicating the name of the member -dimension.} +dimension} + +\item{width}{File width, in the units specified in the parameter size_units +(inches by default). Takes 8 by default.} + +\item{height}{File height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{fileout}{(optional) A filename (pdf, png...) where the plot will be +saved. (Default: the plot is not saved).} + +\item{plotfile}{Deprecated. Use 'fileout' instead.} } \value{ A ggplot object containing the plot. diff --git a/man/VizLayout.Rd b/man/VizLayout.Rd index 0fd373c4165ef4128f4425a33d04894408a48db0..75335fedcec931ed257d715ea43734f0496cf558 100644 --- a/man/VizLayout.Rd +++ b/man/VizLayout.Rd @@ -7,7 +7,7 @@ VizLayout( fun, plot_dims, - var, + data, ..., special_args = NULL, nrow = NULL, @@ -50,25 +50,26 @@ VizLayout( height = NULL, size_units = "in", res = 100, - close_device = TRUE + close_device = TRUE, + var = NULL ) } \arguments{ \item{fun}{Plot function (or name of the function) to be called on the -arrays provided in 'var'. If multiple arrays are provided in 'var', a +arrays provided in 'data'. If multiple arrays are provided in 'data', a vector of as many function names (character strings!) can be provided in -'fun', one for each array in 'var'.} +'fun', one for each array in 'data'.} \item{plot_dims}{Numeric or character string vector with identifiers of the input plot dimensions of the plot function specified in 'fun'. If -character labels are provided, names(dim(var)) or attr('dimensions', var) +character labels are provided, names(dim(data)) or attr('dimensions', data) will be checked to locate the dimensions. As many plots as -prod(dim(var)[-plot_dims]) will be generated. If multiple arrays are -provided in 'var', 'plot_dims' can be sent a list with a vector of plot +prod(dim(data)[-plot_dims]) will be generated. If multiple arrays are +provided in 'data', 'plot_dims' can be sent a list with a vector of plot dimensions for each. If a single vector is provided, it will be used for -all the arrays in 'var'.} +all the arrays in 'data'.} -\item{var}{Multi-dimensional array with at least the dimensions expected by +\item{data}{Multi-dimensional array with at least the dimensions expected by the specified plot function in 'fun'. The dimensions reqired by the function must be specified in 'plot_dims'. The dimensions can be disordered and will be reordered automatically. Dimensions can optionally @@ -83,7 +84,7 @@ blank cell in the layout, which can be populated after (see .SwitchToFigure).} \item{\dots}{Parameters to be sent to the plotting function 'fun'. If -multiple arrays are provided in 'var' and multiple functions are provided +multiple arrays are provided in 'data' and multiple functions are provided in 'fun', the parameters provided through \dots will be sent to all the plot functions, as common parameters. To specify concrete arguments for each of the plot functions see parameter 'special_args'.} @@ -92,13 +93,13 @@ each of the plot functions see parameter 'special_args'.} arguments for each of the plot functions provided in 'fun'. If you want to fix a different value for each plot in the layout you can do so by a) splitting your array into a list of sub-arrays (each with the data for -one plot) and providing it as parameter 'var', +one plot) and providing it as parameter 'data', b) providing a list of named sub-lists in 'special_args', where the names of each sub-list match the names of the parameters to be adjusted, and each value in a sub-list contains the value of the corresponding parameter. For example, if the plots are two maps with different arguments, the structure would be like:\cr -var:\cr +data:\cr List of 2\cr $ : num [1:360, 1:181] 1 3.82 5.02 6.63 8.72 ...\cr $ : num [1:360, 1:181] 2.27 2.82 4.82 7.7 10.32 ...\cr @@ -159,7 +160,7 @@ subtitles. Takes 1 by default.} \item{brks, cols, bar_limits, triangle_ends}{Usually only providing 'brks' is enough to generate the desired colour bar. These parameters allow to define n breaks that define n - 1 intervals to classify each of the values -in 'var'. The corresponding grid cell of a given value in 'var' will be +in 'data'. The corresponding grid cell of a given value in 'data' will be coloured in function of the interval it belongs to. These parameters are sent to \code{ColorBarContinuous()} to generate the breaks and colours. Additional colours for values beyond the limits of the colour bar are also generated @@ -176,16 +177,17 @@ FALSE or:\cr \item{titles}{Character string vector with titles for each of the figures in the multi-pannel, from top-left to bottom-right. Blank by default.} -\item{col_inf, col_sup}{Colour identifiers to colour the values in 'var' that +\item{col_inf, col_sup}{Colour identifiers to colour the values in 'data' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes 'white' by default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not specified. See ?ColorBarContinuous for a full explanation on 'col_inf' and 'col_sup'.} -\item{color_fun, subsampleg, bar_extra_labels, draw_bar_ticks, draw_separators, triangle_ends_scale, bar_label_digits, bar_label_scale, units_scale, bar_tick_scale, bar_extra_margin}{Set of parameters to control the visual aspect of the drawn colour bar. See ?ColorBarContinuous for a full explanation.} +\item{color_fun, subsampleg, bar_extra_labels, draw_bar_ticks, draw_separators, triangle_ends_scale, bar_label_digits, bar_label_scale, units_scale, bar_tick_scale, bar_extra_margin}{Set of parameters to control the visual aspect of the drawn colour bar. See +?ColorBarContinuous for a full explanation.} \item{units}{Title at the top of the colour bar, most commonly the units of -the variable provided in parameter 'var'.} +the variable provided in parameter 'data'.} \item{bar_left_shift_scale}{When plotting row titles, a shift is added to the horizontal positioning of the colour bar in order to center it to the @@ -199,7 +201,7 @@ format c(y1, x1, y2, x2). The units are margin lines. Takes rep(0, 4) by default.} \item{layout_by_rows}{Logical indicating wether the panels should be filled -by columns (FALSE) or by raws (TRUE, default).} +by columns (FALSE) or by rows (TRUE, default).} \item{fileout}{File where to save the plot. If not specified (default) a graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, @@ -223,6 +225,8 @@ the layout and a 'fileout' has been specified. This is useful to avoid closing the device when saving the layout into a file and willing to add extra elements or figures. Takes TRUE by default. Disregarded if no 'fileout' has been specified.} + +\item{var}{Deprecated. Use 'data' instead.} } \value{ \item{brks}{ @@ -254,7 +258,7 @@ dimensions of each of the functions have to be specified, either with the names or the indices of the corresponding input dimensions. It is possible to draw a common colour bar at any of the sides of the multi-pannel for all the s2dv plots that use a colour bar. Common plotting arguments -for all the arrays in 'var' can be specified via the '...' parameter, and +for all the arrays in 'data' can be specified via the '...' parameter, and specific plotting arguments for each array can be fully adjusted via 'special_args'. It is possible to draw titles for each of the figures, layout rows, layout columns and for the whole figure. A number of parameters @@ -268,12 +272,12 @@ nested in complex layouts. \dontrun{ ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, dat_dim = c('dat', 'member'), memb_dim = 'member') -var <- s2dv::MeanDims(ano$exp, "member") -lats <- attr(map_temp$exp, "Variables")$common$lat +data <- s2dv::MeanDims(ano$exp, "member") +lats <- attr(map_temp$exp, "dataiables")$common$lat lons <- attr(map_temp$exp, "Variables")$common$lon VizLayout(fun = VizEquiMap, plot_dims = c('lat', 'lon'), - var = var[, 1, 1, 1, , ], lon = lons, lat = lats, + data = data[, 1, 1, 1, , ], lon = lons, lat = lats, filled.continents = FALSE, toptitle = 'Near-surface temperature Nov.', titles = paste(2000:2005)) diff --git a/man/VizMatrix.Rd b/man/VizMatrix.Rd index 016603c5f6b90041ba3d91a572143b0524bc5790..49a5f0ebaa5604602a89a975de7aa4e686466cfc 100644 --- a/man/VizMatrix.Rd +++ b/man/VizMatrix.Rd @@ -5,7 +5,7 @@ \title{Function to convert any numerical table to a grid of coloured squares.} \usage{ VizMatrix( - var, + data, brks = NULL, cols = NULL, toptitle = NULL, @@ -17,18 +17,20 @@ VizMatrix( ylabels = NULL, line = 3, figure.width = 1, - legend = TRUE, + drawleg = TRUE, + legend = NULL, legend.width = 0.15, xlab_dist = NULL, ylab_dist = NULL, fileout = NULL, size_units = "px", res = 100, + var = NULL, ... ) } \arguments{ -\item{var}{A numerical matrix containing the values to be displayed in a +\item{data}{A numerical matrix containing the values to be displayed in a colored image.} \item{brks}{A vector of the color bar intervals. The length must be one more @@ -49,15 +51,15 @@ color. Set "royalblue4" as default.} \item{ytitle}{A string of title of the y-axis. Set NULL as default.} \item{xlabels}{A vector of labels of the x-axis. The length must be -length of the column of parameter 'var'. Set the sequence from 1 to the -length of the column of parameter 'var' as default.} +length of the column of parameter 'data'. Set the sequence from 1 to the +length of the column of parameter 'data' as default.} \item{xvert}{A logical value to decide whether to place x-axis labels vertically. Set FALSE as default, which keeps the labels horizontally.} \item{ylabels}{A vector of labels of the y-axis The length must be -length of the row of parameter 'var'. Set the sequence from 1 to the -length of the row of parameter 'var' as default.} +length of the row of parameter 'data'. Set the sequence from 1 to the +length of the row of parameter 'data' as default.} \item{line}{An integer specifying the distance between the title of the x-axis and the x-axis. Set 3 as default. Adjust if the x-axis labels @@ -66,17 +68,19 @@ are long.} \item{figure.width}{A positive number as a ratio adjusting the width of the grids. Set 1 as default.} -\item{legend}{A logical value to decide to draw the grid color legend or not. +\item{drawleg}{A logical value to decide to draw the grid color legend or not. Set TRUE as default.} +\item{legend}{Deprecated. Use 'drawleg' instead.} + \item{legend.width}{A number between 0 and 0.5 to adjust the legend width. Set 0.15 as default.} \item{xlab_dist}{A number specifying the distance between the x labels and -the x axis. If not specified, it equals to -1 - (nrow(var) / 10 - 1).} +the x axis. If not specified, it equals to -1 - (nrow(data) / 10 - 1).} \item{ylab_dist}{A number specifying the distance between the y labels and -the y axis. If not specified, it equals to 0.5 - ncol(var) / 10.} +the y axis. If not specified, it equals to 0.5 - ncol(data) / 10.} \item{fileout}{A string of full directory path and file name indicating where to save the plot. If not specified (default), a graphics device will pop up.} @@ -88,6 +92,8 @@ creator function of the corresponding device.} \item{res}{A positive number indicating resolution of the device (file or window) to plot in. See ?Devices and the creator function of the corresponding device.} +\item{var}{Deprecated. Use 'data' instead.} + \item{...}{The additional parameters to be passed to function ColorBarContinuous() in s2dv for color legend creation.} } @@ -102,7 +108,7 @@ colors instead of numbers. \examples{ #Example with random data \dontrun{ -esviz:::VizMatrix(var = matrix(rnorm(n = 120, mean = 0.3), 10, 12), +esviz:::VizMatrix(data = matrix(rnorm(n = 120, mean = 0.3), 10, 12), cols = c('white','#fef0d9','#fdd49e','#fdbb84','#fc8d59', '#e34a33','#b30000', '#7f0000'), brks = c(-1, 0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 1), diff --git a/man/VizPDFsOLE.Rd b/man/VizPDFsOLE.Rd index 726d06fdbef20f4b9e37f473fe5e9c801a7b8214..b790f3922f4f81a145a82f9ffbfb3ec7b6be0cd4 100644 --- a/man/VizPDFsOLE.Rd +++ b/man/VizPDFsOLE.Rd @@ -11,6 +11,7 @@ VizPDFsOLE( nsigma = 3, legendPos = "bottom", legendSize = 1, + fileout = NULL, plotfile = NULL, width = 30, height = 15, @@ -36,9 +37,11 @@ legend ("bottom", "top", "right" or "left")(Default 'bottom').} \item{legendSize}{(optional) A numeric value for setting the size of the legend text. (Default 1.0).} -\item{plotfile}{(optional) A filename where the plot will be saved. +\item{fileout}{(optional) A filename where the plot will be saved. (Default: the plot is not saved).} +\item{plotfile}{Deprecated. Use 'fileout' instead} + \item{width}{(optional) A numeric value indicating the plot width in units ("in", "cm", or "mm"). (Default width = 30).} diff --git a/man/VizRobinson.Rd b/man/VizRobinson.Rd index 48687f1fda6332c03701794280dee8e858020e40..60c9f43e50f98af67570e91cea41915822f4cb05 100644 --- a/man/VizRobinson.Rd +++ b/man/VizRobinson.Rd @@ -10,7 +10,7 @@ VizRobinson( lat, lon_dim = NULL, lat_dim = NULL, - target_proj = "ESRI:54030", + target_proj = NULL, drawleg = "bar", style = "point", dots = NULL, @@ -30,10 +30,14 @@ VizRobinson( units = NULL, crop_coastlines = NULL, point_size = "auto", - title_size = 16, - dots_size = 0.5, - dots_shape = 47, - coastlines_width = 0.3, + title_scale = 16, + title_size = NULL, + dot_size = 0.5, + dots_size = NULL, + dot_symbol = 47, + dots_shape = NULL, + coast_width = 0.3, + coastlines_width = NULL, fileout = NULL, width = 8, height = 4, @@ -62,9 +66,11 @@ of ascending or descending order.} \code{esviz:::.KnownLatNames}. The default value is NULL.} \item{target_proj}{A character string indicating the target projection. It -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.} +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. If package version 'sf' is lower than +"1.0.10" and an error appears regarding the target crs, you can try with +numeric crs (e.g. target_proj = 54030).} \item{drawleg}{A character string indicating the legend style. It can be 'bar' (color bar by \code{ColorBarContinuous()}), 'ggplot2' (discrete legend @@ -108,7 +114,7 @@ parameters to control the visual aspect of the drawn colour bar 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'.} +with parameter 'title_scale'.} \item{caption}{A character string of the caption located at left-bottom of the plot.} @@ -123,14 +129,23 @@ cannot exceed 180 degrees.} \item{point_size}{A number of the size of the data points if "style = 'point'". The default is 'auto' and the function tries to find the appropriate size.} -\item{title_size}{A number of the size of the top title. The default is 16.} +\item{title_scale}{A number of the size of the top title. The default is 16.} -\item{dots_size}{A number of the size of the dots. The default is 0.5.} +\item{title_size}{Deprecated. Use 'title_scale' instead.} -\item{dots_shape}{A number indicating the dot shape recognized by parameter +\item{dot_size}{A number of the size of the dots. The default is 0.5.} + +\item{dots_size}{Deprecated. Use 'dot_size' instead.} + +\item{dot_symbol}{A number indicating the dot shape recognized by parameter 'shape' in \code{geom_point()}.} -\item{coastlines_width}{A number indicating the width of the coastlines.} +\item{dots_shape}{Deprecated. Use 'dot_symbol' instead.} + +\item{coast_width}{A number indicating the width of the coastlines. Default is +0.3.} + +\item{coastlines_width}{Deprecated. Use 'coast_width' instead.} \item{fileout}{A character string of the path to save the plot. If not specified (default), a graphic device will pop up. The extension should be @@ -179,9 +194,9 @@ VizRobinson(data, lon = 0:359, lat = -90:90, dots = dots, 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, 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', - width = 8, height = 6) + target_proj = "+proj=moll", brks = seq(-10, 10, length.out = 11), + color_fun = ClimPalette("purpleorange"), colNA = 'green', + toptitle = 'synthetic example', caption = 'Mollweide Projection', + width = 8, height = 6) } } diff --git a/man/VizScorecard.Rd b/man/VizScorecard.Rd index 838314af41ba0c5fef7d4918f3584dbf57ce17fd..1fef634dd4b344443ccc30b2a604d177199cb95f 100644 --- a/man/VizScorecard.Rd +++ b/man/VizScorecard.Rd @@ -80,6 +80,9 @@ as NULL by default.} \item{subrow_title}{A character string for the title of the sub-row names. It is set as NULL by default.} +\item{col_title}{A character string for the title of the column names. It is +set as NULL by default.} + \item{table_title}{A character string for the title of the plot. It is set as NULL by default.} diff --git a/man/VizSection.Rd b/man/VizSection.Rd index bc2947b13342b88ec916f870f86116d16109bf06..fac59ffd9075302ec3ce48c68491eebcf9c60148 100644 --- a/man/VizSection.Rd +++ b/man/VizSection.Rd @@ -5,11 +5,12 @@ \title{Plots A Vertical Section} \usage{ VizSection( - var, + data, horiz, depth, toptitle = "", - sizetit = 1, + title_scale = 1, + sizetit = NULL, units = "", brks = NULL, cols = NULL, @@ -22,11 +23,12 @@ VizSection( height = 8, size_units = "in", res = 100, + var = NULL, ... ) } \arguments{ -\item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} +\item{data}{Matrix to plot with (longitude/latitude, depth) dimensions.} \item{horiz}{Array of longitudes or latitudes.} @@ -34,7 +36,9 @@ VizSection( \item{toptitle}{Title, optional.} -\item{sizetit}{Multiplicative factor to increase title size, optional.} +\item{title_scale}{Scale factor for the figure top title. Defaults to 1.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{units}{Units, optional.} @@ -68,6 +72,8 @@ corresponding device.} \item{res}{Resolution of the device (file or window) to plot in. See ?Devices and the creator function of the corresponding device.} +\item{var}{Deprecated. Use 'data' instead.} + \item{...}{Arguments to be passed to the method. Only accepts the following graphical parameters:\cr adj ann ask bg bty cex.lab cex.sub cin col.axis col.lab col.main col.sub diff --git a/man/VizStereoMap.Rd b/man/VizStereoMap.Rd index 0bd6fd231a2f9ce8682d731f90bd8cbb073b103d..7431bebbab17089b6dc335721d94c6e3ee543de8 100644 --- a/man/VizStereoMap.Rd +++ b/man/VizStereoMap.Rd @@ -5,7 +5,7 @@ \title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} \usage{ VizStereoMap( - var, + data = NULL, lon, lat, varu = NULL, @@ -30,7 +30,8 @@ VizStereoMap( contour_lwd = 0.5, contour_color = "black", contour_lty = 1, - contour_label_draw = TRUE, + contour_draw_label = TRUE, + contour_label_draw = NULL, contour_label_scale = 0.6, dots = NULL, dot_symbol = 4, @@ -64,11 +65,12 @@ VizStereoMap( height = 5, size_units = "in", res = 100, + var = NULL, ... ) } \arguments{ -\item{var}{Array with the values at each cell of a grid on a regular +\item{data}{Array with the values at each cell of a grid on a regular rectangular or gaussian grid. The array is expected to have two dimensions: c(latitude, longitude). Longitudes can be in ascending or descending order and latitudes in any order. It can contain NA values (coloured with @@ -77,21 +79,21 @@ accepted but 'lon' and 'lat' will be used to disambiguate so this alternative is not appropriate for square arrays.} \item{lon}{Numeric vector of longitude locations of the cell centers of the -grid of 'var', in ascending or descending order (same as 'var'). Expected +grid of 'data', in ascending or descending order (same as 'data'). Expected to be regularly spaced, within either of the ranges [-180, 180] or [0, 360]. Data for two adjacent regions split by the limits of the longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)} -('var' must be provided consitently).} +('data' must be provided consitently).} \item{lat}{Numeric vector of latitude locations of the cell centers of the -grid of 'var', in any order (same as 'var'). Expected to be from a regular +grid of 'data', in any order (same as 'data'). Expected to be from a regular rectangular or gaussian grid, within the range [-90, 90].} \item{varu}{Array of the zonal component of wind/current/other field with -the same dimensions as 'var'.} +the same dimensions as 'data'.} \item{varv}{Array of the meridional component of wind/current/other field -with the same dimensions as 'var'.} +with the same dimensions as 'data'.} \item{latlims}{Latitudinal limits of the figure.\cr Example : c(60, 90) for the North Pole\cr @@ -104,12 +106,12 @@ Example : c(60, 90) for the North Pole\cr 'toptitle'. Deprecated. Use 'title_scale' instead.} \item{units}{Title at the top of the colour bar, most commonly the units of -the variable provided in parameter 'var'.} +the variable provided in parameter 'data'.} \item{brks, cols, bar_limits, triangle_ends}{Usually only providing 'brks' is enough to generate the desired colour bar. These parameters allow to define n breaks that define n - 1 intervals to classify each of the values -in 'var'. The corresponding grid cell of a given value in 'var' will be +in 'data'. The corresponding grid cell of a given value in 'data' will be coloured in function of the interval it belongs to. These parameters are sent to \code{ColorBarContinuous()} to generate the breaks and colours. Additional colours for values beyond the limits of the colour bar are also generated @@ -117,7 +119,7 @@ and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are properly provided to do so. See ?ColorBarContinuous for a full explanation.} \item{col_inf, col_sup, colNA}{Colour identifiers to colour the values in -'var' that go beyond the extremes of the colour bar and to colour NA +'data' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes attr(cols, 'na_color') if available by default, where cols is the parameter 'cols' if provided or the vector of colors returned by 'color_fun'. If not available, it takes 'pink' by @@ -137,7 +139,7 @@ continents. Takes the value gray(0.5) by default.} \item{coast_width}{Line width of the coast line of the drawn projected continents. Takes the value 1 by default.} -\item{contours}{Array of same dimensions as 'var' to be added to the plot +\item{contours}{Array of same dimensions as 'data' to be added to the plot and displayed with contours. Parameter 'brks2' is required to define the magnitude breaks for each contour curve.} @@ -155,15 +157,17 @@ and 'brks2'.} \item{contour_lty}{Line type of the contour curves. Takes 1 (solid) by default. See help on 'lty' in par() for other accepted values.} -\item{contour_label_draw}{A logical value indicating whether to draw the +\item{contour_draw_label}{A logical value indicating whether to draw the contour labels (TRUE) or not (FALSE) when 'contours' is used. The default value is TRUE.} +\item{contour_label_draw}{Deprecated. Use 'contour_draw_label' instead.} + \item{contour_label_scale}{Scale factor for the superimposed labels when drawing contour levels. The default value is 0.6.} -\item{dots}{Array of same dimensions as 'var' or with dimensions -c(n, dim(var)), where n is the number of dot/symbol layers to add to the +\item{dots}{Array of same dimensions as 'data' or with dimensions +c(n, dim(data)), where n is the number of dot/symbol layers to add to the plot. A value of TRUE at a grid cell will draw a dot/symbol on the corresponding square of the plot. By default all layers provided in 'dots' are plotted with dots, but a symbol can be specified for each of the @@ -245,6 +249,8 @@ the corresponding device.} \item{res}{Resolution of the device (file or window) to plot in. See ?Devices and the creator function of the corresponding device.} +\item{var}{Deprecated. Use 'data' instead.} + \item{\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 @@ -283,6 +289,6 @@ compatible with figure layouts if colour bar is disabled. data <- matrix(rnorm(100 * 50), 100, 50) x <- seq(from = 0, to = 360, length.out = 100) y <- seq(from = -90, to = 90, length.out = 50) -VizStereoMap(data, x, y, latlims = c(60, 90), brks = 50, +VizStereoMap(data = data, lon = x, lat = y, latlims = c(60, 90), brks = 50, toptitle = "This is the title") } diff --git a/man/VizTriangles4Categories.Rd b/man/VizTriangles4Categories.Rd index b28c1a00f62ea8d7ce675830f7928871edee3ddb..866b0cde4503b370482f85a33a3567eef44f66f8 100644 --- a/man/VizTriangles4Categories.Rd +++ b/man/VizTriangles4Categories.Rd @@ -19,7 +19,8 @@ VizTriangles4Categories( xtitle = NULL, ylabels = NULL, ytitle = NULL, - legend = TRUE, + drawleg = TRUE, + legend = NULL, lab_legend = NULL, cex_leg = 1, col_leg = "black", @@ -73,9 +74,11 @@ length of the row of parameter 'data' as default.} \item{ytitle}{A string of title of the y-axis. Set NULL as default.} -\item{legend}{A logical value to decide to draw the color bar legend or not. +\item{drawleg}{A logical value to decide to draw the color bar legend or not. Set TRUE as default.} +\item{legend}{Deprecated. Use 'drawleg' instead.} + \item{lab_legend}{A vector of labels indicating what is represented in each category (i.e. triangle). Set the sequence from 1 to the length of the categories (2 or 4).} diff --git a/man/VizVsLTime.Rd b/man/VizVsLTime.Rd index 7ff5ad47239f4ce486a4f4196726fb95b2b28532..5b69ad2d22a17b85c1e114d31f6276d0593a4153 100644 --- a/man/VizVsLTime.Rd +++ b/man/VizVsLTime.Rd @@ -5,7 +5,7 @@ \title{Plot a score along the forecast time with its confidence interval} \usage{ VizVsLTime( - var, + data, toptitle = "", ytitle = "", monini = 1, @@ -16,20 +16,23 @@ VizVsLTime( listobs = c("obs1", "obs2", "obs3"), biglab = FALSE, hlines = NULL, - leg = TRUE, + drawleg = TRUE, + leg = NULL, siglev = FALSE, - sizetit = 1, + title_scale = 1, + sizetit = NULL, show_conf = TRUE, fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, + var = NULL, ... ) } \arguments{ -\item{var}{Matrix containing any Prediction Score with dimensions:\cr +\item{data}{Matrix containing any Prediction Score with dimensions:\cr (nexp/nmod, 3/4 ,nltime)\cr or (nexp/nmod, nobs, 3/4 ,nltime).} @@ -54,14 +57,18 @@ or (nexp/nmod, nobs, 3/4 ,nltime).} \item{hlines}{c(a,b, ..) Add horizontal black lines at Y-positions a,b, ...\cr Default = NULL.} -\item{leg}{TRUE/FALSE if legend should be added or not to the plot. +\item{drawleg}{TRUE/FALSE if legend should be added or not to the plot. Default = TRUE.} +\item{leg}{Deprecated. Use 'drawleg' instead.} + \item{siglev}{TRUE/FALSE if significance level should replace confidence interval.\cr Default = FALSE.} -\item{sizetit}{Multiplicative factor to change title size, optional.} +\item{title_scale}{Scale factor for the figure top title. Defaults to 1.} + +\item{sizetit}{Deprecated. Use 'title_scale' instead.} \item{show_conf}{TRUE/FALSE to show/not confidence intervals for input variables.} @@ -82,6 +89,8 @@ corresponding device.} \item{res}{Resolution of the device (file or window) to plot in. See ?Devices and the creator function of the corresponding device.} +\item{var}{Deprecated. Use 'data' instead.} + \item{...}{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 diff --git a/man/VizWeeklyClim.Rd b/man/VizWeeklyClim.Rd index bba00054e30ab473f7e472445cb97e7c1a2d2ed1..c97e3f037404df8f154b5b8ba501d40a1af55b55 100644 --- a/man/VizWeeklyClim.Rd +++ b/man/VizWeeklyClim.Rd @@ -13,6 +13,7 @@ VizWeeklyClim( time_dim = "time", sdate_dim = "sdate", ylim = NULL, + toptitle = NULL, title = NULL, subtitle = NULL, ytitle = NULL, @@ -66,7 +67,9 @@ The default value is 'sdate'.} Use NA to refer to the existing minimum or maximum. For more information, see 'ggplot2' documentation of 'scale_y_continuous' parameter.} -\item{title}{The text for the top title of the plot. It is NULL by default.} +\item{toptitle}{The text for the top title of the plot. It is NULL by default.} + +\item{title}{Deprecated. Use 'toptitle' instead.} \item{subtitle}{The text for the subtitle of the plot. It is NULL bu default.} @@ -113,7 +116,7 @@ data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) VizWeeklyClim(data = data, first_date = '2002-08-09', last_date = '2002-09-15', ref_period = 2010:2019, data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', - title = "Observed weekly means and climatology", + toptitle = "Observed weekly means and climatology", subtitle = "Target years: 2010 to 2019", ytitle = paste0('tas', " (", "deg.C", ")")) diff --git a/tests/testthat/test-VizEquiMap.R b/tests/testthat/test-VizEquiMap.R index 6604f5318e0b56980f530e79983a5da11d21860a..395f293bd0a4d3b27ae3911ce44cc064b5a4e9df 100644 --- a/tests/testthat/test-VizEquiMap.R +++ b/tests/testthat/test-VizEquiMap.R @@ -30,283 +30,283 @@ test_that("1. Input checks", { "Parameters 'lon' and 'lat' must be numeric vectors." ) - # Check var + # Check data expect_error( - VizEquiMap(var = NULL, lon = lons1, lat = lats1), - "Parameter 'var' cannot be NULL." + VizEquiMap(data = NULL, lon = lons1, lat = lats1), + "Parameter 'data' cannot be NULL." ) # Check varu and varv expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, varu = "test1"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, varu = "test1"), "Only one of the components 'varu' or 'varv' has been provided. Both must be provided." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, varu = "test1", varv = "test2"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, varu = "test1", varv = "test2"), "Parameter 'varu' must be a numerical array with two dimensions." ) # Check contours expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, contours = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, contours = "test"), "Parameter 'contours' must be a numerical array with two dimensions." ) # Check toptitle expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, toptitle = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, toptitle = 1), "Parameter 'toptitle' must be a character string." ) # Check caption expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, caption = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, caption = 1), "Parameter 'caption' must be a character string." ) # Check include_lower_boundary and include_upper_boundary expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, include_lower_boundary = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, include_lower_boundary = 1), "Parameter 'include_lower_boundary' must be a logical element." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, include_upper_boundary = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, include_upper_boundary = 1), "Parameter 'include_upper_boundary' must be a logical element." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, vertical = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, vertical = "test"), "Parameter 'vertical' must be TRUE or FALSE." ) # Check colNA expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, colNA = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, colNA = "test"), "Parameter 'colNA' must be a valid colour identifier." ) # Check square expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, square = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, square = "test"), "Parameter 'square' must be logical." ) # Check filled.continents expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, filled.continents = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, filled.continents = "test"), "Parameter 'filled.continents' must be logical or a colour identifier." ) # Check filled.oceans expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, filled.oceans = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, filled.oceans = "test"), "Parameter 'filled.oceans' must be logical or a colour identifier." ) # Check country.borders expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, country.borders = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, country.borders = "test"), "Parameter 'country.borders' must be logical." ) # Check coast_color expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, coast_color = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, coast_color = "test"), "Parameter 'coast_color' must be a valid colour identifier." ) # Check coast_width expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, coast_width = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, coast_width = "test"), "Parameter 'coast_width' must be numeric." ) # Check lake_color expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, lake_color = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, lake_color = "test"), "Parameter 'lake_color' must be a valid colour identifier." ) # Check shapefile expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile = list()), + VizEquiMap(data = data1, lon = lons1, lat = lats1, shapefile = list()), "The list names of the object in 'shapefile' .rds file should have at least 'x' and 'y'." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, shapefile = 1), "Parameter 'shapefile' must be a .rds file or a list." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, shapefile = "test"), "Parameter 'shapefile' is not a valid file." ) # Check shapefile_col expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile_color = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, shapefile_color = "test"), "Parameter 'shapefile_color' must be a valid colour identifier." ) # Check contour_lwd expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_lwd = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, contour_lwd = "test"), "Parameter 'contour_lwd' must be numeric." ) # Check contour_color expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_color = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, contour_color = "test"), "Parameter 'contour_color' must be a valid colour identifier." ) # Check contour_lty expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_lty = c()), + VizEquiMap(data = data1, lon = lons1, lat = lats1, contour_lty = c()), "Parameter 'contour_lty' must be either a number or a character string." ) # Check contour_draw_label expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_draw_label = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, contour_draw_label = "test"), "Parameter 'contour_draw_label' must be logical." ) # Check contour_label_scale expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_label_scale = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, contour_label_scale = "test"), "Parameter 'contour_label_scale' must be numeric." ) # Check dots expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, dots = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, dots = "test"), "Parameter 'dots' must be a logical array with two or three dimensions." ) # Check mask expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, mask = "test"), - "Parameter 'mask' must have two dimensions named as the longitude and latitude dimensions in 'var'." + VizEquiMap(data = data1, lon = lons1, lat = lats1, mask = "test"), + "Parameter 'mask' must have two dimensions named as the longitude and latitude dimensions in 'data'." ) # Check arrow parameters expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_subsamp = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_subsamp = "test"), "Parameter 'arr_subsamp' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_scale = "test"), "Parameter 'arr_scale' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_ref_len = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_ref_len = "test"), "Parameter 'arr_ref_len' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_units = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_units = 1), "Parameter 'arr_units' must be character." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale_shaft = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_scale_shaft = "test"), "Parameter 'arr_scale_shaft' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale_shaft_angle = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_scale_shaft_angle = "test"), "Parameter 'arr_scale_shaft_angle' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale_shaft_angle = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, arr_scale_shaft_angle = "test"), "Parameter 'arr_scale_shaft_angle' must be numeric." ) # Check axis parameters expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, axelab = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, axelab = "test"), "Parameter 'axelab' must be logical." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, labW = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, labW = "test"), "Parameter 'labW' must be logical." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, lab_dist_x = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, lab_dist_x = "test"), "Parameter 'lab_dist_x' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, lab_dist_y = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, lab_dist_y = "test"), "Parameter 'lab_dist_y' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, intylat = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, intylat = "test"), "Parameter 'intylat' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, intxlon = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, intxlon = "test"), "Parameter 'intxlon' must be numeric." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, xlonshft = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, xlonshft = "test"), "Parameter 'xlonshft' must be a number." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, ylatshft = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, ylatshft = "test"), "Parameter 'ylatshft' must be a number." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, xlabels = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, xlabels = 1), "Parameter 'xlabels' must be a vector of character string." ) expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, ylabels = 1), + VizEquiMap(data = data1, lon = lons1, lat = lats1, ylabels = 1), "Parameter 'ylabels' must be a vector of character string." ) # Check legend parameters expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, drawleg = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, drawleg = "test"), "Parameter 'drawleg' must be logical." ) # Check margin_scale expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, margin_scale = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, margin_scale = "test"), "Parameter 'margin_scale' must be a numeric vector of length 4." ) # Check title_scale expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, title_scale = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, title_scale = "test"), "Parameter 'title_scale' must be numeric." ) # Check caption_size expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, caption_size = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, caption_size = "test"), "Parameter 'caption_size' must be numeric." ) # Check axes_tick_scale expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, axes_tick_scale = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, axes_tick_scale = "test"), "Parameter 'axes_tick_scale' must be numeric." ) # Check axes_label_scale expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, axes_label_scale = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, axes_label_scale = "test"), "Parameter 'axes_label_scale' must be numeric." ) # Check numbfig expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, numbfig = "test"), + VizEquiMap(data = data1, lon = lons1, lat = lats1, numbfig = "test"), "Parameter 'numbfig' must be numeric." ) # Check hatching_mask expect_error( - VizEquiMap(var = data1, lon = lons1, lat = lats1, hatching_mask = "test"), - "Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'var'." + VizEquiMap(data = data1, lon = lons1, lat = lats1, hatching_mask = "test"), + "Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'data'." ) }) @@ -325,7 +325,7 @@ save_fun <- function(...) { test_that("2. Output checks", { expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F)), name = 'VizEquiMap_1a.png' @@ -333,21 +333,21 @@ test_that("2. Output checks", { # check include_lower_boundary and include_upper_boundary expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), include_lower_boundary = FALSE), name = 'VizEquiMap_1b.png' ) expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), include_upper_boundary = FALSE), name = 'VizEquiMap_1c.png' ) expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), include_lower_boundary = FALSE, include_upper_boundary = FALSE), @@ -356,7 +356,7 @@ test_that("2. Output checks", { # check triangle_ends expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(1, 9), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(T, T), col_inf = "lightblue", col_sup = "lightblue"), @@ -365,7 +365,7 @@ test_that("2. Output checks", { # check filled.continents expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = T, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = T, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F)), name = 'VizEquiMap_filled.continents.png' @@ -374,7 +374,7 @@ test_that("2. Output checks", { # check mask mask <- array(rep(c(rep(0, 60), rep(1, 60)), 10), dim = c(lat = 30, lon = 44)) expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), mask = mask), @@ -383,7 +383,7 @@ test_that("2. Output checks", { # check title_scale expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), title_scale = 0.5), @@ -392,7 +392,7 @@ test_that("2. Output checks", { # check bar_label_scale expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), bar_label_scale = 0.5), @@ -401,7 +401,7 @@ test_that("2. Output checks", { # check margin_scale expect_snapshot_file( - save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + save_fun(data = data1, lon = lons1, lat = lats1, filled.continents = F, bar_limits = c(0, 10), toptitle = "plot 1", cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), margin_scale = rep(10, 4)), diff --git a/tests/testthat/test-VizForecastPDF.R b/tests/testthat/test-VizForecastPDF.R index 5857f5784e0217574f8bb33185fe17c4399fa6fe..8f5bc3240bd875c49630cc1543db782952a2eb4b 100644 --- a/tests/testthat/test-VizForecastPDF.R +++ b/tests/testthat/test-VizForecastPDF.R @@ -35,7 +35,7 @@ fcsts <- data.frame(fcst1 = rnorm(10), fcst2 = rnorm(10, 0.5, 1.2)) save_fun <- function(...) { path <- tempfile(fileext = ".png") - do.call(VizForecastPDF, list(..., plotfile = path)) + do.call(VizForecastPDF, list(..., fileout = path)) path } diff --git a/tests/testthat/test-VizPDFsOLE.R b/tests/testthat/test-VizPDFsOLE.R index 19e3af2c284e6f3da543e7a3a42d9c3f6702ddf3..03da292b5b014e412e94baa74eafe1eb6636ba70 100644 --- a/tests/testthat/test-VizPDFsOLE.R +++ b/tests/testthat/test-VizPDFsOLE.R @@ -8,61 +8,61 @@ test_that("Sanity checks", { attr(pdf_2, "name") <- "NAO2" dim(pdf_2) <- c(statistic = 2) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = "plot.png", width = 30, height = 15, units = "cm", dpi = '300') , "Parameter 'dpi' must be numeric.") - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = "plot.png", width = 30, height = 15, units = 20, dpi = 300) , "Parameter 'units' must be character") - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = "plot.png", width = 30, height = 15, units = "dm", dpi = 300) , "Parameter 'units' must be equal to 'in', 'cm' or 'mm'.") - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = "plot.png", width = 30, height = '15', units = "cm", dpi = 300) , "Parameter 'height' must be numeric.") - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = "plot.png", + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = "plot.png", width = list(30), height = 15, units = "cm", dpi = 300) , "Parameter 'width' must be numeric.") - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = 0, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = 0, width = 30, height = 15, units = "cm", dpi = 300) , - paste0("Parameter 'plotfile' must be a character string ", + paste0("Parameter 'fileout' must be a character string ", "indicating the path and name of output png file.")) - expect_error(VizPDFsOLE(pdf_1, pdf_2, legendPos = 1, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, legendPos = 1, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'legendPos' must be character") expect_error(VizPDFsOLE(pdf_1, pdf_2, legendPos = 'arriba', - plotfile = "plot.png", + fileout = "plot.png", width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'legendPos' must be equal to 'bottom', 'top', 'right' or 'left'.") - expect_error(VizPDFsOLE(pdf_1, pdf_2, legendSize = '3', plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, legendSize = '3', fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'legendSize' must be numeric.") - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = '3', plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = '3', fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'nsigma' must be numeric.") pdf_1 <- list(1.1,0.6) attr(pdf_1, "name") <- "NAO1" - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'pdf_1' must be an array.") @@ -70,7 +70,7 @@ test_that("Sanity checks", { pdf_1 <- c('1.1','0.6') attr(pdf_1, "name") <- "NAO1" dim(pdf_1) <- c(statistic = 2) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'pdf_1' must be a numeric array.") @@ -78,7 +78,7 @@ test_that("Sanity checks", { pdf_1 <- c(1.1,0.6) attr(pdf_1, "name") <- "NAO1" dim(pdf_1) <- c(2) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , paste0("Parameters 'pdf_1' and 'pdf_2' ", @@ -87,7 +87,7 @@ test_that("Sanity checks", { pdf_1 <- c(1.1,0.6) attr(pdf_1, "name") <- "NAO1" dim(pdf_1) <- c(statisti = 2) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'pdf_1' must have dimension 'statistic'.") @@ -95,7 +95,7 @@ test_that("Sanity checks", { pdf_1 <- c(1.1,0.6) attr(pdf_1, "name") <- "NAO1" dim(pdf_1) <- c(statistic = 2, model = 1) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , "Parameter 'pdf_1' must have only dimension 'statistic'.") @@ -103,7 +103,7 @@ test_that("Sanity checks", { pdf_1 <- c(1.1, 0.6, 0.2) attr(pdf_1, "name") <- "NAO1" dim(pdf_1) <- c(statistic = 3) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , paste0("Length of dimension 'statistic'", @@ -112,7 +112,7 @@ test_that("Sanity checks", { pdf_1 <- c(1.1, 0.6) attr(pdf_1, "name") <- 12 dim(pdf_1) <- c(statistic = 2) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , paste0("The 'name' attribute of parameter 'pdf_1' must be a character ", @@ -125,7 +125,7 @@ test_that("Sanity checks", { attr(pdf_2, "name") <- 12 dim(pdf_2) <- c(statistic = 2) - expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, plotfile = NULL, + expect_error(VizPDFsOLE(pdf_1, pdf_2, nsigma = 3, fileout = NULL, width = 30, height = 15, units = "cm", dpi = 300) , paste0("The 'name' attribute of parameter 'pdf_2' must be a character ", diff --git a/tests/testthat/test-VizRobinson.R b/tests/testthat/test-VizRobinson.R index fd2463e9a5af7c1dcd8a438f3b96cbbe250ac4dc..6e8aedaf30020c89f7d3da59afcb87a028ff624b 100644 --- a/tests/testthat/test-VizRobinson.R +++ b/tests/testthat/test-VizRobinson.R @@ -89,7 +89,7 @@ test_that("1. Input checks", { # point_size expect_error( VizRobinson(data1, lon = lon1_1, lat = lat1, point_size = 'small'), - "Parameter 'point_size' must be a number." + "Parameter 'point_size' must be a numerical value." ) }) @@ -126,7 +126,7 @@ test_that("3. data2: Europe", { expect_snapshot_file( save_VizRobinson(data2, lon = lon2, lat = lat2, dots = dots2, target_proj = 102014, brks = seq(-10, 0, 2), cols = c("#FDD49E", "#FDBB84", "#FC8D59", "#E34A33", "#B30000"), col_inf = "#FEF0D9", - toptitle = 'VizRobinson', caption = 'unit test: 1a\n projection: Lambert Europe (ESRI:102014)', point_size = 1.1, title_size = 12, + toptitle = 'VizRobinson', caption = 'unit test: 1a\n projection: Lambert Europe (ESRI:102014)', point_size = 1.1, title_scale = 12, width = 6, vertical = F, bar_extra_margin = c(0.5, 4, 0.5, 4), crop_coastlines = c(latmin = 27, latmax = 70, lonmin = -20, lonmax = 40)), name = 'VizRobinson_2a.png' ) @@ -136,7 +136,7 @@ test_that("3. data2: Europe", { # expect_snapshot_file( # save_VizRobinson(data2, lon = lon2, lat = lat2, dots = dots2, target_proj = 102014, # brks = seq(-10, 0, 2), cols = c("#FDD49E", "#FDBB84", "#FC8D59", "#E34A33", "#B30000"), col_inf = "#FEF0D9", - # toptitle = 'VizRobinson', caption = 'unit test: 1a\n projection: Lambert Europe (ESRI:102014)', point_size = 1.1, title_size = 12, + # toptitle = 'VizRobinson', caption = 'unit test: 1a\n projection: Lambert Europe (ESRI:102014)', point_size = 1.1, title_scale = 12, # width = 6, vertical = F, bar_extra_margin = c(0.5, 4, 0.5, 4), crop_coastlines = c(latmin = 27, latmax = 70, lonmin = -20, lonmax = 40), style = 'polygon'), # name = 'VizRobinson_2b.png' # ) diff --git a/tests/testthat/test-VizWeeklyClim.R b/tests/testthat/test-VizWeeklyClim.R index 2edbdb0528396700dc0d5f33b80efc14fb73913b..fe8a030c8d360108951840e3b3601d579b3501f6 100644 --- a/tests/testthat/test-VizWeeklyClim.R +++ b/tests/testthat/test-VizWeeklyClim.R @@ -152,7 +152,7 @@ test_that("2. Output", { save_fun(data = data, first_date = '2002-08-09', last_date = '2002-09-15', ref_period = 2010:2019, data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', - title = "Observed weekly means and climatology", + toptitle = "Observed weekly means and climatology", subtitle = "Target years: 2010 to 2019", ytitle = paste0('tas', " (", "deg.C", ")")), name = 'VizWeeklyClim_1a.png' diff --git a/vignettes/map_proj_equi.Rmd b/vignettes/map_proj_equi.Rmd index 9bef2227a4338dba758a9207d4f68a8556c20d12..4d8ba193b9f8658ed94a30012c3d7b90c2be3c79 100644 --- a/vignettes/map_proj_equi.Rmd +++ b/vignettes/map_proj_equi.Rmd @@ -18,7 +18,7 @@ In this vignette, we will go through the functions that plot the maps with equid `VizEquiMap()`, `VizAnimateMap()`, `VizLayout()`. Some traits of these plotting functions: - - Expect a data matrix in the parameter `var` of dimensions + - Expect a data matrix in the parameter `data` of dimensions `c(n. of latitudes, n. of longitudes)`, `lat` with a vector with the latitudes of the centers of the grid cells and `lon`, a vector with the longitudes. - The N colors to paint the grid cells with (via `cols`) as well as the N + @@ -201,7 +201,7 @@ In the following example, we plot the ensemble-mean climatology at each forecast ```r VizLayout(fun = VizEquiMap, plot_dims = c('lat', 'lon'), - var = exp_clim, lon = lons, lat = lats, + data = exp_clim, lon = lons, lat = lats, units = 'K', title_scale = 0.8, toptitle = "SEAS5 tas climatology (1997-2016)", titles = paste0("ftime ", seq_len(dim(exp_clim)[1]), ": ", @@ -235,12 +235,12 @@ args <- list( units = 'K', units_scale = 2), list(), list(), list(monini = 11, freq = 12, ytitle = "K/year", limits = c(-0.02, 0.1), - listexp = c('SEAS5', 'Meteo-France System 7'), sizetit = 0.5, leg = F) + listexp = c('SEAS5', 'Meteo-France System 7'), title_scale = 0.5, leg = F) ) VizLayout(fun = c('VizEquiMap', 'plot', 'plot', 'VizVsLTime'), plot_dims = list(c('lat', 'lon'), 1, 1, 1:3), - var = list(exp_clim, array(1:10), array(10:1), input_trend), + data = list(exp_clim, array(1:10), array(10:1), input_trend), special_args = args, drawleg = 'E', brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup, triangle_ends = c(T, T), diff --git a/vignettes/map_proj_robinson.Rmd b/vignettes/map_proj_robinson.Rmd index 6db8f219d065b86c33e8436dc4a2b9ebc878dc0c..a63b997ce02fd83664fa02727b6d2fe67bbaa23c 100644 --- a/vignettes/map_proj_robinson.Rmd +++ b/vignettes/map_proj_robinson.Rmd @@ -61,7 +61,7 @@ The plot style can be either "point" or "polygen", which is more time-consuming. ```r VizRobinson(rmsss$rmsss[1, , ], lon = lons, lat = lats, target_proj = "ESRI:54030", - dots = !rmsss$sign[1, , ], dots_size = 0.7, + dots = !rmsss$sign[1, , ], dot_size = 0.7, brks = brks, cols = cols, col_inf = col_inf, style = 'point', drawleg = 'bar', toptitle = "RMSSS SEAS5-ERA5 monthly tas anomaly Nov 2011-2016", diff --git a/vignettes/map_proj_stereo.Rmd b/vignettes/map_proj_stereo.Rmd index 66d5a3a7bfbfc42a336480d5762410a563bdd48e..d654e56ffdb7a0bb606e364ed364b9d6cf5cfa3e 100644 --- a/vignettes/map_proj_stereo.Rmd +++ b/vignettes/map_proj_stereo.Rmd @@ -123,7 +123,7 @@ VizAnimateMap(exp1_clim, equi = FALSE, filled.continents = FALSE, monini = 11, toptitle = "SEAS5 tas climatology (Nov. 2011-2016), North Pole", brks = brks, cols = cols, col_sup = col_sup, triangle_ends = c(F, T), - units = "K", sizetit = 0.5, + units = "K", title_scale = 0.5, fileout = 'map_stereo_anim_clim_exp1_np.gif') ``` @@ -143,7 +143,7 @@ VizRobinson(exp1_clim[1, lats_np_ind, ], target_proj = 3995, legend = 's2dv', style = 'polygon', toptitle = "SEAS5 tas climatology (Nov. 2011-2016), ftime = 1, North Pole", caption = paste0("plotted by esviz::VizRobinson"), - units = "K", title_size = 14, + units = "K", title_scale = 14, width = 8, height = 8, fileout = "map_stereo_clim_exp1_np_robin.png") ``` diff --git a/vignettes/multimodel_skill_assessment.Rmd b/vignettes/multimodel_skill_assessment.Rmd index e0b16e070937dcee78b2f2be11223eb8d6b04cb6..fa0e0c0a8b161f924326b26bfb61d3e40199d707 100644 --- a/vignettes/multimodel_skill_assessment.Rmd +++ b/vignettes/multimodel_skill_assessment.Rmd @@ -195,7 +195,7 @@ To obtain a spatial plot with a scale from -1 to 1 value of correlation for the ```r VizCombinedMap(AnomDJF$data$corr[,1,1,,], lon = Lon, lat = Lat, map_select_fun = max, display_range = c(0, 1), map_dim = 'nexp', - legend_scale = 0.5, brks = 11, + bar_label_scale = 0.5, brks = 11, cols = list(c('white', 'black'), c('white', 'darkblue'), c('white', 'darkred'), @@ -225,7 +225,7 @@ The following lines are necessary to obtain the plot which visualizes the best m ```r VizCombinedMap(AnomDJF$data$rms[,1,1,,], lon = Lon, lat = Lat, map_select_fun = min, display_range = c(0, ceiling(max(abs(AnomDJF$data$rms)))), map_dim = 'nexp', - legend_scale = 0.5, brks = 11, + bar_label_scale = 0.5, brks = 11, cols = list(c('black', 'white'), c('darkblue', 'white'), c('darkred', 'white'), @@ -253,7 +253,7 @@ VizCombinedMap(AnomDJF$data$rmsss[,1,1,,], lon = Lon, lat = Lat, map_select_fun = function(x) {x[which.min(abs(x - 1))]}, display_range = c(0, ceiling(max(abs(AnomDJF$data$rmsss)))), map_dim = 'nexp', - legend_scale = 0.5, brks = 11, + bar_label_scale = 0.5, brks = 11, cols = list(c('white', 'black'), c('white', 'darkblue'), c('white', 'darkred'), diff --git a/vignettes/time_series.Rmd b/vignettes/time_series.Rmd index e6d6a0c9b6a00bf1c418e4058c61835d4ff49868..9ec0b8440624ba325b0ac2e84181f147415c993a 100644 --- a/vignettes/time_series.Rmd +++ b/vignettes/time_series.Rmd @@ -35,7 +35,7 @@ parameter `freq`. file name of which you have to provide to the `fileout` parameter. Can plot in a presentation oriented style or in a paper oriented style, adjustable with the parameter `biglab`. - - Can plot a legend automatically, adjustable via the parameters `leg`, + - Can plot a legend automatically, adjustable via the parameters `drawleg`, `listexp` and `listobs`/`listvar` in `VizVsLTime()`, `Viz2VarVsLtime()` and `VizClim()` or via the parameter `legends` in `VizAno()` and `VizACC()`. - Accept any additional parameters via the parameter `...` to be sent to @@ -213,8 +213,8 @@ input_reg[1, 4, ] <- reg_ano$regression[1, ] VizVsLTime(input_reg, toptitle = "Regression of System5c3s and Meteo-France System 7, Europe", - ytitle = "K/year", sizetit = 0.7, - monini = 11, freq = 1, leg = FALSE, + ytitle = "K/year", title_scale = 0.7, + monini = 11, freq = 1, drawleg = FALSE, fileout = 'ts_regression_exp1_exp2.png') ``` @@ -237,7 +237,7 @@ names(spr_stats) <- names(spread) for (i_plot in seq_len(length(spread))) { inputs <- list(spread[[i_plot]], toptitle = paste0(spr_stats[i_plot], " across members and start dates, Europe"), - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, listexp = c('SEAS5', 'Meteo-France System 7'), fileout = paste0('ts_', names(spr_stats)[i_plot], '_exp1_exp2.png')) @@ -271,7 +271,7 @@ input_cor[, 4, ] <- corr_ano$p.val[, 1, ] VizVsLTime(input_cor, toptitle = "Time correlation with ERA5, over Europe", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, listexp = c('SEAS5', 'Meteo-France System 7'), fileout = 'ts_corr_exp1_exp2_obs.png') @@ -290,7 +290,7 @@ input_rms[, 3, ] <- rms_ano$conf.upper[, 1, ] VizVsLTime(input_rms, toptitle = "RMSE against ERA5, over Europe", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, listexp = c('SEAS5', 'Meteo-France System 7'), fileout = 'ts_rms_exp1_exp2_obs.png') @@ -308,7 +308,7 @@ input_rmsss[, 1, 4, ] <- rmsss$p.val VizVsLTime(input_rmsss, toptitle = "RMSSS against ERA5 , Europe", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, siglev = TRUE, listexp = c('SEAS5', 'Meteo-France System 7'), fileout = 'ts_rmsss_exp1_exp2_obs.png') @@ -332,8 +332,8 @@ input_ratio_rms[1, 4, ] <- ratio_rms$p.val VizVsLTime(input_ratio_rms, toptitle = "RMSE Ratio of SEAS5 and Meteo-France System 7 against ERA5, Europe", - ytitle = "K", sizetit = 0.6, - monini = 11, freq = 1, siglev = TRUE, leg = FALSE, + ytitle = "K", title_scale = 0.6, + monini = 11, freq = 1, siglev = TRUE, drawleg = FALSE, fileout = 'ts_ratiorms_exp1_exp2_obs.png') ``` @@ -354,7 +354,7 @@ input_ratio_sdrms[, 1, 4, ] <- ratio_sdrms$p.val VizVsLTime(input_ratio_sdrms, toptitle = "S. dev. over members and s. dates / RMSE, Europe", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, siglev = TRUE, listexp = c('SEAS5', 'Meteo-France System 7'), fileout = 'ts_ratiosdrms_exp1_exp2_obs.png') @@ -382,7 +382,7 @@ input_ratio_sdrms[1, , 4, ] <- ratio_sdrms$p.val VizVsLTime(input_ratio_sdrms, toptitle = "S. dev. over members and s. dates / RMSE, Europe", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, siglev = TRUE, listexp = c('SEAS5'), listobs = c('ERA5', 'ERA5 with random turbulance'), @@ -403,7 +403,7 @@ input_eno[, 2, ] <- eno VizVsLTime(input_eno, toptitle = "Effective n. of independent data, Europe", - sizetit = 0.7, + title_scale = 0.7, monini = 11, freq = 1, siglev = FALSE, show_conf = FALSE, listexp = c('SEAS5', 'Meteo-France System 7'), fileout = 'ts_eno_exp1_exp2.png') @@ -428,7 +428,7 @@ We put correlation and RMS from the previous sections in one plot. ```r Viz2VarsVsLTime(input_cor[, 1:3, ], input_rms, toptitle = "Time correlation and RMSE with ERA5, Europe", - ytitle = "K", sizetit = 0.7, + ytitle = "K", title_scale = 0.7, monini = 11, freq = 1, limits = c(-0.8, 2.2), listexp = c('SEAS5', 'Meteo-France System 7'), listvars = c('Corr', 'RMSE'), @@ -480,7 +480,7 @@ input_acc[, , , , 4] <- acc$p.val VizACC(input_acc, sdates, toptitle = "Spatial anomaly corr. coeff. with ERA5 over Europe", - ytitle = "K", sizetit = 0.7, freq = 1, limits = c(-0.8, 1.6), + ytitle = "K", title_scale = 0.7, freq = 1, limits = c(-0.8, 1.6), legends = c('SEAS5', 'Meteo-France System 7'), fileout = 'ts_acc_exp1_exp2_obs.png') ```