diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000000000000000000000000000000000000..b2e3b6cb9cdc70223e06e13f2e5f32275cd2cf38 --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,13 @@ +stages: + - build +build: + stage: build + script: + - module load R/4.1.2-foss-2015a-bare + - module load CDO/1.9.8-foss-2015a + - module load GEOS/3.7.2-foss-2015a-Python-3.7.3 + - module load GDAL/2.2.1-foss-2015a + - module load PROJ/4.8.0-foss-2015a + - R CMD build --resave-data . + - R CMD check --as-cran --no-manual --run-donttest esviz_*.tar.gz + - R -e 'covr::package_coverage()' diff --git a/DESCRIPTION b/DESCRIPTION index ddef70fefe6b088eaa5d0b6865155245e618ce5f..88e38bd4b91c0bd1a7ec3722747fbcb07964a827 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,14 @@ -Package: ClimPlot -Title: Plotting functions for Climate Science and Services +Package: esviz +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: ClimPlot is an R plotting package for climate science and services. +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 integrated functinalities. + but with more consistent and integrated functinalities. Depends: R (>= 3.6.0) Imports: @@ -21,14 +21,26 @@ Imports: sf, ggplot2, rnaturalearth, - cowplot + cowplot, + s2dv, + multiApply, + RColorBrewer, + CSTools, + easyNCDF, + dplyr, + plyr, + data.table, + reshape2, + scales, + stats, + utils Suggests: testthat License: GPL-3 -URL: https://earth.bsc.es/gitlab/es/climplot/ -BugReports: https://earth.bsc.es/gitlab/es/climplot/-/issues +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.0 Config/testthat/edition: 3 - +LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 1d3bbc605477bd6f3f8c72e3f3599052cd4f30f1..94b5cc225c0c97514df8daf6e4fe7c04769c688e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,29 +5,46 @@ export(ClimPalette) export(ColorBarContinuous) export(ColorBarDiscrete) export(PlotCombinedMap) -export(PlotEquiMap) export(PlotForecastPDF) export(PlotMostLikelyQuantileMap) export(PlotPDFsOLE) -export(PlotRobinson) export(PlotTriangles4Categories) export(PlotWeeklyClim) export(ShapeToMask) +export(Viz2VarsVsLTime) +export(VizACC) +export(VizAnimateMap) +export(VizAno) +export(VizBoxWhisker) +export(VizClim) +export(VizEquiMap) +export(VizLayout) +export(VizMatrix) +export(VizRobinson) +export(VizSection) +export(VizStereoMap) +export(VizVsLTime) import(RColorBrewer) import(cowplot) import(easyNCDF) import(ggplot2) import(graphics) +import(mapproj) import(maps) import(multiApply) import(rnaturalearth) import(sf) +import(stats) +import(utils) importFrom(CSTools,SplitDim) importFrom(ClimProjDiags,Subset) importFrom(RColorBrewer,brewer.pal) importFrom(data.table,CJ) importFrom(data.table,data.table) importFrom(data.table,setkey) +importFrom(dplyr,group_by) +importFrom(dplyr,mutate) +importFrom(dplyr,summarise) importFrom(grDevices,adjustcolor) importFrom(grDevices,bmp) importFrom(grDevices,col2rgb) @@ -41,6 +58,7 @@ importFrom(grDevices,jpeg) importFrom(grDevices,pdf) importFrom(grDevices,png) importFrom(grDevices,postscript) +importFrom(grDevices,rainbow) importFrom(grDevices,rgb) importFrom(grDevices,svg) importFrom(grDevices,tiff) @@ -62,5 +80,8 @@ importFrom(plyr,dlply) importFrom(reshape2,melt) importFrom(s2dv,InsertDim) importFrom(s2dv,MeanDims) +importFrom(s2dv,Reorder) importFrom(scales,date_format) importFrom(stats,cor) +importFrom(stats,median) +importFrom(stats,ts) diff --git a/R/ClimPalette.R b/R/ClimPalette.R index 844282d819cd3a3307b82d6a2d9d123a78f39819..4b943f486d178446517a73a94a51043eb1370950 100644 --- a/R/ClimPalette.R +++ b/R/ClimPalette.R @@ -22,10 +22,10 @@ #'@examples #'lims <- seq(-1, 1, length.out = 21) #' -#'ColorBar(lims, color_fun = climPalette('redyellow')) +#'cb <- ColorBarContinuous(lims, color_fun = ClimPalette('redyellow'), plot = FALSE) #' #'cols <- ClimColors(20) -#'ColorBar(lims, cols) +#'cb <- ColorBarContinuous(lims, cols, plot = FALSE) #' #'@importFrom grDevices colorRampPalette #'@export diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index b3c74df949e7a930b9b74afe211b3b47054b8990..cf6c51cf7a30fdffce3b820a8b815c98d2d3baec 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -138,8 +138,10 @@ #'cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", #' "white", "yellow", "orange", "red", "saddlebrown") #'lims <- seq(-1, 1, 0.2) -#'ColorBarContinuous(lims, cols) +#'cb <- ColorBarContinuous(lims, cols, plot = FALSE) +#' #'@importFrom grDevices col2rgb rgb +#'@import utils #'@export ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, bar_limits = NULL, var_limits = NULL, diff --git a/R/ColorBarDiscrete.R b/R/ColorBarDiscrete.R index 0aa1b8b4a49fc2f55b8dde9e53a7414923f92e4d..0f4d85405854522d7006841d221ae0983f6ef3f2 100644 --- a/R/ColorBarDiscrete.R +++ b/R/ColorBarDiscrete.R @@ -68,6 +68,8 @@ #'@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 #' the colour bar. The number of provided decimals will be conserved. #' Disregarded if 'plot = FALSE'. @@ -104,11 +106,12 @@ #'} #' #'@examples -#'ColorBarDiscrete( +#'cb <- ColorBarDiscrete( #' brks = 0:4, cols = c("green1", "green2", "green3", "green4"), -#' vertical = F, labels = paste0('lev ', 1:4), label_scale = 1.5, -#' extra_margin = c(0.5, 2, 0.5, 2)) +#' vertical = FALSE, labels = paste0('lev ', 1:4), label_scale = 1.5, +#' extra_margin = c(0.5, 2, 0.5, 2), plot = FALSE) #' +#'@import utils #'@importFrom grDevices col2rgb rgb #'@export ColorBarDiscrete <- function(brks = NULL, cols = NULL, vertical = TRUE, diff --git a/R/PlotCombinedMap.R b/R/PlotCombinedMap.R index 871a9c838a7fccd68f513f7a6b6a9022c7a60ef3..53161852c631d6e0557adff75d486c6af7482f41 100644 --- a/R/PlotCombinedMap.R +++ b/R/PlotCombinedMap.R @@ -27,14 +27,23 @@ #'@param map_dim Optional name for the dimension of 'maps' along which the #' multiple maps are arranged. Only applies when 'maps' is provided as a #' 3-dimensional array. Takes the value 'map' by default. -#'@param brks Colour levels to be sent to PlotEquiMap. This parameter is +#'@param brks Colour levels to be sent to VizEquiMap. This parameter is #' optional and adjusted automatically by the function. -#'@param cols List of vectors of colours to be sent to PlotEquiMap for the +#'@param cols List of vectors of colours to be sent to VizEquiMap for the #' colour bar of each map. This parameter is optional and adjusted #' automatically by the function (up to 5 maps). The colours provided for each #' colour bar will be automatically interpolated to match the number of breaks. #' Each item in this list can be named, and the name will be used as title for #' the corresponding colour bar (equivalent to the parameter 'bar_titles'). +#'@param bar_limits A numeric vector of 2 indicating the range of color bar. +#' The default is NULL, and the function will decide the range automatically. +#'@param triangle_ends A logical vector of two indicating if the lower and upper +#' triangles of the color bar should be plotted. The default is +#' c(FALSE, FALSE). +#'@param col_inf A character string of recognized color name or code indicating +#' the color of the lower triangle of the color bar. The default is NULL. +#'@param col_sup A character string of recognized color name or code indicating +#' the color of the upper triangle of the color bar. The default is NULL. #'@param col_unknown_map Colour to use to paint the grid cells for which a map #' is not possible to be chosen according to 'map_select_fun' or for those #' values that go beyond 'display_range'. Takes the value 'white' by default. @@ -59,7 +68,10 @@ #'@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 -#' PlotEquiMap. +#' VizEquiMap. +#'@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 @@ -84,7 +96,7 @@ #' arguments for GradientCatsColorBar() or ColorBarContinuous() will be #' returned. It is convenient for users to adjust the color bars manually. The #' default is FALSE, the color bars will be plotted directly. -#'@param ... Additional parameters to be passed on to \code{PlotEquiMap}. +#'@param ... Additional parameters to be passed on to \code{VizEquiMap}. #' #'@examples #'# Simple example @@ -115,8 +127,9 @@ #' width = 14, height = 10) #'} #' -#'@seealso \code{PlotCombinedMap} and \code{PlotEquiMap} -#' +#'@seealso \code{PlotCombinedMap} and \code{VizEquiMap} +#' +#'@import utils #'@importFrom maps map #'@importFrom graphics box image layout mtext par plot.new #'@importFrom grDevices adjustcolor bmp colorRampPalette dev.cur dev.new dev.off @@ -126,7 +139,8 @@ PlotCombinedMap <- function(maps, lon, lat, map_select_fun, display_range, map_dim = 'map', brks = NULL, cols = NULL, - bar_limits = NULL, triangle_ends = c(F, F), col_inf = NULL, col_sup = NULL, + bar_limits = NULL, triangle_ends = c(FALSE, FALSE), + col_inf = NULL, col_sup = NULL, col_unknown_map = 'white', mask = NULL, col_mask = 'grey', dots = NULL, @@ -315,7 +329,7 @@ PlotCombinedMap <- function(maps, lon, lat, #---------------------- #TODO: Consider col_inf if (!is.null(colorbar$col_inf[[1]])) { - .warning("Lower triangle is not supported now. Please contact maintainer if you have this need.") + warning("Lower triangle is not supported now. Please contact maintainer if you have this need.") } if (!is.null(colorbar$col_sup[[1]])) { @@ -426,7 +440,7 @@ PlotCombinedMap <- function(maps, lon, lat, } #---------------------- - # Set colors and breaks and then PlotEquiMap + # Set colors and breaks and then VizEquiMap #---------------------- if (!is.null(colorbar$col_sup[[1]])) { tcols <- c(col_unknown_map, colorbar$cols[[1]], colorbar$col_sup[[1]]) @@ -448,7 +462,7 @@ PlotCombinedMap <- function(maps, lon, lat, plot_margin <- c(5, 4, 4, 2) + 0.1 # default of par()$mar } - PlotEquiMap(var = ml_map, lon = lon, lat = lat, + VizEquiMap(var = ml_map, lon = lon, lat = lat, brks = tbrks, cols = tcols, drawleg = FALSE, filled.continents = FALSE, dots = dots, margin_scale = plot_margin, ...) @@ -520,7 +534,7 @@ PlotCombinedMap <- function(maps, lon, lat, plot = TRUE, draw_separators = TRUE, bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, extra_margin = bar_extra_margin) - .warning("The device is not off yet. Use dev.off() after plotting the color bars.") + warning("The device is not off yet. Use dev.off() after plotting the color bars.") return(tmp) #NOTE: The device is not off! Can keep plotting the color bars. } diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index 80ab857fce647a5cab93f8add3960c60638e31fa..77e26e43f2c8b5019f0de03174f6685a4a609fdf 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -47,7 +47,7 @@ #'@examples #'fcsts <- data.frame(fcst1 = rnorm(10), fcst2 = rnorm(10, 0.5, 1.2)) #'PlotForecastPDF(fcsts,c(-1,1)) -#'@import ggplot2 +#'@import ggplot2 stats #'@importFrom data.table data.table CJ setkey #'@importFrom reshape2 melt #'@importFrom plyr . dlply diff --git a/R/PlotPDFsOLE.R b/R/PlotPDFsOLE.R index bf95abb76c745410447d0cdf59c22f34b2509231..a8b55bb871e92f4d1e06bc901d1a999134051d02 100644 --- a/R/PlotPDFsOLE.R +++ b/R/PlotPDFsOLE.R @@ -41,7 +41,7 @@ #'dim(pdf_2) <- c(statistic = 2) #' #'PlotPDFsOLE(pdf_1, pdf_2) -#'@import ggplot2 +#'@import ggplot2 stats #'@export PlotPDFsOLE <- function(pdf_1, pdf_2, nsigma = 3, legendPos = 'bottom', legendSize = 1.0, plotfile = NULL, width = 30, diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index bc1c0e2f4da6917321e6ca8f8e82697a376cfb29..5ca8e38dc4b1d8c9bd6fcfcf46c82779f4a01d93 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -70,9 +70,7 @@ #' subtitle = "Target years: 2010 to 2019", #' ytitle = paste0('tas', " (", "deg.C", ")")) #' -#'@import multiApply -#'@import ggplot2 -#'@import RColorBrewer +#'@import multiApply ggplot2 RColorBrewer stats #'@importFrom scales date_format #'@importFrom ClimProjDiags Subset #'@importFrom s2dv MeanDims @@ -313,4 +311,4 @@ PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, ggsave(filename = fileout, plot = p, device = device, height = height, width = width, units = units, dpi = dpi) } -} \ No newline at end of file +} diff --git a/R/Utils.R b/R/Utils.R index b4874d06a4f56382f2bc020ff455bdc524d74a46..a4840af02e1d3ee0e1048189189cee6054464f85 100644 --- a/R/Utils.R +++ b/R/Utils.R @@ -105,6 +105,7 @@ #Draws Color Bars for Categories #A wrapper of ColorBarContinuous to generate multiple color bars for different #categories, and each category has different color set. +#'@import utils GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, bar_limits, var_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, plot = TRUE, diff --git a/R/Viz2VarsVsLTime.R b/R/Viz2VarsVsLTime.R new file mode 100644 index 0000000000000000000000000000000000000000..9a61df6a4dd569405826494d3b2cfff7b5df325f --- /dev/null +++ b/R/Viz2VarsVsLTime.R @@ -0,0 +1,245 @@ +#'Plot two scores with confidence intervals in a common plot +#' +#'Plot two input variables that have the same dimensions in a common plot. +#'One plot for all experiments. +#'The input variables should have dimensions (nexp/nmod, nltime). +#' +#'@param var1 Matrix of dimensions (nexp/nmod, nltime). +#'@param var2 Matrix of dimensions (nexp/nmod, nltime). +#'@param toptitle Main title, optional. +#'@param ytitle Title of Y-axis, optional. +#'@param monini Starting month between 1 and 12. Default = 1. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12. +#'@param nticks Number of ticks and labels on the x-axis, optional. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@param listexp List of experiment names, up to three, optional. +#'@param listvars List of names of input variables, optional. +#'@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. +#' Default = TRUE. +#'@param siglev TRUE/FALSE if significance level should replace confidence +#' interval.\cr +#' Default = FALSE. +#'@param sizetit Multiplicative factor to change title size, optional. +#'@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, +#' pdf, bmp and tiff. The default value is NULL. +#'@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 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 ... 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 +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@examples +#'clim <- s2dv::Clim(ts_temp$exp, ts_temp$obs, time_dim = "sdate", +#' dat_dim = c("dat", "member")) +#'ano_exp <- Ano(ts_temp$exp, clim$clim_exp) +#'ano_obs <- Ano(ts_temp$obs, clim$clim_obs) +#'corr_ano <- s2dv::Corr(s2dv::MeanDims(ano_exp, 'member'), ano_obs, +#' time_dim = 'sdate', dat_dim = 'dat') +#'input_cor <- array(dim = c(dat = 1, 3, time = 5)) +#'input_cor[, 1, ] <- corr_ano$conf.lower[, 1, 1, ] +#'input_cor[, 2, ] <- corr_ano$corr[, 1, 1, ] +#'input_cor[, 3, ] <- corr_ano$conf.upper[, 1, 1, ] +#' +#'rms_ano <- s2dv::RMS(s2dv::MeanDims(ano_exp, 'member'), ano_obs, +#' time_dim = 'sdate', dat_dim = 'dat') +#' +#'input_rms <- array(dim = c(dat = 1, 3, time = 5)) +#'input_rms[, 1, ] <- rms_ano$conf.lower[, 1, 1, ] +#'input_rms[, 2, ] <- rms_ano$rms[, 1, 1, ] +#'input_rms[, 3, ] <- rms_ano$conf.upper[, 1, 1, ] +#'Viz2VarsVsLTime(input_cor, input_rms, +#' toptitle = "Time correlation and RMSE with ERA5", +#' ytitle = "K", sizetit = 0.7, +#' monini = 11, freq = 1, limits = c(-1, 5), +#' listexp = c('SEAS5'), listvars = c('Corr', 'RMSE'), +#' fileout = NULL) +#' +#'@importFrom grDevices png jpeg postscript pdf svg bmp tiff postscript dev.cur dev.new dev.off +#'@importFrom stats ts +#'@export +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, ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + nvars <- 2 + + if (length(dim(var1)) != length(dim(var2))) { + print("the two input variables should have the same dimensions") + stop() + } + if (length(dim(var1)) >= 4) { + print("dimensions of input variables should be 3") + stop() + } + nleadtime <- dim(var1)[3] + nexp <- dim(var1)[1] + var <- array(dim = c(nvars, nexp, 3, nleadtime)) + for (jvar in 1:nvars) { + varname <- paste("var", as.character(jvar), sep = "") + var[jvar, , , ] <- get(varname) + rm(varname) + } + + if (is.null(limits) == TRUE) { + ll <- min(var1, na.rm = TRUE) + ul <- max(var1, na.rm = TRUE) + if (biglab) { + ul <- ul + 0.4 * (ul - ll) + } else { + ul <- ul + 0.3 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + empty_ts <- ts(start = c(0000, (monini - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + empty <- array(dim = length(empty_ts)) + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (is.null(nticks)) { + if (biglab) { + nticks <- 5 + } else { + nticks <- 10 + } + } + labind <- seq(1, nleadtime, max(nleadtime %/% nticks, 1)) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + labmonth <- months[((labind - 1) * 12 / freq + monini - 1) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, nchar(y2o3dig) + - 1, nchar(y2o3dig)), sep = "") + } + color <- c("red1", "dodgerblue1", "green1", "orange1", "lightblue1", + "deeppink1", "mediumpurple1", "lightgoldenrod1", "olivedrab1", + "mediumorchid1") + type <- c(1, 3) + if (siglev == TRUE) { + lines <- c("n", "l", "n") + } + else{ + lines <- c("l", "l", "l") + } + thickness <- array(dim = c(3)) + thickness[1] <- c(1) + thickness[2] <- c(8) + thickness[3] <- thickness[1] + + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1.25, 1.4, 0.5, 1), mgp = c(4, 2.5, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(3, 1.8, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, + main = toptitle, cex.main = cexmain * sizetit, axes = FALSE) + axis(1, at = labind, labels = labmonth) + axis(2) + box() + if (is.null(hlines) != TRUE) { + for (jy in 1:length(hlines)) { + par(new = TRUE) + abline(h = hlines[jy]) + } + } + # + # Loop on experimental data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + legendnames <- array(dim = nexp * nvars) + legendthick <- array(dim = nexp * nvars) + legendsty <- array(dim = nexp * nvars) + legendcol <- array(dim = nexp * nvars) + if (show_conf == TRUE) { + start_line <- 3 + end_line <- 1 + } else { + start_line <- 2 + end_line <- 2 + } + for (jint in seq(start_line, end_line, -1)) { + ind <- 1 + for (jexp in 1:nexp) { + for (jvar in 1:nvars) { + par(new = TRUE) + plot(var[jvar, jexp, jint, ], type = lines[jint], ylim = c(ll, ul), + col = color[jexp], lty = type[jvar], lwd = thickness[jint], + ylab = "", xlab = "", axes = FALSE) + legendnames[ind] <- paste(listexp[jexp], listvars[jvar]) + legendthick[ind] <- 2 + legendsty[ind] <- type[jvar] + legendcol[ind] <- color[jexp] + ind <- ind + 1 + } + } + } + if (leg) { + legend(1, ul, legendnames, lty = legendsty, lwd = legendthick, + col = legendcol, cex = legsize) + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/R/VizACC.R b/R/VizACC.R new file mode 100644 index 0000000000000000000000000000000000000000..a70a980a60babd5846285a417d101711124c0937 --- /dev/null +++ b/R/VizACC.R @@ -0,0 +1,229 @@ +#'Plot Plumes/Timeseries Of Anomaly Correlation Coefficients +#' +#'Plots plumes/timeseries of ACC from an array with dimensions +#'(output from \code{ACC()}): \cr +#'c(nexp, nobs, nsdates, nltime, 4)\cr +#'where the fourth dimension is of length 4 and contains the lower limit of +#'the 95\% confidence interval, the ACC, the upper limit of the 95\% +#'confidence interval and the 95\% significance level given by a one-sided +#'T-test. +#' +#'@param ACC An ACC array with with dimensions:\cr +#' c(nexp, nobs, nsdates, nltime, 4)\cr +#' with the fourth dimension of length 4 containing the lower limit of the +#' 95\% confidence interval, the ACC, the upper limit of the 95\% confidence +#' 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 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 +#' Y-axis, optional. +#'@param legends A character vector of flags to be written in the legend, +#' optional. +#'@param freq A integer: 1 = yearly, 12 = monthly, 4 = seasonal, ... Default: 12. +#'@param biglab A logical value for presentation/paper plot, Default = FALSE. +#'@param fill A logical value if filled confidence interval. Default = FALSE. +#'@param linezero A logical value if a line at y=0 should be added. Default = FALSE. +#'@param points A logical value if points instead of lines. Default = TRUE.\cr +#' Must be TRUE if only 1 leadtime. +#'@param vlines A vector of x location where to add vertical black lines, optional. +#'@param fileout A character string of the output file name. Extensions allowed: +#' eps/ps, jpeg, png, pdf, bmp and tiff. Default is NULL. +#'@param width A numeric of the file width, in the units specified in the +#' parameter size_units (inches by default). Takes 8 by default. +#'@param height A numeric of the file height, in the units specified in the parameter +#' size_units (inches by default). Takes 5 by default. +#'@param size_units A character string of the 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 \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 +#' csi cxy err family fg fig fin font font.axis font.lab font.main font.sub +#' lend lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page +#' plt smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog\cr +#' For more information about the parameters see `par`. +#' +#'@examples +#'ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, +#' dat_dim = c('dat', 'member'), memb_dim = 'member') +#'lats <- attr(map_temp$exp, "Variables")$common$lat +#'lons <- attr(map_temp$exp, "Variables")$common$lon +#'acc <- s2dv::ACC(ano$exp, ano$obs, lat = lats, lon = lons, +#' dat_dim = 'dat', memb_dim = 'member') +#'input_acc <- array(dim = c(dim(acc$acc)[c('nexp', 'nobs', 'sdate', 'time')], 4)) +#'input_acc[, , , , 1] <- acc$conf.lower +#'input_acc[, , , , 2] <- acc$acc +#'input_acc[, , , , 3] <- acc$conf.upper +#'input_acc[, , , , 4] <- acc$p.val +#'sdates <- paste0(2000:2005, '1101') +#'VizACC(input_acc, sdates, +#' toptitle = "Spatial anomaly corr. coeff. with ERA5", +#' ytitle = "K", sizetit = 0.7, freq = 12, +#' legends = 'SEAS5', fileout = NULL) +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@export +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, ...) { + # 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", + "lwd", "mai", "mgp", "new", "pch", "pin", "ps", "pty") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + if (length(dim(ACC)) != 5 | dim(ACC)[5] != 4) { + stop("5 dim needed : c(nexp, nobs, nsdates, nltime, 4)") + } + nexp <- dim(ACC)[1] + nobs <- dim(ACC)[2] + nleadtime <- dim(ACC)[4] + nsdates <- dim(ACC)[3] + if (is.null(limits) == TRUE) { + ll <- min(ACC, na.rm = TRUE) + ul <- max(ACC, na.rm = TRUE) + if (biglab) { + ul <- ul + 0.3 * (ul - ll) + } else { + ul <- ul + 0.2 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + yearinit <- as.integer(substr(sdates[1], 1, 4)) + moninit <- as.integer(substr(sdates[1], 5, 6)) + lastyear <- as.integer(substr(sdates[nsdates], 1, 4)) + (moninit + ( + nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (moninit + (nleadtime - 1) * (12 / freq) - 1) %% 12 + 1 + empty_ts <- ts(start = c(yearinit, (moninit - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + color <- c("red4", "dodgerblue4", "lightgoldenrod4", "deeppink4", + "mediumpurple4", "green4", "orange4", "lightblue4", "mediumorchid4", + "olivedrab4") + colorblock <- c("red1", "dodgerblue1", "lightgoldenrod1", "deeppink1", + "mediumpurple1", "green1", "orange1", "lightblue1", + "mediumorchid1", "olivedrab1") + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(2.8, 0.9, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(0.8, 0.8, 0.5, 0.1), mgp = c(2, 0.5, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty_ts, ylim = c(ll, ul), xlab = "Time (years)", ylab = ytitle, + main = toptitle, cex.main = cexmain * sizetit) + for (jexp in 1:nexp) { + for (jobs in 1:nobs) { + numcol <- jobs + (jexp - 1) * nobs + for (jdate in 1:nsdates) { + year0 <- as.integer(substr(sdates[jdate], 1, 4)) + mon0 <- as.integer(substr(sdates[jdate], 5, 6)) + start <- (year0 - yearinit) * freq + 1 + end <- start + nleadtime - 1 + var <- array(dim = c(3, length(empty_ts))) + var[, start:end] <- t(ACC[jexp, jobs, jdate, , 1:3]) + if (fill) { + par(new = TRUE) + bordup <- ACC[jexp, jobs, jdate, , 3] + borddown <- ACC[jexp, jobs, jdate, , 1] + tmp <- c(start:end) + xout <- is.na(bordup + borddown) + tmp <- tmp[which(xout == FALSE)] + xx <- c(tmp, rev(tmp)) + bordup <- bordup[which(xout == FALSE)] + borddown <- borddown[which(xout == FALSE)] + yy <- c(bordup, rev(borddown)) + if (jdate == 1) { + matplot(t(var), type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + } + polygon(xx, yy, col = colorblock[numcol], border = NA) + } + if (points) { + par(new = TRUE) + plot(var[2, ], type = "p", lty = 1, lwd = 6, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE, + cex = 0.6) + par(new = TRUE) + plot(var[1, ], type = "p", pch = 6, lwd = 3, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE, + cex = 0.6) + par(new = TRUE) + plot(var[3, ], type = "p", pch = 2, lwd = 3, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE, + cex = 0.6) + par(new = TRUE) + for (jind in start:end) { + lines(c(jind, jind), var[c(1, 3), jind], lwd = 1, + ylim = c(ll, ul), col = color[numcol], xlab = "", + ylab = "", axes = FALSE) + } + } else { + par(new = TRUE) + plot(var[2, ], type = "l", lty = 1, lwd = 4, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + par(new = TRUE) + plot(var[1, ], type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + par(new = TRUE) + plot(var[3, ], type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[numcol], xlab = "", ylab = "", axes = FALSE) + } + } + } + } + if (linezero) { + abline(h = 0, col = "black") + } + if (is.null(vlines) == FALSE) { + for (x in vlines) { + abline(v = x, col = "black") + } + } + if (is.null(legends) == FALSE) { + if (points) { + legend(0, ul, legends[1:(nobs * nexp)], lty = 3, lwd = 10, + col = color[1:(nobs * nexp)], cex = legsize) + } else { + legend(0, ul, legends[1:(nobs * nexp)], lty = 1, lwd = 4, + col = color[1:(nobs * nexp)], cex = legsize) + } + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/R/VizAnimateMap.R b/R/VizAnimateMap.R new file mode 100644 index 0000000000000000000000000000000000000000..7efab6f538fffc939f18a691f7ef6b2735d1789f --- /dev/null +++ b/R/VizAnimateMap.R @@ -0,0 +1,242 @@ +#'Animate Maps of Forecast/Observed Values or Scores Over Forecast Time +#' +#'Create animations of maps in an equi-rectangular or stereographic +#'projection, showing the anomalies, the climatologies, the mean InterQuartile +#'Range, Maximum-Mininum, Standard Deviation, Median Absolute Deviation, +#'the trends, the RMSE, the correlation or the RMSSS, between modelled and +#'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 +#' (nexp/nmod, nltime, nlat, nlon) or (nexp/nmod, 3/4, nltime, nlat, nlon) or +#' (nexp/nmod, nobs, 3/4, nltime, nlat, nlon). +#'@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 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). +#'@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 +#' Greenwich and equi = TRUE. Filling unavailable if square = FALSE and +#' equi = TRUE. +#'@param lonmin Westward limit of the domain to plot (> 0 or < 0). +#' Default : 0 degrees. +#'@param lonmax Eastward limit of the domain to plot (> 0 or < 0). +#' lonmax > lonmin. Default : 360 degrees. +#'@param latmin Southward limit of the domain to plot. Default : -90 degrees. +#'@param latmax Northward limit of the domain to plot. Default : 90 degrees. +#'@param intlat Interval between latitude ticks on y-axis for equi = TRUE or +#' between latitude circles for equi = FALSE. Default = 30 degrees. +#'@param intlon Interval between longitude ticks on x-axis. +#' Default = 20 degrees. +#'@param drawleg Draw a colorbar. Can be FALSE only if square = FALSE or +#' equi = FALSE. Default = TRUE. +#'@param subsampleg Supsampling factor of the interval between ticks on +#' colorbar. Default = 1 = every colour level. +#'@param colNA Color used to represent NA. Default = 'white'. +#'@param equi TRUE/FALSE == cylindrical equidistant/stereographic projection. +#' Default: TRUE. +#'@param fileout c('', '', \dots) array of output file name for each animation. +#' If RMS, RMSSS, correlations : first exp with successive obs, then second +#' exp with successive obs, etc ... +#'@param ... 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 +#' cin col.axis col.lab col.main col.sub cra crt csi cxy err family fg fig +#' font font.axis font.lab font.main font.sub las lheight ljoin lmitre lty +#' lwd mai mar mex mfcol mfrow mfg mgp mkh oma omd omi page pch plt pty smo +#' srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog. \cr +#' For more information about the parameters see `par`. +#' +#'@details +#'Examples of input: +#'\enumerate{ +#' \item{ +#' Outputs from clim (exp, obs, memb = FALSE): +#' (nmod, nltime, nlat, nlon) +#' or (nobs, nltime, nlat, nlon) +#' } +#' \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): +#' (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. +#' } +#' \item{ +#' model and observed output from load/ano/smoothing: +#' (nmod, nmemb, sdate, nltime, nlat, nlon) +#' & (nobs, nmemb, sdate, nltime, nlat, nlon) +#' then averaged along members mean1dim(var_exp/var_obs, posdim = 2): +#' (nmod, sdate, nltime, nlat, nlon) +#' (nobs, sdate, nltime, nlat, nlon) +#' then passed through corr(exp, obs, posloop = 1, poscor = 2) +#' or RMS(exp, obs, posloop = 1, posRMS = 2): +#' (nmod, nobs, 3, nltime, nlat, nlon) +#' animates correlations or RMS between each exp & each obs against leadtime. +#' } +#'} +#' +#'@examples +#'clim <- s2dv::Clim(map_temp$exp, map_temp$obs, memb = FALSE, +#' dat_dim = c('dat', 'member'), memb_dim = 'member') +#'lats <- attr(map_temp$exp, "Variables")$common$lat +#'lons <- attr(map_temp$exp, "Variables")$common$lon +#'VizAnimateMap(clim$clim_exp[1, 1, , , ], lon = lons, lat = lats, +#' toptitle = "climatology of decadal prediction", sizetit = 1, +#' units = "K", brks = seq(270, 300, 3), monini = 11, freq = 12, +#' msk95lev = FALSE, filled.continents = FALSE, intlon = 10, intlat = 10, +#' fileout = 'clim_animation.gif') +#' +#'@importFrom grDevices postscript dev.off +#' @importFrom s2dv InsertDim +#'@export +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"), ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + ## fileout content with extension for consistency between + ## functions keeping only filename without extension + ext <- regmatches(fileout, regexpr("\\.[a-zA-Z0-9]*$", fileout)) + if ((length(ext) != 0) && any(ext != ".gif")) { + warning("some or all extensions of the filenames provided in 'fileout' are not 'gif'. The extensions are being converted to 'gif'.") + } + fileout <- sub("\\.[a-zA-Z0-9]*$", "", fileout) + + # + + # Check var + if (!is.numeric(var) || !is.array(var)) { + stop("Parameter 'var' 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(var)) == 3) { + var <- InsertDim(var, posdim = 1, lendim = 1, name = 'new') + } + if (length(dim(var)) == 4) { + var <- InsertDim(var, posdim = 2, lendim = 3, name = 'new') + } + if (length(dim(var)) == 5) { + var <- InsertDim(var, posdim = 2, lendim = 1, name = 'new') + } + + nleadtime <- dim(var)[4] + nexp <- dim(var)[1] + nobs <- dim(var)[2] + nlat <- dim(var)[5] + nlon <- dim(var)[6] + if (length(lon) != nlon | length(lat) != nlat) { + stop("Inconsistent var 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) + if (is.null(cols) == TRUE) { + cols <- colorbar(10) + } + nlev <- length(cols) + brks <- signif(seq(ll, ul, (ul - ll)/nlev), 4) + } else { + if (is.null(cols) == TRUE) { + nlev <- length(brks) - 1 + cols <- colorbar(nlev) + } else { + nlev <- length(cols) + } + } + lon[which(lon < lonmin)] <- lon[which(lon < lonmin)] + 360 + lon[which(lon > lonmax)] <- lon[which(lon > lonmax)] - 360 + latb <- sort(lat[which(lat >= latmin & lat <= latmax)], index.return = TRUE) + lonb <- sort(lon[which(lon >= lonmin & lon <= lonmax)], index.return = TRUE) + + # Define some plot parameters ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + labind <- 1:nleadtime + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", + "Aug", "Sep", "Oct", "Nov", "Dec") + years <- ((labind - 1) * 12/freq + monini - 1)%/%12 + suffixtit <- months[((labind - 1) * 12/freq + monini - 1)%%12 + + 1] + for (jx in 1:nleadtime) { + y2o3dig <- paste("0", as.character(years[jx]), sep = "") + suffixtit[jx] <- paste(suffixtit[jx], "-", substr(y2o3dig, + nchar(y2o3dig) - 1, nchar(y2o3dig)), sep = "") + } + + # Loop on experimental & observational data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + for (jexp in 1:nexp) { + for (jobs in 1:nobs) { + postscript(paste(fileout[(jexp - 1) * nobs + jobs], + ".png", sep = ""), width = 550, height = 300, + bg = "white") + # Load the user parameters + par(userArgs) + for (jt in 1:nleadtime) { + title <- paste(toptitle[(jexp - 1) * nobs + jobs], + " Time=", suffixtit[jt], sep = "") + varbis <- var[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, + lonb$ix] > 0)] <- TRUE + flag[which(var[jexp, jobs, 1, jt, latb$ix, + lonb$ix] < 0 & var[jexp, jobs, 3, jt, latb$ix, + lonb$ix] < 0)] <- TRUE + } + varbis[which(varbis <= min(brks))] <- min(brks) + + (max(brks) - min(brks))/1000 + varbis[which(varbis >= max(brks))] <- max(brks) - + (max(brks) - min(brks))/1000 + if (equi) { + VizEquiMap(t(varbis), lonb$x, latb$x, toptitle = title, + sizetit = sizetit, 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, sizetit = sizetit, + units = units, filled.continents = filled.continents, + dots = t(flag), brks = brks, cols = cols, + intlat = intlat, drawleg = drawleg, subsampleg = subsampleg, + colNA = colNA, ...) + } + } + dev.off() + system(paste("convert -rotate 90 -loop 10 -delay 50 ", + fileout[(jexp - 1) * nobs + jobs], ".png ", fileout[(jexp - + 1) * nobs + jobs], ".gif", sep = "")) + file.remove(paste0(fileout[(jexp - 1) * nobs + jobs], + ".png")) + } + } +} diff --git a/R/VizAno.R b/R/VizAno.R new file mode 100644 index 0000000000000000000000000000000000000000..86d6c33a848fdad567ed8e262443aaa25efc9a0a --- /dev/null +++ b/R/VizAno.R @@ -0,0 +1,296 @@ +#'Plot Anomaly or Raw time series +#' +#'Plots time series of raw or smoothed anomalies of any variable output from +#'\code{Load()} or \code{Ano()} or or \code{Ano_CrossValid()} or +#'\code{Smoothing()}. +#' +#'@param exp_ano A numerical array containing the experimental data:\cr +#' c(nmod/nexp, nmemb/nparam, nsdates, nltime). +#'@param obs_ano A numerical array containing the observational data:\cr +#' c(nobs, nmemb, nsdates, nltime) +#'@param sdates A character vector of start dates in the format of +#' c('YYYYMMDD','YYYYMMDD'). +#'@param toptitle Main title for each experiment: c('',''), optional. +#'@param ytitle Title of Y-axis for each experiment: c('',''), optional. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@param legends List of observational dataset names, optional. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default: 12. +#'@param biglab TRUE/FALSE for presentation/paper plot. Default = FALSE. +#'@param fill TRUE/FALSE if the spread between members should be filled. +#' Default = TRUE. +#'@param memb TRUE/FALSE if all members/only the ensemble-mean should be +#' plotted.\cr +#' Default = TRUE. +#'@param ensmean TRUE/FALSE if the ensemble-mean should be plotted. +#' Default = TRUE. +#'@param linezero TRUE/FALSE if a line at y=0 should be added. +#' Default = FALSE. +#'@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 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 +#' one and it will be extended to the rest. The default value is NULL, which +#' the pop-up window shows. +#'@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 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 \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 +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page plt smo +#' srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@examples +#'dim(ts_temp$exp) <- c(dat = 1, member = 3, sdate = 6, time = 5) +#'dim(ts_temp$obs) <- c(dat = 1, member = 1, sdate = 6, time = 5) +#'sdates <- paste0(2000:2005, '1101') +#'VizAno(ts_temp$exp, ts_temp$obs, sdates, +#' toptitle = "Raw 'tas'", ytitle = 'K', legends = 'ERA5', biglab = FALSE) +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@importFrom s2dv MeanDims +#'@export +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, ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + # Get some arguments + # ~~~~~~~~~~~~~~~~~~~~ + # + if (length(dim(exp_ano)) != 4 ) { + stop("4 dim needed : c(nexp/nobs, nmemb, nsdates, nltime)") + } + nexp <- dim(exp_ano)[1] + nmemb <- dim(exp_ano)[2] + nleadtime <- dim(exp_ano)[4] + nsdates <- dim(exp_ano)[3] + if (is.null(obs_ano) == FALSE) { + nobs <- dim(obs_ano)[1] + if (length(dim(obs_ano)) != 4 ) { + stop("4 dim needed : c(nexp/nobs, nmemb, nsdates, nltime)") + } + if (dim(obs_ano)[3] != nsdates | dim(obs_ano)[4] != nleadtime ) { + stop("obs and exp must have same number of sdates & ltimes") + } + } else { + nobs <- 0 + } + # sdate check + if (!all(nchar(sdates) == 8)) { + stop ("The parameter 'sdates' must be formatted as YYYYMMDD.") + } + + if (is.null(limits) == TRUE) { + if (memb) { + ll <- min(min(exp_ano, na.rm = TRUE), min(obs_ano, na.rm = TRUE), na.rm = TRUE) + ul <- max(max(exp_ano, na.rm = TRUE), max(obs_ano, na.rm = TRUE), na.rm = TRUE) + } + else{ + ll <- min(min(MeanDims(exp_ano, 2), na.rm = TRUE), min(obs_ano, na.rm = TRUE), + na.rm = TRUE) + ul <- max(max(MeanDims(exp_ano, 2), na.rm = TRUE), max(obs_ano, na.rm = TRUE), + na.rm = TRUE) + } + if (nobs > 0) { + if (biglab) { + ul <- ul + 0.3 * (ul - ll) + } else { + ul <- ul + 0.2 * (ul - ll) + } + } + } else { + ll <- limits[1] + ul <- limits[2] + } + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + yearinit <- as.integer(substr(sdates[1], 1, 4)) + moninit <- as.integer(substr(sdates[1], 5, 6)) + lastyear <- as.integer(substr(sdates[nsdates], 1, 4)) + (moninit + ( + nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (moninit + (nleadtime - 1) * (12 / freq) - 1) %% 12 + 1 + empty_ts <- ts(start = c(yearinit, (moninit - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + color <- c("red4", "orange4", "lightgoldenrod4", "olivedrab4", "green4", + "lightblue4", "dodgerblue4", "mediumpurple4", "mediumorchid4", + "deeppink4") + color <- c(color, color, color, color, color, color, color, color, color, + color, color) + colorblock <- c("red1", "orange1", "lightgoldenrod1", "olivedrab1", "green1", + "lightblue1", "dodgerblue1", "mediumpurple1", "mediumorchid1", + "deeppink1") + colorblock <- c(colorblock, colorblock, colorblock, colorblock, colorblock, + colorblock, colorblock, colorblock, colorblock, colorblock) + type <- c(1, 3, 2, 4) + thickness <- c(1, 3, 2, 2) + # + # Loop on the experiments : one plot for each + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + for (jexp in 1:nexp) { + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout[jexp]) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(2.8, 0.9, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(0.8, 0.8, 0.5, 0.3), mgp = c(2, 0.5, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty_ts, ylim = c(ll, ul), xlab = "Time (years)", ylab = ytitle[jexp], + main = toptitle[jexp], cex.main = cexmain * sizetit) + # + # Plot experimental data + all observational datasets sdate by sdate + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + for (jdate in 1:nsdates) { + year0 <- as.integer(substr(sdates[jdate], 1, 4)) + mon0 <- as.integer(substr(sdates[jdate], 5, 6)) + start <- (year0 - yearinit) * freq + 1 + end <- start + nleadtime - 1 + var <- array(dim = c(nmemb, length(empty_ts))) + var[, start:end] <- exp_ano[jexp, , jdate, ] + # + # Compute parameters for filling max-min over members + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (fill) { + par(new = TRUE) + bordup <- array(dim = nleadtime) + borddown <- array(dim = nleadtime) + for (jt in 1:nleadtime) { + bordup[jt] <- max(exp_ano[jexp, , jdate, jt], na.rm = TRUE) + borddown[jt] <- min(exp_ano[jexp, , jdate, jt], na.rm = TRUE) + } + tmp <- c(start:end) + xout <- is.na(bordup + borddown) + tmp <- tmp[which(xout == FALSE)] + xx <- c(tmp, rev(tmp)) + bordup <- bordup[which(xout == FALSE)] + borddown <- borddown[which(xout == FALSE)] + yy <- c(bordup, rev(borddown)) + # + # Plotting + # ~~~~~~~~~~ + # + if (jdate == 1) { + matplot(t(var), type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[jdate], xlab = "", ylab = "", axes = FALSE) + } + # Max-min member range + polygon(xx, yy, col = colorblock[jdate], border = NA) + } + if (ensmean) { # Ensemble-mean + par(new = TRUE) + if (points) { + plot(MeanDims(t(var), 2), type = "p", lty = 1, lwd = 4, + ylim = c(ll, ul), col = color[jdate], xlab = "", ylab = "", + axes = FALSE) + } else { + plot(MeanDims(t(var), 2), type = "l", lty = 1, lwd = 4, + ylim = c(ll, ul), col = color[jdate], xlab = "", ylab = "", + axes = FALSE) + } + } + if (memb) { + par(new = TRUE) # All members + if (points) { + matpoints(t(var), type = "p", lty = 1, lwd = 1, pch = 20, + ylim = c(ll, ul), col = color[jdate], xlab = "", ylab = "", + axes = FALSE) + } else { + matplot(t(var), type = "l", lty = 1, lwd = 1, ylim = c(ll, ul), + col = color[jdate], xlab = "", ylab = "", axes = FALSE) + } + } + if (nobs > 0) { + for (jobs in 1:nobs) { + for (jmemb in 1:dim(obs_ano)[2]) { + var <- array(dim = length(empty_ts)) + var[start:end] <- obs_ano[jobs, jmemb, jdate, ] + par(new = TRUE) # Observational datasets + if (points) { + plot(var, type = "p", lty = 1, lwd = 4, pch = 20, + ylim = c(ll, ul), col = 1, ylab = "", xlab = "", + axes = FALSE) + } else { + plot(var, lty = type[jobs], lwd = thickness[jobs], type = "l", + ylim = c(ll, ul), col = 1, ylab = "", xlab = "", + axes = FALSE) + } + } + } + } + } + if (linezero) { + abline(h = 0, col = "black") + } + if (is.null(vlines) == FALSE) { + for (x in vlines) { + abline(v = x, col = "black") + } + } + if (is.null(legends) == FALSE) { + if (points) { + legend('topleft', legends[1:nobs], lty = 3, lwd = 10, col = 1, + cex = legsize) + } else { + legend('topleft', ul, legends[1:nobs], lty = type[1:nobs], + lwd = thickness[1:nobs], col = 1, cex = legsize) + } + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() + } +} diff --git a/R/VizBoxWhisker.R b/R/VizBoxWhisker.R new file mode 100644 index 0000000000000000000000000000000000000000..09dd252a03f2c7076b386805194b4d5bafcb578a --- /dev/null +++ b/R/VizBoxWhisker.R @@ -0,0 +1,204 @@ +#'Box-And-Whisker Plot of Time Series with Ensemble Distribution +#' +#'Produce time series of box-and-whisker plot showing the distribution of the +#'members of a forecast vs. the observed evolution. The correlation between +#'forecast and observational data is calculated and displayed. Only works for +#'n-monthly to n-yearly time series. +#' +#'@param exp Forecast array of multi-member time series, e.g., the NAO index +#' of one experiment. The expected dimensions are +#' c(members, start dates/forecast horizons). A vector with only the time +#' dimension can also be provided. Only monthly or lower frequency time +#' series are supported. See parameter freq. +#'@param obs Observational vector or array of time series, e.g., the NAO index +#' of the observations that correspond the forecast data in \code{exp}. +#' The expected dimensions are c(start dates/forecast horizons) or +#' c(1, start dates/forecast horizons). Only monthly or lower frequency time +#' series are supported. See parameter freq. +#'@param toptitle Character string to be drawn as figure title. +#'@param ytitle Character string to be drawn as y-axis title. +#'@param monini Number of the month of the first time step, from 1 to 12. +#'@param yearini Year of the first time step. +#'@param freq Frequency of the provided time series: 1 = yearly, 12 = monthly, +# 4 = seasonal, ... Default = 12. +#'@param expname Experimental dataset name. +#'@param obsname Name of the observational reference dataset. +#'@param drawleg TRUE/FALSE: whether to draw the legend or not. +#'@param fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, +#' pdf, bmp and tiff. \cr +#' Default = 'output_PlotBox.ps'. +#'@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 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 ... Arguments to be passed to the method. Only accepts the following +#' graphical parameters:\cr +#' ann ask bg cex.lab cex.sub cin col.axis col.lab col.main col.sub cra crt +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mex mfcol mfrow mfg mkh oma omd omi page pin plt pty +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@return Generates a file at the path specified via \code{fileout}. +#' +#'@seealso EOF, ProjectField, NAO +#'@examples +#'# No example data is available over NAO region, so in this example we will +#'# tweak the longitude and latitude. +#'ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, +#' dat_dim = c('dat', 'member'), memb_dim = 'member') +#'nao <- s2dv::NAO(ano$exp, ano$obs, lat = seq(20, 80, length.out = 11), +#' lon = seq(-80, 40, length.out = 16), memb_dim = "member", +#' ftime_dim = "time") +#'nao$exp <- drop(aperm(nao$exp, c(2, 1, 3, 4))) +#'nao$obs <- drop(nao$obs) +#'VizBoxWhisker(nao$exp, nao$obs, toptitle = "NAO index", +#' ytitle = "NAO index (PC1) TOS", monini = 11, freq = 1, +#' yearini = 2000, expname = "SEAS5", obsname = "ERA5") +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats cor +#'@export +VizBoxWhisker <- function(exp, obs, toptitle = '', ytitle = '', monini = 1, + yearini = 0, freq = 1, expname = "exp 1", + obsname = "obs 1", drawleg = 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("adj", "bty", "cex", "cex.axis", "cex.main", "col", "din", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "pch", "ps") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # Checking exp + if (is.numeric(exp)) { + if (is.null(dim(exp)) || length(dim(exp)) == 1) { + dim(exp) <- c(1, length(exp)) + } + } + if (!is.numeric(exp) || length(dim(exp)) != 2) { + stop("Parameter 'exp' must be a numeric vector or array of dimensions c(forecast horizons/start dates) or c(ensemble members, forecast horizons/start dates)") + } + + # Checking obs + if (is.numeric(obs)) { + if (is.null(dim(obs)) || length(dim(obs)) == 1) { + dim(obs) <- c(1, length(obs)) + } + } + if (!is.numeric(obs) || length(dim(obs)) != 2) { + stop("Parameter 'obs' must be a numeric vector or array of dimensions c(forecast horizons/start dates) or c(1, forecast horizons/start dates)") + } + + # Checking consistency in exp and obs + if (dim(exp)[2] != dim(obs)[2]) { + stop("'exp' and 'obs' must have data for the same amount of time steps.") + } + + if (!is.character(toptitle) || !is.character(ytitle)) { + stop("Parameters 'ytitle' and 'toptitle' must be character strings.") + } + + if (!is.numeric(monini)) { + stop("'monini' must be a month number, from 1 to 12.") + } + if (monini < 1 || monini > 12) { + stop("'monini' must be >= 1 and <= 12.") + } + + if (!is.numeric(yearini)) { + stop("'yearini' must be a month number, from 1 to 12.") + } + + if (!is.numeric(freq)) { + stop("'freq' must be a number <= 12.") + } + + if (!is.character(expname) || !is.character(obsname)) { + stop("'expname' and 'obsname' must be character strings.") + } + + if (!is.logical(drawleg)) { + stop("Parameter 'drawleg' must be either TRUE or FALSE.") + } + + if (!is.character(fileout) && !is.null(fileout)) { + stop("Parameter 'fileout' must be a character string.") + } + + ntimesteps <- dim(exp)[2] + lastyear <- (monini + (ntimesteps - 1) * 12 / freq - 1) %/% 12 + yearini + lastmonth <- (monini + (ntimesteps - 1) * 12 / freq - 1) %% 12 + 1 + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + labind <- seq(1, ntimesteps) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + yearini + labmonth <- months[((labind - 1) * 12 / freq + monini - 1) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, + nchar(y2o3dig) - 1, nchar(y2o3dig)), sep = "") + } + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + ## Observed time series. + #pc.o <- ts(obs[1, ], deltat = 1, start = yr1, end = yr2) + pc.o <- obs[1, ] + ## Normalization of obs, forecast members. Fabian + ## Normalization of forecast should be according to ensemble + ## mean, to keep info on ensemble spread, no? Lauriane pc.o <- + ## pc.o/sd(pc.o) sd.fc <- apply(exp,c(1),sd) + ## exp <- exp/sd.fc mn.fc <- + ## apply(exp,2, mean) exp <- + ## exp/sd(mn.fc) Produce plot. + par(mar = c(5, 6, 4, 2)) + boxplot(exp, add = FALSE, main = toptitle, + ylab = "", xlab = "", col = "red", lwd = 2, t = "b", + axes = FALSE, cex.main = 2, ylim = c(-max(abs(c(exp, pc.o))), max(abs(c(exp, pc.o))))) + lines(1:ntimesteps, pc.o, lwd = 3, col = "blue") + abline(h = 0, lty = 1) + if (drawleg) { + legend("bottomleft", c(obsname, expname), lty = c(1, 1), lwd = c(3, + 3), pch = c(NA, NA), col = c("blue", "red"), horiz = FALSE, + bty = "n", inset = 0.05) + } + ##mtext(1, line = 3, text = tar, cex = 1.9) + mtext(3, line = -2, text = paste(" AC =", round(cor(pc.o, + apply(exp, c(2), mean)), 2)), cex = 1.9, adj = 0) + axis(2, cex.axis = 2) + mtext(2, line = 3, text = ytitle, cex = 1.9) + par(mgp = c(0, 4, 0)) + ##axis(1, c(1:ntimesteps), NA, cex.axis = 2) + axis(1, seq(1, ntimesteps, by = 1), labmonth, cex.axis = 2) + box() + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} + diff --git a/R/VizClim.R b/R/VizClim.R new file mode 100644 index 0000000000000000000000000000000000000000..412122bf3b5e25c3003a69f2b469a484015f18a0 --- /dev/null +++ b/R/VizClim.R @@ -0,0 +1,210 @@ +#'Plots Climatologies +#' +#'Plots climatologies as a function of the forecast time for any index output +#'from \code{Clim()} and organized in matrix with dimensions:\cr +#'c(nmod/nexp, nmemb/nparam, nltime) or c(nmod/nexp, nltime) for the +#'experiment data\cr +#'c(nobs, nmemb, nltime) or c(nobs, nltime) for the observational data +#' +#'@param exp_clim Matrix containing the experimental data with dimensions:\cr +#' c(nmod/nexp, nmemb/nparam, nltime) or c(nmod/nexp, nltime) +#'@param obs_clim Matrix containing the observational data (optional) with +#' dimensions:\cr +#' c(nobs, nmemb, nltime) or c(nobs, nltime) +#'@param toptitle Main title, optional. +#'@param ytitle Title of Y-axis, optional. +#'@param monini Starting month between 1 and 12. Default = 1. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@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 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 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 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 +#' in a pop-up window. +#'@param ... 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 +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +#' smo srt tck usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@examples +#'clim <- s2dv::Clim(ts_temp$exp, ts_temp$obs, time_dim = "sdate", +#' dat_dim = c("dat", "member")) +#'dim(clim$clim_exp) <- dim(clim$clim_exp)[-3] +#'dim(clim$clim_obs) <- dim(clim$clim_obs)[-2] +#'VizClim(clim$clim_exp, clim$clim_obs, toptitle = 'Climatologies', +#' ytitle = 'K', monini = 11, listexp = 'SEAS5', +#' listobs = 'ERA5', biglab = FALSE, fileout = NULL) +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@importFrom s2dv InsertDim +#'@export +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, ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + # Get some arguments + # ~~~~~~~~~~~~~~~~~~~~ + # + if (length(dim(exp_clim)) != 2 & length(dim(exp_clim)) != 3 ) { + stop("2 or 3 dim needed : c(nexp, nltime) or c(nexp, nmemb, nltime)") + } + if (length(dim(exp_clim)) < 3) { + exp_clim <- InsertDim(exp_clim, 2, 1, name = 'new') + } + nleadtime <- dim(exp_clim)[3] + nexp <- dim(exp_clim)[1] + if (is.null(obs_clim)) { + nobs <- 0 + } else { + nobs <- dim(obs_clim)[1] + if (length(dim(obs_clim)) != 2 & length(dim(obs_clim)) != 3 ) { + stop("2 or 3 dim needed : c(nobs, nltime) or c(nobs, nmemb, nltime)") + } + if (length(dim(obs_clim)) < 3) { + obs_clim <- InsertDim(obs_clim, 2, 1, name = 'new') + } + if (dim(obs_clim)[3] != nleadtime) { + stop("obs and exp must have same number of ltimes") + } + } + if (is.null(limits) == TRUE) { + ll <- min(min(exp_clim, na.rm = TRUE), min(obs_clim, na.rm = TRUE), na.rm = TRUE) + ul <- max(max(exp_clim, na.rm = TRUE), max(obs_clim, na.rm = TRUE), na.rm = TRUE) + if (biglab) { + ul <- ul + 0.3 * (ul - ll) + } else { + ul <- ul + 0.2 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (biglab) { + labind <- seq(1, nleadtime, max(nleadtime %/% 5, 1)) + } else { + labind <- seq(1, nleadtime, max(nleadtime %/% 10, 1)) + } + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + labmonth <- months[((labind - 1) * 12 / freq + monini - 1) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, + nchar(y2o3dig) - 1, nchar(y2o3dig)), sep = "") + } + empty_ts <- ts(start = c(0000, (monini - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + empty <- array(dim = length(empty_ts)) + color <- c("red1", "dodgerblue1", "green1", "orange1", "lightblue1", + "deeppink1", "mediumpurple1", "lightgoldenrod1", "olivedrab1", + "mediumorchid1") + type <- c(1, 3, 2, 4) + thickness <- c(1, 3, 1, 2) + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1.25, 1.4, 0.5, 0), mgp = c(4, 2.5, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(3, 1.8, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, + main = toptitle, cex.main = cexmain * sizetit, axes = FALSE) + axis(1, at = labind, labels = labmonth) + axis(2) + box() + # + # Loops on experimental and observational data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + for (jexp in 1:nexp) { + for (jmemb in 1:dim(exp_clim)[2]) { + par(new = TRUE) + plot(exp_clim[jexp, jmemb, ], type = "l", lty = 1, lwd = 2, + ylim = c(ll, ul), col = color[jexp], ylab = "", xlab = "", + axes = FALSE) + } + } + if (nobs > 0) { + for (jobs in 1:nobs) { + for (jmemb in 1:dim(obs_clim)[2]) { + par(new = TRUE) + plot(obs_clim[jobs, jmemb, ], lty = type[jobs], lwd = thickness[jobs], + type = "l", ylim = c(ll, ul), col = 1, ylab = "", xlab = "", + axes = FALSE) + } + } + if (leg) { + 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) { + legend(1, ul, listexp[1:nexp], lty = 1, lwd = 2, col = color[1:nexp], + cex = legsize) + } + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/R/PlotEquiMap.R b/R/VizEquiMap.R similarity index 96% rename from R/PlotEquiMap.R rename to R/VizEquiMap.R index 58b329a7cd02f8fc4a8534a051a561b82720bea7..deafcfbf7060f7cf28f9db6c485b17ead1d44098 100644 --- a/R/PlotEquiMap.R +++ b/R/VizEquiMap.R @@ -70,8 +70,8 @@ #' 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. -#' Takes the value gray(0.5) by default or, if 'square = FALSE', takes the -#' value FALSE. If set to FALSE, continents are not filled in. +#' If 'square = FALSE', it is set as FALSE. +#' If set to FALSE (default), the continents are not filled. #'@param filled.oceans A logical value or the color name to fill in drawn #' projected oceans. The default value is FALSE. If it is TRUE, the default #' colour is "light blue". @@ -117,7 +117,7 @@ #'@param dot_symbol Single character/number or vector of characters/numbers #' that correspond to each of the symbol layers specified in parameter 'dots'. #' If a single value is specified, it will be applied to all the layers in -#' 'dots'. Takes 15 (centered square) by default. See 'pch' in par() for +#' 'dots'. Takes 4 (cross) by default. See 'pch' in par() for #' additional accepted options. #'@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 @@ -225,45 +225,27 @@ #'} #' #'@examples -#'# See examples on Load() to understand the first lines in this example -#' \dontrun{ -#'data_path <- system.file('sample_data', package = 's2dv') -#'expA <- list(name = 'experiment', path = file.path(data_path, -#' 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', -#' '$VAR_NAME$_$START_DATE$.nc')) -#'obsX <- list(name = 'observation', path = file.path(data_path, -#' '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', -#' '$VAR_NAME$_$YEAR$$MONTH$.nc')) +#'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 +#'lons <- attr(map_temp$exp, "Variables")$common$lon #' -#'# Now we are ready to use Load(). -#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- Load('tos', list(expA), list(obsX), startDates, -#' leadtimemin = 1, leadtimemax = 4, output = 'lonlat', -#' latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) -#' } -#' \dontshow{ -#'startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -#'sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), -#' c('observation'), startDates, -#' leadtimemin = 1, -#' leadtimemax = 4, -#' output = 'lonlat', -#' latmin = 27, latmax = 48, -#' lonmin = -12, lonmax = 40) -#' } -#'PlotEquiMap(sampleData$mod[1, 1, 1, 1, , ], sampleData$lon, sampleData$lat, -#' toptitle = 'Predicted sea surface temperature for Nov 1960 from 1st Nov', -#' title_scale = 0.5) -#'@import graphics maps +#'VizEquiMap(var[1, 1, 1, 1, , ], lon = lons, lat = lats, +#' toptitle = 'Near-surface temperature anomaly, Nov. 2000', +#' filled.continents = FALSE, title_scale = 0.7) +#' +#'@import graphics maps utils #'@importFrom grDevices dev.cur dev.new dev.off gray #'@importFrom stats cor +#' @importFrom s2dv InsertDim #'@export -PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, +VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, 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(), - square = TRUE, filled.continents = NULL, + square = TRUE, filled.continents = FALSE, filled.oceans = FALSE, country.borders = FALSE, coast_color = NULL, coast_width = 1, lake_color = NULL, shapefile = NULL, shapefile_color = NULL, shapefile_lwd = 1, diff --git a/R/VizLayout.R b/R/VizLayout.R new file mode 100644 index 0000000000000000000000000000000000000000..4cf0a546b92336c9c1b1f817b091a912a1c57486 --- /dev/null +++ b/R/VizLayout.R @@ -0,0 +1,743 @@ +#'Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar +#' +#'This function takes an array or list of arrays and loops over each of them +#'to plot all the sub-arrays they contain on an automatically generated +#'multi-pannel layout. A different plot function (not necessarily from +#'s2dv) can be applied over each of the provided arrays. The input +#'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 +#'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 +#'is provided in order to adjust the position, size and colour of the +#'components. Blank cells can be forced to appear and later be filled in +#'manually with customized plots.\cr +#'This function pops up a blank new device and fills it in, so it cannot be +#'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 +#' vector of as many function names (character strings!) can be provided in +#' 'fun', one for each array in 'var'. +#'@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) +#' 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 +#' 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 +#' 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 +#' be labelled in order to refer to them with names in 'plot_dims'. All the +#' available plottable sub-arrays will be automatically plotted and arranged +#' in consecutive cells of an automatically arranged layout. A list of +#' multiple (super-)arrays can be specified. The process will be repeated for +#' each of them, by default applying the same plot function to all of them +#' or, if properly specified in 'fun', a different plot function will be +#' 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 \dots Parameters to be sent to the plotting function 'fun'. If +#' multiple arrays are provided in 'var' 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'. +#'@param special_args List of sub-lists, each sub-list having specific extra +#' 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', +#' 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 +#' 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 +#' special_args:\cr +#' List of 2\cr +#' $ :List of 2\cr +#' ..$ arg1: ...\cr +#' ..$ arg2: ...\cr +#' $ :List of 1\cr +#' ..$ arg1: ...\cr +#'@param nrow Numeric value to force the number of rows in the automatically +#' generated layout. If higher than the required, this will yield blank cells +#' in the layout (which can then be populated). If lower than the required +#' the function will stop. By default it is configured to arrange the layout +#' in a shape as square as possible. Blank cells can be manually populated +#' after with customized plots (see SwitchTofigure). +#'@param ncol Numeric value to force the number of columns in the +#' automatically generated layout. If higher than the required, this will +#' yield blank cells in the layout (which can then be populated). If lower +#' than the required the function will stop. By default it is configured to +#' arrange the layout in a shape as square as possible. Blank cells can be +#' manually populated after with customized plots (see SwitchTofigure). +#'@param toptitle Topt title for the multi-pannel. Blank by default. +#'@param row_titles Character string vector with titles for each of the rows +#' in the layout. Blank by default. +#'@param col_titles Character string vector with titles for each of the +#' columns in the layout. Blank by default. +#'@param bar_scale Scale factor for the common colour bar. Takes 1 by default. +#'@param title_scale Scale factor for the multi-pannel title. Takes 1 by +#' default. +#'@param title_margin_scale Scale factor for the margins surrounding the top +#' title. Takes 1 by default. +#'@param title_left_shift_scale When plotting row titles, a shift is added +#' to the horizontal positioning of the top title in order to center it to +#' the region of the figures (without taking row titles into account). This +#' shift can be reduced. A value of 0 will remove the shift completely, +#' centering the title to the total width of the device. This parameter will +#' be disregarded if no 'row_titles' are provided. +#'@param subtitle_scale Scale factor for the row titles and column titles +#' (specified in 'row_titles' and 'col_titles'). Takes 1 by default. +#'@param subtitle_margin_scale Scale factor for the margins surrounding the +#' subtitles. Takes 1 by default. +#'@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'. +#'@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 +#' 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 +#' 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 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 +#' 'down', 'd', 'D', 'bottom', 'b', 'B', 'south', 's', 'S' (default)\cr +#' 'right', 'r', 'R', 'east', 'e', 'E'\cr +#' 'left', 'l', 'L', 'west', 'w', 'W' +#'@param titles Character string vector with titles for each of the figures in +#' the multi-pannel, from top-left to bottom-right. Blank by default. +#'@param 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 +#' region of the figures (without taking row titles into account). This shift +#' can be reduced. A value of 0 will remove the shift completely, centering +#' the colour bar to the total width of the device. This parameter will be +#' disregarded if no 'row_titles' are provided. +#'@param extra_margin Extra margins to be added around the layout, in the +#' 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). +#'@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 Width in inches of the multi-pannel. 7 by default, or 11 if +#' 'fielout' has been specified. +#'@param height Height in inches of the multi-pannel. 7 by default, or 11 if +#' 'fileout' has been specified. +#'@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 close_device Whether to close the graphics device after plotting +#' 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. +#' +#'@return +#'\item{brks}{ +#' Breaks used for colouring the map (and legend if drawleg = TRUE). +#'} +#'\item{cols}{ +#' Colours used for colouring the map (and legend if drawleg = TRUE). +#' Always of length length(brks) - 1. +#'} +#'\item{col_inf}{ +#' Colour used to draw the lower triangle end in the colour bar +#' (NULL if not drawn at all). +#'} +#'\item{col_sup}{ +#' Colour used to draw the upper triangle end in the colour bar +#' (NULL if not drawn at all). +#'} +#'\item{layout_matrix}{ +#' Underlying matrix of the layout. Useful to later set any of the layout +#' cells as current figure to add plot elements. See .SwitchToFigure. +#'} +#' +#'@examples +#'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 +#'lons <- attr(map_temp$exp, "Variables")$common$lon +#' +#'VizLayout(fun = VizquiMap, plot_dims = c('lat', 'lon'), +#' var = var[, 1, 1, 1, , ], lon = lons, lat = lats, +#' filled.continents = FALSE, +#' toptitle = 'Near-surface temperature Nov.', +#' titles = paste(2000:2005)) +#'@import utils +#'@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) { + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + 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).") + } + } else { + stop("Parameter 'var' must be an array or a list of arrays.") + } + + # Check fun + if (length(fun) == 1) { + if (is.function(fun)) { + fun <- as.character(substitute(fun)) + } + if (is.character(fun)) { + fun <- rep(fun, length(var)) + } + } + 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'.") + } + + # 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'.") + } + } + + # Check plot_dims + if (is.character(plot_dims) || is.numeric(plot_dims)) { + plot_dims <- replicate(length(var), 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'.") + } + + # Check nrow + if (!is.null(nrow)) { + if (!is.numeric(nrow)) { + stop("Parameter 'nrow' must be numeric or NULL.") + } + nrow <- round(nrow) + } + + # Check ncol + if (!is.null(ncol)) { + if (!is.numeric(ncol)) { + stop("Parameter 'ncol' must be numeric or NULL.") + } + ncol <- round(ncol) + } + # Check layout_by_rows + if (!is.logical(layout_by_rows)) { + stop("Parameter 'layout_by_rows' must be logical.") + } + + # Check toptitle + if (is.null(toptitle) || is.na(toptitle)) { + toptitle <- '' + } + if (!is.character(toptitle)) { + stop("Parameter 'toptitle' must be a character string.") + } + + # Check row_titles + if (!is.null(row_titles)) { + if (!is.character(row_titles)) { + stop("Parameter 'row_titles' must be a vector of character strings.") + } + } + + # Check col_titles + if (!is.null(row_titles)) { + if (!is.character(row_titles)) { + stop("Parameter 'row_titles' must be a vector of character strings.") + } + } + + # Check drawleg + if (is.character(drawleg)) { + if (drawleg %in% c('up', 'u', 'U', 'top', 't', 'T', 'north', 'n', 'N')) { + drawleg <- 'N' + } else if (drawleg %in% c('down', 'd', 'D', 'bottom', 'b', 'B', 'south', 's', 'S')) { + drawleg <- 'S' + } else if (drawleg %in% c('right', 'r', 'R', 'east', 'e', 'E')) { + drawleg <- 'E' + } else if (drawleg %in% c('left', 'l', 'L', 'west', 'w', 'W')) { + drawleg <- 'W' + } else { + stop("Parameter 'drawleg' must be either TRUE, FALSE or a valid identifier of a position (see ?PlotMultiMap).") + } + } 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)) && + (is.null(brks) || length(brks) < 2)) { + stop("Either data arrays in 'var' 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))) { + if (!all(is.na(unlist(var)))) { + var_limits <- c(min(unlist(var), na.rm = TRUE), max(unlist(var), na.rm = TRUE)) + } else { + if (!is.null(brks)) { + #NOTE: var_limits be like this to avoid warnings from ColorBar + var_limits <- c(min(brks, na.rm = TRUE) + diff(brks)[1], + max(brks, na.rm = TRUE)) + } else if (!is.null(bar_limits)) { + var_limits <- c(bar_limits[1] + 0.01, bar_limits[2]) + } else { + var_limits <- c(-0.5, 0.5) # random range since colorbar is not going to be plotted + if (!isFALSE(drawleg)) { + drawleg <- FALSE + warning("All data are NAs. Color bar won't be drawn. If you want to have color bar still, define parameter 'brks' or 'bar_limits'.") + } + } + } + } + + 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) + + # Check bar_scale + if (!is.numeric(bar_scale)) { + stop("Parameter 'bar_scale' must be numeric.") + } + + # Check bar_left_shift_scale + if (!is.numeric(bar_left_shift_scale)) { + stop("Parameter 'bar_left_shift_scale' must be numeric.") + } + + # Check title_scale + if (!is.numeric(title_scale)) { + stop("Parameter 'title_scale' must be numeric.") + } + + # Check title_margin_scale + if (!is.numeric(title_margin_scale)) { + stop("Parameter 'title_margin_scale' must be numeric.") + } + + # Check title_left_shift_scale + if (!is.numeric(title_left_shift_scale)) { + stop("Parameter 'title_left_shift_scale' must be numeric.") + } + + # Check subtitle_scale + if (!is.numeric(subtitle_scale)) { + stop("Parameter 'subtite_scale' must be numeric.") + } + + # Check subtitle_margin_scale + if (!is.numeric(subtitle_margin_scale)) { + stop("Parameter 'subtite_margin_scale' must be numeric.") + } + + # Check subplot_titles_scale + if (!is.numeric(subplot_titles_scale)) { + stop("Parameter 'subplot_titles_scale' must be numeric.") + } + + # Check titles + if (!all(sapply(titles, is.character))) { + stop("Parameter 'titles' must be a vector of character strings.") + } + + # Check extra_margin + if (!is.numeric(extra_margin) || length(extra_margin) != 4) { + stop("Parameter 'extra_margin' must be a numeric vector with 4 elements.") + } + + # Check width + if (is.null(width)) { + if (is.null(fileout)) { + width <- 7 + } else { + width <- 11 + } + } + if (!is.numeric(width)) { + stop("Parameter 'width' must be numeric.") + } + + # Check height + if (is.null(height)) { + if (is.null(fileout)) { + height <- 7 + } else { + height <- 8 + } + } + if (!is.numeric(height)) { + stop("Parameter 'height' must be numeric.") + } + + # Check close_device + if (!is.logical(close_device)) { + stop("Parameter 'close_device' must be logical.") + } + + # 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) { + if (is_single_na(plot_array)) { + n_plots <- n_plots + 1 + } else { + dim_ids <- plot_dims[[plot_array_i]] + if (is.character(dim_ids)) { + dimnames <- NULL + if (!is.null(names(dim(plot_array)))) { + dimnames <- names(dim(plot_array)) + } else if (!is.null(attr(plot_array, 'dimensions'))) { + dimnames <- attr(plot_array, 'dimensions') + } + 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'.") + } + 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)) + } else { + warning(paste0("Assuming the ", plot_array_i, "th array provided in 'var' 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 + } + } + } else if (any(dim_ids > length(dim(plot_array)))) { + stop("Parameter 'plot_dims' contains dimension identifiers out of range.") + } + 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]])) + dim_ids <- dim_ids + 1 + } + plot_dims[[plot_array_i]] <- dim_ids + } + plot_array_i <- plot_array_i + 1 + } + if (is.null(nrow) && is.null(ncol)) { + ncol <- ceiling(sqrt(n_plots)) + nrow <- ceiling(n_plots/ncol) + } else if (is.null(ncol)) { + ncol <- ceiling(n_plots/nrow) + } 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'.") + } + + if (is.logical(drawleg) && drawleg) { + if (nrow > ncol) { + drawleg <- 'S' + } else { + drawleg <- 'E' + } + } + vertical <- drawleg %in% c('E', 'W') + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } else if (prod(par('mfrow')) > 1) { + dev.new(units = units, res = res, width = width, height = height) + } + + # Take size of device and set up layout: + # --------------------------------------------- + # |0000000000000000000000000000000000000000000| + # |0000000000000000 TOP TITLE 0000000000000000| + # |0000000000000000000000000000000000000000000| + # |-------------------------------------------| + # |00000|0000000000000000000000000000000000000| + # |00000|000000000000 ROW TITLES 0000000000000| + # |00000|0000000000000000000000000000000000000| + # |00000|-------------------------------------| + # |0 0|222222222222222222|333333333333333333| + # |0 C 0|222222222222222222|333333333333333333| + # |0 O 0|222222222222222222|333333333333333333| + # |0 L 0|2222 FIGURE 1 2222|3333 FIGURE 2 3333| + # |0 0|222222222222222222|333333333333333333| + # |0 T 0|222222222222222222|333333333333333333| + # |0 I 0|222222222222222222|333333333333333333| + # |0 T 0|-------------------------------------| + # |0 L 0|444444444444444444|555555555555555555| + # |0 S 0|444444444444444444|555555555555555555| + # |0 0|444444444444444444|555555555555555555| + # |00000|4444 FIGURE 3 4444|5555 FIGURE 4 5555| + # |00000|444444444444444444|555555555555555555| + # |00000|444444444444444444|555555555555555555| + # |00000|444444444444444444|555555555555555555| + # |-------------------------------------------| + # |1111111111111111111111111111111111111111111| + # |1111111111111111 COLOR BAR 1111111111111111| + # |1111111111111111111111111111111111111111111| + # --------------------------------------------- + device_size <- par('din') + device_size[1] <- device_size[1] - sum(extra_margin[c(2, 4)]) + device_size[2] <- device_size[2] - sum(extra_margin[c(1, 3)]) + cs <- char_size <- par('csi') + title_cex <- 2.5 * title_scale + title_margin <- 0.5 * title_cex * title_margin_scale + subtitle_cex <- 1.5 * subtitle_scale + subtitle_margin <- 0.5 * sqrt(nrow * ncol) * subtitle_cex * subtitle_margin_scale + mat_layout <- 1:(nrow * ncol) + if (drawleg != FALSE) { + if (all(fun %in% 'PlotMostLikelyQuantileMap')) { #multi_colorbar + 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]) + minimum_value <- ceiling(1 / nmap * 10 * 1.1) * 10 + display_range = c(minimum_value, 100) + mat_layout <- mat_layout + nmap + } else { + multi_colorbar <- FALSE + mat_layout <- mat_layout + 1 + } + } + mat_layout <- matrix(mat_layout, nrow, ncol, byrow = layout_by_rows) + fsu <- figure_size_units <- 10 # unitless + widths <- rep(fsu, ncol) + heights <- rep(fsu, nrow) + # Useless +# n_figures <- nrow * ncol + + if (drawleg != FALSE) { + if (drawleg == 'N') { + mat_layout <- rbind(rep(1, dim(mat_layout)[2]), mat_layout) + heights <- c(round(bar_scale * 2 * nrow), heights) + } else if (drawleg == 'S') { + if (multi_colorbar) { + new_mat_layout <- c() + for (i_col in 1:ncol) { + new_mat_layout <- c(new_mat_layout, rep(mat_layout[, i_col], nmap)) + } + new_mat_layout <- matrix(new_mat_layout, nrow, nmap * ncol) + colorbar_row <- rep(1:nmap, each = ncol) + mat_layout <- rbind(new_mat_layout, as.numeric(colorbar_row)) + widths <- rep(widths, nmap) + } else { + mat_layout <- rbind(mat_layout, rep(1, dim(mat_layout)[2])) + } + heights <- c(heights, round(bar_scale * 2 * nrow)) + } else if (drawleg == 'W') { + mat_layout <- cbind(rep(1, dim(mat_layout)[1]), mat_layout) + widths <- c(round(bar_scale * 3 * ncol), widths) + } else if (drawleg == 'E') { + mat_layout <- cbind(mat_layout, rep(1, dim(mat_layout)[1])) + widths <- c(widths, round(bar_scale * 3 * ncol)) + } + # Useless +# n_figures <- n_figures + 1 + } + + # row and col titles + if (length(row_titles) > 0) { + mat_layout <- cbind(rep(0, dim(mat_layout)[1]), mat_layout) + widths <- c(((subtitle_cex + subtitle_margin / 2) * cs / device_size[1]) * ncol * fsu, widths) + } + if (length(col_titles) > 0) { + mat_layout <- rbind(rep(0, dim(mat_layout)[2]), mat_layout) + heights <- c(((subtitle_cex + subtitle_margin) * cs / device_size[2]) * nrow * fsu, heights) + } + # toptitle + if (toptitle != '') { + mat_layout <- rbind(rep(0, dim(mat_layout)[2]), mat_layout) + heights <- c(((title_cex + title_margin) * cs / device_size[2]) * nrow * fsu, heights) + } + par(oma = extra_margin) + layout(mat_layout, widths, heights) + # Draw the color bar + if (drawleg != FALSE) { + if (length(row_titles) > 0) { + bar_extra_margin[2] <- bar_extra_margin[2] + (subtitle_cex + subtitle_margin / 2) * + bar_left_shift_scale + } + + if (multi_colorbar) { # multiple colorbar + if (!is.null(list(...)$bar_titles)) { + bar_titles <- list(...)$bar_titles + } else { + bar_titles <- NULL + } + GradientCatsColorBar(nmap = nmap, + brks = brks, cols = cols, vertical = vertical, subsampleg = subsampleg, + bar_limits = display_range, var_limits = var_limits, + triangle_ends = triangle_ends, plot = TRUE, + draw_separators = draw_separators, + bar_titles = bar_titles, title_scale = units_scale, + 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) + + } + } + + # Draw titles + if (toptitle != '' || length(col_titles) > 0 || length(row_titles) > 0) { + plot(0, type = 'n', ann = FALSE, axes = FALSE, xaxs = 'i', yaxs = 'i', + xlim = c(0, 1), ylim = c(0, 1)) + width_lines <- par('fin')[1] / par('csi') + plot_lines <- par('pin')[1] / par('csi') + plot_range <- par('xaxp')[2] - par('xaxp')[1] + size_units_per_line <- plot_range / plot_lines + if (toptitle != '') { + title_x_center <- par('xaxp')[1] - par('mar')[2] * size_units_per_line + + ncol * width_lines * size_units_per_line / 2 + if (length(row_titles) > 0) { + title_x_center <- title_x_center - (1 - title_left_shift_scale) * + (subtitle_cex + subtitle_margin) / 2 * size_units_per_line + } + title_y_center <- par('mar')[3] + (title_margin + title_cex) / 2 + if (length(col_titles > 0)) { + title_y_center <- title_y_center + (subtitle_margin + subtitle_cex) + } + mtext(toptitle, cex = title_cex, line = title_y_center, at = title_x_center, + padj = 0.5) + } + if (length(col_titles) > 0) { + t_x_center <- par('xaxp')[1] - par('mar')[2] * size_units_per_line + for (t in 1:ncol) { + mtext(col_titles[t], cex = subtitle_cex, + line = par('mar')[3] + (subtitle_margin + subtitle_cex) / 2, + at = t_x_center + (t - 0.5) * width_lines * size_units_per_line, + padj = 0.5) + } + } + height_lines <- par('fin')[2] / par('csi') + plot_lines <- par('pin')[2] / par('csi') + plot_range <- par('yaxp')[2] - par('yaxp')[1] + size_units_per_line <- plot_range / plot_lines + if (length(row_titles) > 0) { + t_y_center <- par('yaxp')[1] - par('mar')[1] * size_units_per_line + for (t in 1:nrow) { + mtext(row_titles[t], cex = subtitle_cex, + line = par('mar')[2] + (subtitle_margin + subtitle_cex) / 2, + at = t_y_center - (t - 1.5) * height_lines * size_units_per_line, + padj = 0.5, side = 2) + } + } + par(new = TRUE) + } + + array_number <- 1 + plot_number <- 1 + # For each array provided in var + lapply(var, function(x) { + if (is_single_na(x)) { + if (!all(sapply(var[array_number:length(var)], is_single_na))) { + plot.new() + par(new = FALSE) + } + plot_number <<- plot_number + 1 + } else { + if (is.character(plot_dims[[array_number]])) { + plot_dim_indices <- which(names(dim(x)) %in% plot_dims[[array_number]]) + } else { + plot_dim_indices <- plot_dims[[array_number]] + } + # For each of the arrays provided in that array + apply(x, (1:length(dim(x)))[-plot_dim_indices], + function(y) { + # Do the plot. colorbar is not drew. + fun_args <- c(list(y, toptitle = titles[plot_number], drawleg = FALSE), list(...), + special_args[[array_number]]) +# funct <- fun[[array_number]] + if (fun[[array_number]] %in% c('PlotEquiMap', 'PlotStereoMap')) { + fun_args <- c(fun_args, list(brks = colorbar$brks, cols = colorbar$cols, + col_inf = colorbar$col_inf, + col_sup = colorbar$col_sup, + title_scale = subplot_titles_scale # when all the functions have this argument, put it above in fun_args + )) + } else if (fun[[array_number]] == c('PlotSection')) { + fun_args <- c(fun_args, list(brks = colorbar$brks, cols = colorbar$cols)) + + } else if (fun[[array_number]] %in% 'PlotMostLikelyQuantileMap') { + #TODO: pre-generate colorbar params? like above + fun_args <- c(fun_args, list(brks = brks, cols = cols)) + } + do.call(fun[[array_number]], fun_args) + plot_number <<- plot_number + 1 + }) + } + array_number <<- array_number + 1 + }) + + # If the graphic was saved to file, close the connection with the device + if (!is.null(fileout) && close_device) dev.off() + + invisible(list(brks = colorbar$brks, cols = colorbar$cols, + col_inf = colorbar$col_inf, col_sup = colorbar$col_sup, + layout_matrix = mat_layout)) +} diff --git a/R/VizMatrix.R b/R/VizMatrix.R new file mode 100644 index 0000000000000000000000000000000000000000..361a255376254e9a44738e5d25409f2a25942585 --- /dev/null +++ b/R/VizMatrix.R @@ -0,0 +1,229 @@ +#'Function to convert any numerical table to a grid of coloured squares. +#' +#'This function converts a numerical data matrix into a coloured +#'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 +#' colored image. +#'@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. +#'@param cols A vector of valid color identifiers for color bar. The length +#' must be one less than the parameter 'brks'. Use ColorBarContinuous() to +#' generate default values. +#'@param toptitle A string of the title of the grid. Set NULL as default. +#'@param title.color A string of valid color identifier to decide the title +#' color. Set "royalblue4" as default. +#'@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. +#'@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. +#'@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. +#' Set TRUE as default. +#'@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). +#'@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. +#'@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 +#' (file or window) to plot in. Set 'px' as default. See ?Devices and the +#' creator function of the corresponding device. +#'@param 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. +#'@param ... The additional parameters to be passed to function +#' ColorBarContinuous() in s2dv for color legend creation. +#'@return A figure in popup window by default, or saved to the specified path. +#' +#'@examples +#'#Example with random data +#' VizMatrix(var = 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), +#' toptitle = "Mean Absolute Error", +#' xtitle = "Forecast time (month)", ytitle = "Start date", +#' xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", +#' "Aug", "Sep", "Oct", "Nov", "Dec")) +#' +#'@importFrom grDevices dev.new dev.off dev.cur +#'@export +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)) + stop("Input values are not a matrix") + if (!is.numeric(var)) + stop("Input values are not always numbers") + + # Build: brks, cols + colorbar <- ColorBarContinuous(brks = brks, cols = cols, vertical = FALSE, + plot = FALSE, ...) + brks <- colorbar$brks + cols <- colorbar$cols + + n.cols <- length(cols) ## number of colours + n.brks <- length(brks) ## number of intervals + + 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 + if (ncols < 2) + stop("Matrix must have at least two columns") + if (nrows < 2) + stop("Matrix must have at least two rows") + if (!is.null(xlabels) && length(xlabels) != ncols) + stop(paste0("The number of x labels must be equal to the number of ", + "columns of the data matrix")) + if (!is.null(ylabels) && length(ylabels) != nrows) + stop(paste0("The number of y labels must be equal to the number of ", + "rows of the data matrix")) + if (!is.numeric(figure.width) || figure.width < 0) + stop("figure.width must be a positive number") + 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)) { + deviceInfo <- .SelectDevice(fileout = fileout, + width = 80 * ncols * figure.width, + height = 80 * nrows, + units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, + width = 8 * figure.width, height = 5) + } + + if (!is.null(fileout)) { + + # Draw empty plot: + par(mar = c(4, 4, 1, 0), fig = c(0.1, 1 - legend.width, 0.1, 0.9)) + plot(1, 1, type = "n", xaxt = "n", yaxt = "n", ylim = c(0.5, nrows + 0.5), + xlim = c(-0.5, ncols - 1 + 0.5), ann = F, bty = "n") + + # Add axes titles: + label.size <- 1.2 * (max(ncols, nrows) / 10) ^ 0.5 + mtext(side = 1, text = xtitle, line = line, cex = label.size, font = 3) + mtext(side = 2, text = ytitle, line = 3, cex = label.size, font = 3) + + # Add plot title: + if (is.null(title.color)) title.color <- "royalblue4" + mtext(side = 3, text = toptitle, cex = 1.75 * (nrows / 10) ^ 0.7, + col = title.color) + + # Add axis labels: + axis.size <- (max(ncols, nrows) / 10) ^ 0.3 + if (is.null(xlabels)) xlabels = 1:ncols + if (is.null(ylabels)) ylabels = 1:nrows + + if(is.null(xlab_dist)) { ## Add x axis labels + axis(1, at = seq(0, ncols - 1), las = ifelse(xvert, 2, 1), labels = xlabels, + cex.axis = axis.size, tck = 0, lwd = 0, line = - 1 - (nrows / 10 - 1)) + } else { + axis(1, at = seq(0, ncols - 1), las = ifelse(xvert, 2, 1), labels = xlabels, + cex.axis = axis.size, tck = 0, lwd = 0, line = xlab_dist) + } + if(is.null(ylab_dist)) { ## Add y axis labels + axis(2, at = seq(1, nrows), las = 1, labels = rev(ylabels), + cex.axis = axis.size, tck = 0, lwd = 0, line = 0.5 - ncols / 10) + } else { + axis(2, at = seq(1, nrows), las = 1, labels = rev(ylabels), + cex.axis = axis.size, tck = 0, lwd = 0, line = ylab_dist) + } + + } else { + + # Draw empty plot: + par(mar = c(4, 4, 1, 0), fig = c(0.1, 1 - legend.width, 0.1, 0.9)) + plot(1, 1, type = "n", xaxt = "n", yaxt = "n", ylim = c(0.5, nrows + 0.5), + xlim = c(-0.5, ncols - 1 + 0.5), ann = F, bty = "n") + + # Add axes titles: + label.size <- 1.2 # * (max(ncols, nrows) / 10) ^ 0.5 + mtext(side = 1, text = xtitle, line = line, cex = label.size, font = 3) + mtext(side = 2, text = ytitle, line = 3, cex = label.size, font = 3) + + # Add plot title: + if (is.null(title.color)) title.color <- "royalblue4" + mtext(side = 3, text = toptitle, cex = 1.5, #* (nrows / 10) ^ 0.7, + col = title.color) + + # Add axis labels: + axis.size <- 1 #(max(ncols, nrows) / 10) ^ 0.3 + if (is.null(xlabels)) xlabels = 1:ncols + if (is.null(ylabels)) ylabels = 1:nrows + + if(is.null(xlab_dist)){ ## Add x axis labels + axis(1, at = seq(0, ncols - 1), las = ifelse(xvert, 2, 1), labels = xlabels, + cex.axis = axis.size, tck = 0, lwd = 0, line = - 1 - (nrows / 10 - 1)) + } else { + axis(1, at = seq(0, ncols - 1), las = ifelse(xvert, 2, 1), labels = xlabels, + cex.axis = axis.size, tck = 0, lwd = 0, line = xlab_dist) + } + if(is.null(ylab_dist)){ ## Add y axis labels + axis(2, at = seq(1, nrows), las = 1, labels = rev(ylabels), + cex.axis = axis.size, tck = 0, lwd = 0, line = 0.5 - ncols / 10) + } else { + axis(2, at = seq(1, nrows), las = 1, labels = rev(ylabels), + cex.axis = axis.size, tck = 0, lwd = 0, line = ylab_dist) + } + + } + + # 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] + + # fill with colors the cells in the figure: + for (p in 1:nrows) { + for (l in 0:(ncols - 1)) { + polygon(c(0.5 + l - 1, 0.5 + l - 1, 1.5 + l - 1, 1.5 + l - 1), + c(-0.5 + nrows + 1 - p, 0.5 + nrows + 1 - p, + 0.5 + nrows + 1 - p, -0.5 + nrows + 1 - p), + col = array.colors[p, 1 + l], border = "black") + } + } + + # Draw color legend: + if (legend) { + par(fig = c(1 - legend.width - 0.01, + 1 - legend.width + legend.width * min(1, 10 / ncols), + 0.3, 0.8), new = TRUE) + #legend.label.size <- (max(ncols, nrows) / 10) ^ 0.4 + ColorBarContinuous(brks = brks, cols = cols, vertical = TRUE, ...) + } + + # If the graphic was saved to file, close the connection with the device + if (!is.null(fileout)) dev.off() + invisible(list(brks = brks, cols = cols)) + +} diff --git a/R/PlotRobinson.R b/R/VizRobinson.R similarity index 93% rename from R/PlotRobinson.R rename to R/VizRobinson.R index dc9b36d4619fff23241fae6e8df1b20b430bae6c..285e8b44bfcad6e70b2a536fb9b1f4de4264f2fa 100644 --- a/R/PlotRobinson.R +++ b/R/VizRobinson.R @@ -4,7 +4,7 @@ #'plot the map. The target projection must be a valid CRS string, preferrably be #'EPSG or ESRI code; check \link[sf]{st_crs} for more explanation. This function #'is mainly tested for Robinson projection (ESRI:54030), but it can work with -#'other projection types in theory.\n +#'other projection types in theory.\cr #'The map can be plotted by points or polygon. A legend can be plotted as either #'a color bar or a discrete ggplot legend. Dots can be drawn on top of the data, #'which can be used for significance test. A mask can be added to not plot the @@ -95,36 +95,37 @@ #'@return A map plot with speficied projection, either in pop-up window or a #' saved file. #' -#'@examples -#'data <- array(rep(seq(-10, 10, length.out = 181), 360) + rnorm(360), +#'@examples +#'data <- array(rep(seq(-10, 10, length.out = 181), 360) + rnorm(360), #' dim = c(lat = 181, lon = 360)) #'dots <- data #'dots[which(dots < 4 & dots > -4)] <- 0 #'dots[which(dots != 0)] <- 1 -#'PlotRobinson(data, lon = 0:359, lat = -90:90, dots = dots, -#' brks = seq(-10, 10, length.out = 11), -#' toptitle = 'synthetic example', vertical = F, -#' caption = 'Robinson Global\ns2dv::PlotRobinson example', -#' bar_extra_margin = c(0, 1, 0, 1), width = 8, height = 6) -#'PlotRobinson(data, lon = 0:359, lat = -90:90, mask = dots, legend = 'ggplot2', -#' target_proj = "+proj=moll", brks = seq(-10, 10, length.out = 11), -#' color_fun = ClimPalette("purpleorange"), colNA = 'green', -#' toptitle = 'synthetic example', -#' caption = 'Mollweide Global\ns2dv::PlotRobinson example', -#' width = 8, height = 6) +#'VizRobinson(data, lon = 0:359, lat = -90:90, dots = dots, +#' brks = seq(-10, 10, length.out = 11), +#' toptitle = 'synthetic example', vertical = F, +#' caption = 'Robinson Projection', +#' bar_extra_margin = c(0, 1, 0, 1), width = 8, height = 6) +#'Vizobinson(data, lon = 0:359, lat = -90:90, mask = dots, legend = '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) #' -#'@import sf ggplot2 rnaturalearth cowplot +#'@import sf ggplot2 rnaturalearth cowplot utils +#'@importFrom dplyr mutate group_by summarise +#'@importFrom ClimProjDiags Subset #'@export -PlotRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, - target_proj = 54030, legend = 's2dv', 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) { +VizRobinson <- function(data, lon, lat, lon_dim = NULL, lat_dim = NULL, + target_proj = 54030, legend = 's2dv', 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) { # Sanity check # data diff --git a/R/VizSection.R b/R/VizSection.R new file mode 100644 index 0000000000000000000000000000000000000000..06a272413ad2618ab0abf557a421ac908a5ffaea --- /dev/null +++ b/R/VizSection.R @@ -0,0 +1,171 @@ +#'Plots A Vertical Section +#' +#'Plot a (longitude,depth) or (latitude,depth) section. +#' +#'@param var Matrix to plot with (longitude/latitude, depth) dimensions. +#'@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 units Units, optional. +#'@param brks Colour levels, optional. +#'@param cols List of colours, optional. +#'@param axelab TRUE/FALSE, label the axis. Default = TRUE. +#'@param intydep Interval between depth ticks on y-axis. Default: 200m. +#'@param intxhoriz Interval between longitude/latitude ticks on x-axis.\cr +#' Default: 20deg. +#'@param drawleg Draw colorbar. Default: TRUE. +#'@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 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 fileout Name of output file. Extensions allowed: eps/ps, jpeg, png, +#' pdf, bmp and tiff. \cr +#' Default = NULL +#'@param ... 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 +#' cra crt csi cxy err family fg fig fin font font.axis font.lab font.main +#' font.sub lend lheight ljoin lmitre lty lwd mex mfcol mfrow mfg mkh oma omd +#' omi page pch pin plt pty smo srt tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs +#' yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@examples +#'# Synthetic data +#'data <- array(rep(seq(25, 10, length.out = 7), each = 21) - rnorm(147), +#' dim = c(lat = 21, depth = 7)) +#'VizSection(data, horiz = 0:20, depth = seq(0, 300, length.out = 7), +#' intydep = 50, intxhoriz = 5, brks = 11, +#' toptitle = 'Temperature cross-section', units = "degC") +#'@importFrom grDevices dev.cur dev.new dev.off rainbow +#'@export +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, ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + # Input arguments + # ~~~~~~~~~~~~~~~~~ + # + dims <- dim(var) + if (length(dims) > 2) { + stop("Only 2 dimensions expected for var : (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) + } else { + stop("Inconsistent var dimensions and longitudes/latitudes + depth") + } + } + dhoriz <- horiz[2:dims[1]] - horiz[1:(dims[1] - 1)] + wher <- which(dhoriz > (mean(dhoriz) + 5)) + if (length(wher) > 0) { + horiz[(wher + 1):dims[1]] <- horiz[(wher + 1):dims[1]] - 360 + } + horizb <- sort(horiz, index.return = TRUE) + depthb <- sort(-abs(depth), index.return = TRUE) + horizmin <- floor(min(horiz) / 10) * 10 + horizmax <- ceiling(max(horiz) / 10) * 10 + 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) + if (is.null(cols) == TRUE) { + cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", + "white", "white", "yellow", "orange", "red", "saddlebrown") + } + nlev <- length(cols) + brks <- signif(seq(ll, ul, (ul - ll) / nlev), 4) + } else { + if (is.null(cols) == TRUE) { + nlev <- length(brks) - 1 + cols <- rainbow(nlev) + } else { + if (length(cols) != (length(brks) - 1)) { + stop("Inconsistent colour levels / list of colours") + } + } + } + # + # Plotting the section + # ~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + xmargin <- 0.5 + ymargin <- 0.5 + topmargin <- 3 + if (axelab) { + ymargin <- ymargin + 2.5 + xmargin <- xmargin + 1.5 + } + if (drawleg) { + layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5, 1)) + xmargin <- max(xmargin - 1.8, 0) + } + if (toptitle == '') { + topmargin <- topmargin - 2.5 + } + par(mar = c(xmargin, ymargin, topmargin, 0.5), cex = 1.4, + 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, + breaks = brks, axes = FALSE, xlab = "", ylab = "", add = TRUE) + if (axelab) { + minhoriz <- ceiling(round(min(horizb$x), 0) / 10) * 10 + maxhoriz <- floor(round(max(horizb$x), 0) / 10) * 10 + axis(1, at = seq(minhoriz, maxhoriz, intxhoriz), tck = -0.02) + maxdepth <- floor(round(max(depthb$x), 0) / 10) * 10 + axis(2, at = seq(-8000, 0, intydep), tck = -0.015) + } + box() + # + # Colorbar + # ~~~~~~~~~~ + # + if (drawleg) { + par(mar = c(1.5, ymargin, 2.5, 0.5), mgp = c(1.5, 0.3, 0), las = 1, + cex = 1.2) + image(1:length(cols), 1, t(t(1:length(cols))), axes = FALSE, col = cols, + xlab = units, ylab = '') + box() + axis(1, at = seq(0.5, length(brks) - 0.5, 1), labels = brks, cex.axis = 1) + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/R/VizStereoMap.R b/R/VizStereoMap.R new file mode 100644 index 0000000000000000000000000000000000000000..37ff86430a4a7ad6733a6654c257cbd665371300 --- /dev/null +++ b/R/VizStereoMap.R @@ -0,0 +1,863 @@ +#'Maps A Two-Dimensional Variable On A Polar Stereographic Projection +#' +#'Map longitude-latitude array (on a regular rectangular or gaussian grid) on +#'a polar stereographic world projection with coloured grid cells. Only the +#'region within a specified latitude interval is displayed. A colour bar +#'(legend) can be plotted and adjusted. It is possible to draw superimposed +#'dots, symbols, boxes, contours, and arrows. A number of options is provided to +#'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 +#' 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 lon Numeric vector of longitude locations of the cell centers of the +#' grid of 'var', in ascending or descending order (same as 'var'). 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). +#'@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 +#' 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'. +#'@param varv Array of the meridional component of wind/current/other field +#' with the same dimensions as 'var'. +#'@param latlims Latitudinal limits of the figure.\cr +#' Example : c(60, 90) for the North Pole\cr +#' c(-90,-60) for the South Pole +#'@param toptitle Top title of the figure, scalable with parameter +#' 'title_scale'. +#'@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'. +#'@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 +#' 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 +#' 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 +#' 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 filled.continents Colour to fill in drawn projected continents. Takes +#' the value gray(0.5) by default. If set to FALSE, continents are not +#' filled in. +#'@param coast_color Colour of the coast line of the drawn projected +#' 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 +#' 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 +#' contour curves for the array provided in 'contours'. If it is a number, it +#' represents the number of breaks (n) that defines (n - 1) intervals to +#' classify 'contours'. +#'@param contour_lwd Line width of the contour curves provided via 'contours' +#' and 'brks2'. The default value is 0.5. +#'@param contour_color Line color of the contour curves provided via 'contours' +#' 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 +#' contour labels (TRUE) or not (FALSE) when 'contours' is used. The default +#' value is TRUE. +#'@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 +#' 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 +#' layers via the parameter 'dot_symbol'. +#'@param dot_symbol Single character/number or vector of characters/numbers +#' that correspond to each of the symbol layers specified in parameter 'dots'. +#' If a single value is specified, it will be applied to all the layers in +#' 'dots'. Takes 15 (centered square) by default. See 'pch' in par() for +#' additional accepted options. +#'@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 intlat Interval between latitude lines (circles), in degrees. +#' Defaults to 10. +#'@param arr_subsamp A number as subsampling factor to select a subset of arrows +#' in 'varu' and 'varv' to be drawn. Only one out of arr_subsamp arrows will +#' be drawn. The default value is 1. +#'@param arr_scale A number as scale factor for drawn arrows from 'varu' and +#' 'varv'. The default value is 1. +#'@param arr_ref_len A number of the length of the refence arrow to be drawn as +#' legend at the bottom of the figure (in same units as 'varu' and 'varv', only +#' affects the legend for the wind or variable in these arrays). The default +#' value is 15. +#'@param arr_units Units of 'varu' and 'varv', to be drawn in the legend. +#' Takes 'm/s' by default. +#'@param arr_scale_shaft A number for the scale of the shaft of the arrows +#' (which also depend on the number of figures and the arr_scale parameter). +#' The default value is 1. +#'@param arr_scale_shaft_angle A number for the scale of the angle of the +#' shaft of the arrows (which also depend on the number of figure and the +#' arr_scale parameter). The default value is 1. +#'@param drawleg Whether to plot a color bar (legend, key) or not. +#' Defaults to TRUE. +#'@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. +#'@param boxcol Colour of the box lines. A vector with a colour for each of +#' the boxes is also accepted. Defaults to 'purple2'. +#'@param boxlwd Line width of the box lines. A vector with a line width for +#' each of the boxes is also accepted. Defaults to 5. +#'@param margin_scale Scale factor for the margins to be added to the plot, +#' with the format c(y1, x1, y2, x2). Defaults to rep(1, 4). If drawleg = TRUE, +#' margin_scale[1] is subtracted 1 unit. +#'@param title_scale Scale factor for the figure top title. Defaults to 1. +#'@param numbfig Number of figures in the layout the plot will be put into. +#' A higher numbfig will result in narrower margins and smaller labels, +#' axe labels, ticks, thinner lines, ... Defaults to 1. +#'@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 +#' (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 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 \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 +#' csi cxy err family fg font font.axis font.lab font.main font.sub lend +#' lheight ljoin lmitre mex mfcol mfrow mfg mkh omd omi page pch pin plt pty +#' smo srt tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@return +#'\item{brks}{ +#' Breaks used for colouring the map (and legend if drawleg = TRUE). +#'} +#'\item{cols}{ +#' Colours used for colouring the map (and legend if drawleg = TRUE). Always +#' of length length(brks) - 1. +#'} +#'\item{col_inf}{ +#' Colour used to draw the lower triangle end in the colour bar (NULL if not +#' drawn at all). +#'} +#'\item{col_sup}{ +#' Colour used to draw the upper triangle end in the colour bar (NULL if not +#' drawn at all). +#'} +#' +#'@examples +#'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, +#' toptitle = "This is the title") +#'@import mapproj utils +#'@importFrom grDevices dev.cur dev.new dev.off gray +#'@importFrom stats median +#' @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, ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # Preliminar check of dots, lon, lat + if (!is.null(dots)) { + if (!is.array(dots) || !(length(dim(dots)) %in% c(2, 3))) { + stop("Parameter 'dots' must be a logical array with two or three dimensions.") + } + if (length(dim(dots)) == 2) { + dim(dots) <- c(1, dim(dots)) + } + } + if (!is.numeric(lon) || !is.numeric(lat)) { + stop("Parameters 'lon' and 'lat' must be numeric vectors.") + } + + # Check var + if (!is.array(var)) { + stop("Parameter 'var' must be a numeric array.") + } + if (length(dim(var)) > 2) { + var <- drop(var) + dim(var) <- head(c(dim(var), 1, 1), 2) + } + 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.") + } + dims <- dim(var) + + # Check varu and varv + if (!is.null(varu) && !is.null(varv)) { + if (!is.array(varu) || !(length(dim(varu)) == 2)) { + stop("Parameter 'varu' must be a numerical array with two dimensions.") + } + if (!is.array(varv) || !(length(dim(varv)) == 2)) { + stop("Parameter 'varv' must be a numerical array with two dimensions.") + } + } else if (!is.null(varu) || !is.null(varv)) { + stop("Only one of the components 'varu' or 'varv' has been provided. Both must be provided.") + } + + 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'.") + } + if (dim(varv)[1] != dims[1] || dim(varv)[2] != dims[2]) { + stop("Parameter 'varv' must have same number of longitudes and latitudes as 'var'.") + } + } + + # Transpose the input matrices because the base plot functions work directly + # 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) + 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) + } + } + + # 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'.") + } + + # 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'.") + } + + # Prepare sorted lon/lat and other arguments + latb <- sort(lat, index.return = TRUE) + lonb <- sort(lon, index.return = TRUE) + latmin <- floor(min(lat) / 10) * 10 + latmax <- ceiling(max(lat) / 10) * 10 + lonmin <- floor(min(lon) / 10) * 10 + lonmax <- ceiling(max(lon) / 10) * 10 + + # Check latlims + if (!is.numeric(latlims) || length(latlims) != 2) { + stop("Parameter 'latlims' must be a numeric vector with two elements.") + } + latlims <- sort(latlims) + center_at <- 90 * sign(latlims[which.max(abs(latlims))]) + if (max(abs(latlims - center_at)) > 90 + 20) { + stop("The range specified in 'latlims' is too wide. 110 degrees supported maximum.") + } + dlon <- median(lonb$x[2:dims[1]] - lonb$x[1:(dims[1] - 1)]) / 2 + dlat <- median(latb$x[2:dims[2]] - latb$x[1:(dims[2] - 1)]) / 2 + original_last_lat <- latlims[which.min(abs(latlims))] + last_lat <- latb$x[which.min(abs(latb$x - original_last_lat))] - dlat * sign(center_at) + latlims[which.min(abs(latlims))] <- last_lat + + # Subset lat by latlims + lat_plot_ind <- which(lat >= latlims[1] & lat <= latlims[2]) + latb_plot_ind <- which(latb$x >= latlims[1] & latb$x <= latlims[2]) + + # Check toptitle + if (is.null(toptitle) || is.na(toptitle)) { + toptitle <- '' + } + if (!is.character(toptitle)) { + stop("Parameter 'toptitle' must be a character string.") + } + + # Check sizetit + if (!is.null(sizetit)) { + warning("Parameter 'sizetit' is obsolete. Use 'title_scale' instead.") + if (!is.numeric(sizetit) || length(sizetit) != 1) { + stop("Parameter 'sizetit' must be a single numeric value.") + } + title_scale <- sizetit + } + + # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks + # draw_separators, triangle_ends_scale, label_scale, units, units_scale, + # bar_label_digits + # Build: brks, cols, bar_limits, col_inf, col_sup + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + colorbar <- ColorBarContinuous(brks, cols, FALSE, subsampleg, bar_limits, var_limits, + triangle_ends, col_inf, col_sup, color_fun, FALSE, + extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, + 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) + 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)) + + # Check colNA + if (is.null(colNA)) { + if ('na_color' %in% names(attributes(cols))) { + colNA <- attr(cols, 'na_color') + if (!.IsColor(colNA)) { + stop("The 'na_color' provided as attribute of the colour vector must be a valid colour identifier.") + } + } else { + colNA <- 'pink' + } + } else if (!.IsColor(colNA)) { + stop("Parameter 'colNA' must be a valid colour identifier.") + } + + # Check filled.continents + if (!.IsColor(filled.continents) && !is.logical(filled.continents)) { + stop("Parameter 'filled.continents' must be logical or a colour identifier.") + } else if (!is.logical(filled.continents)) { + continent_color <- filled.continents + filled.continents <- TRUE + } else if (filled.continents) { + continent_color <- gray(0.5) + } + + # Check coast_color + if (is.null(coast_color)) { + if (filled.continents) { + coast_color <- continent_color + } else { + coast_color <- 'black' + } + } + if (!.IsColor(coast_color)) { + stop("Parameter 'coast_color' must be a valid colour identifier.") + } + + # Check coast_width + if (!is.numeric(coast_width)) { + stop("Parameter 'coast_width' must be numeric.") + } + # Check contours + if (!is.null(contours)) { + if (!is.array(contours)) { + stop("Parameter 'contours' must be a numeric array.") + } + if (length(dim(contours)) > 2) { + contours <- drop(contours) + dim(contours) <- head(c(dim(contours), 1, 1), 2) + } + if (length(dim(contours)) > 2) { + stop("Parameter 'contours' must be a numeric array with two dimensions.") + } else if (length(dim(contours)) < 2) { + stop("Parameter 'contours' must be a numeric array with two dimensions.") + } + # Transpose the input matrices because the base plot functions work directly + # with dimensions c(lon, lat). + 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'.") + } + } + + # Check brks2 + if (!is.null(contours)) { + if (is.null(brks2)) { + ll <- signif(min(contours, na.rm = TRUE), 2) + ul <- signif(max(contours, na.rm = TRUE), 2) + brks2 <- unique(signif(seq(ll, ul, length.out = length(brks)), 2)) + + } else if (is.numeric(brks2) & length(brks2) == 1) { + ll <- signif(min(contours, na.rm = TRUE), 2) + ul <- signif(max(contours, na.rm = TRUE), 2) + brks2 <- unique(signif(seq(ll, ul, length.out = brks2), 2)) + } else if (!is.numeric(brks2)) { + stop("Parameter 'brks2' must be a numeric value or vector.") + } + } + + # Check contour_lwd + if (!is.numeric(contour_lwd)) { + stop("Parameter 'contour_lwd' must be numeric.") + } + + # Check contour_color + if (!.IsColor(contour_color)) { + stop("Parameter 'contour_color' must be a valid colour identifier.") + } + + # Check contour_lty + if (!is.numeric(contour_lty) && !is.character(contour_lty)) { + 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_label_scale + if (!is.numeric(contour_label_scale)) { + stop("Parameter 'contour_label_scale' must be numeric.") + } + + # 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'.") + } + if (!is.numeric(dot_symbol) && !is.character(dot_symbol)) { + stop("Parameter 'dot_symbol' must be a numeric or character string vector.") + } + if (length(dot_symbol) == 1) { + dot_symbol <- rep(dot_symbol, dim(dots)[1]) + } else if (length(dot_symbol) < dim(dots)[1]) { + stop("Parameter 'dot_symbol' does not contain enough symbols.") + } + if (!is.numeric(dot_size)) { + stop("Parameter 'dot_size' must be numeric.") + } + if (length(dot_size) == 1) { + dot_size <- rep(dot_size, dim(dots)[1]) + } else if (length(dot_size) < dim(dots)[1]) { + stop("Parameter 'dot_size' does not contain enough sizes.") + } + } + + # Check intlat + if (!is.numeric(intlat)) { + stop("Parameter 'intlat' must be numeric.") + } + + # Check arrow parameters + if (!is.numeric(arr_subsamp)) { + stop("Parameter 'arr_subsamp' must be numeric.") + } + if (!is.numeric(arr_scale)) { + stop("Parameter 'arr_scale' must be numeric.") + } + if (!is.numeric(arr_ref_len)) { + stop("Parameter 'arr_ref_len' must be numeric.") + } + if (!is.character(arr_units)) { + stop("Parameter 'arr_units' must be character.") + } + if (!is.numeric(arr_scale_shaft)) { + stop("Parameter 'arr_scale_shaft' must be numeric.") + } + if (!is.numeric(arr_scale_shaft_angle)) { + stop("Parameter 'arr_scale_shaft_angle' must be numeric.") + } + + # Check legend parameters + if (!is.logical(drawleg)) { + stop("Parameter 'drawleg' must be logical.") + } + + # Check box parameters + if (!is.null(boxlim)) { + if (!is.list(boxlim)) { + boxlim <- list(boxlim) + } + for (i in 1:length(boxlim)) { + if (!is.numeric(boxlim[[i]]) || length(boxlim[[i]]) != 4) { + stop("Parameter 'boxlim' must be a a numeric vector or a list of numeric vectors of length 4 (with W, S, E, N box limits).") + } + } + if (!is.character(boxcol)) { + stop("Parameter 'boxcol' must be a character string or a vector of character strings.") + } else { + if (length(boxlim) != length(boxcol)) { + if (length(boxcol) == 1) { + boxcol <- rep(boxcol, length(boxlim)) + } else { + stop("Parameter 'boxcol' must have a colour for each box in 'boxlim' or a single colour for all boxes.") + } + } + } + if (!is.numeric(boxlwd)) { + stop("Parameter 'boxlwd' must be numeric.") + } else { + if (length(boxlim) != length(boxlwd)) { + if (length(boxlwd) == 1) { + boxlwd <- rep(boxlwd, length(boxlim)) + } else { + stop("Parameter 'boxlwd' must have a line width for each box in 'boxlim' or a single line width for all boxes.") + } + } + } + } + + # Check margin_scale + if (!is.numeric(margin_scale) || length(margin_scale) != 4) { + stop("Parameter 'margin_scale' must be a numeric vector of length 4.") + } + + # Check title_scale + if (!is.numeric(title_scale)) { + stop("Parameter 'title_scale' must be numeric.") + } + + # Check numbfig + if (!is.null(numbfig)) { + if (!is.numeric(numbfig)) { + stop("Parameter 'numbfig' must be numeric.") + } else { + numbfig <- round(numbfig) + scale <- 1 / numbfig ** 0.3 + title_scale <- title_scale * scale + margin_scale <- margin_scale * scale + dot_size <- dot_size * scale + arr_scale <- arr_scale * scale + contour_label_scale <- contour_label_scale * scale + contour_lwd <- contour_lwd * scale + } + } + + # + # Plotting the map + # ~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # + # Defining the layout + # ~~~~~~~~~~~~~~~~~~~~~ + # + if (drawleg) { + margin_scale[1] <- margin_scale[1] - 1 + } + margins <- rep(0.2, 4) * margin_scale + cex_title <- 2 * title_scale + if (toptitle != '') { + margins[3] <- margins[3] + cex_title + 1 + } + bar_extra_margin[1] <- bar_extra_margin[1] + margins[1] + bar_extra_margin[3] <- bar_extra_margin[3] + margins[3] + + if (!is.null(varu)) { + margins[1] <- margins[1] + 2.2 * units_scale + } + + if (drawleg) { + layout(matrix(1:2, ncol = 2, nrow = 1), widths = c(8, 2)) + } + # Load the user parameters + par(userArgs) + par(mar = margins, las = 0) + coast <- map("world", interior = FALSE, projection = "stereographic", + orientation = c(center_at, 0, 0), fill = filled.continents, + xlim = c(-180,180), ylim = latlims, wrap = TRUE, plot = FALSE) + # Compute the bounding circle + limit <- abs(mapproj::mapproject(0, last_lat, projection = 'stereographic', + orientation = c(center_at, 0, 0))$y) + for (i in 1:length(coast$x)) { + distance <- sqrt(coast$x[i]**2 + coast$y[i]**2) + if (!is.na(distance)) { + if (distance > limit) { + coast$x[i] <- coast$x[i] / distance * limit + coast$y[i] <- coast$y[i] / distance * limit + } + } + } + xcircle <- c() + ycircle <- c() + for (i in 0:500) { + xcircle <- c(xcircle, sin(2 * pi / 500 * i) * limit) + ycircle <- c(ycircle, cos(2 * pi / 500 * i) * limit) + } + circle <- list(x = xcircle, y = ycircle) + # Plot circle to set up device + plot(circle, type= 'l', axes = FALSE, lwd = 1, col = gray(0.2), asp = 1, + xlab = '', ylab = '', main = toptitle, cex.main = cex_title) + col_inf_image <- ifelse(is.null(col_inf), colNA, col_inf) + col_sup_image <- ifelse(is.null(col_sup), colNA, col_sup) + # Draw the data polygons + for (jx in 1:dims[1]) { + for (jy in 1:length(lat_plot_ind)) { + coord <- mapproj::mapproject(c(lon[jx] - dlon, lon[jx] + dlon, + 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)) { + col <- colNA + } else if (var[jx, lat_plot_ind[jy]] <= brks[1]) { + col <- col_inf_image + } else if (var[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)]) + col <- cols[ind] + } + polygon(coord, col = col, border = NA) + } + } + + # contours + if (!is.null(contours)) { + nbrks2 <- length(brks2) + for (n_brks2 in 1:nbrks2) { + cl <- grDevices::contourLines(x = lonb$x, y = latb$x[latb_plot_ind], + z = contours[lonb$ix, latb$ix[latb_plot_ind]], + levels = brks2[n_brks2]) + if (length(cl) > 0) { + for (i in seq_along(cl)) { + xy <- mapproj::mapproject(cl[[i]]$x, cl[[i]]$y) + xc <- xy$x + yc <- xy$y + nc <- length(xc) + lines(xc, yc, col = contour_color, lwd = contour_lwd, lty = contour_lty) + + # draw label + if (contour_label_draw) { + label_char <- as.character(signif(brks2[n_brks2], 2)) + ## Check if the label has enough space to draw first. + last_slope <- Inf + put_label <- FALSE + for (p1 in 1:nc) { + p2 <- p1 + while (p2 < nc) { + dist <- sqrt((yc[p2] - yc[p1])^2 + (xc[p2] - xc[p1])^2) + if (!is.infinite(dist) & + dist > 1.2 * strwidth(label_char, cex = contour_label_scale)) { + put_label <- TRUE + slope <- (yc[p2] - yc[p1]) / (xc[p2] - xc[p1]) + # flatter is better + if (abs(slope) < abs(last_slope)) { + last_slope <- slope + last_p1 <- p1 + last_p2 <- p2 + } + break # Found a proper space for label. Move to the next p1. + } + p2 <- p2 + 1 # If the dist is not enough, try next p2. + } + } + + ## If label can be put + if (put_label) { + # Label should be at the middle of p1 and p2 + p_label <- (last_p1 + last_p2) / 2 + # string rotation angle is calculated from the slope + srt_label <- atan(last_slope) * 57.2958 # radian to degree + + #NOTE: 'cex' in text() is the scale factor. The actual size will be + # contour_label_scale * par("cex") + text(xc[p_label], yc[p_label], label_char, + cex = contour_label_scale, col = contour_color, srt = srt_label) + } + } + } + } + } + } + + # Draw the dots + 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]) + 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]]) + points(points_proj$x, points_proj$y, + pch = dot_symbol[counter], + cex = dot_size[counter] * 3 / sqrt(sqrt(sum(lat >= latlims[which.min(abs(latlims))]) * length(lon))), + lwd = dot_size[counter] * 3 / sqrt(sqrt(sum(lat >= latlims[which.min(abs(latlims))]) * length(lon)))) + } + } + + # Draw the continents, grid and bounding circle + if (filled.continents) { + old_lwd <- par('lwd') + par(lwd = coast_width) + polygon(coast, col = continent_color, border = coast_color) + par(lwd = old_lwd) + } else { + lines(coast, col = coast_color, lwd = coast_width) + } + mapproj::map.grid(lim = c(-180, 180, latlims), nx = 18, + ny = ceiling((latlims[2] - latlims[1]) / intlat), + col = 'lightgrey', labels = FALSE) + polygon(circle, border = 'black') + # Draw boxes on the map + if (!is.null(boxlim)) { + counter <- 1 + for (box in boxlim) { + if (box[1] > box[3]) { + box[1] <- box[1] - 360 + } + if (length(box) != 4) { + stop(paste("The", counter, "st box defined in the parameter 'boxlim' is ill defined.")) + } else if (center_at == 90 && (box[2] < original_last_lat || + box[4] > center_at) || + center_at == -90 && (box[4] > original_last_lat || + box[2] < center_at)) { + stop(paste("The limits of the", counter, + "st box defined in the parameter 'boxlim' are invalid.")) + } else { + mapproj::map.grid(lim = c(box[1], box[3], box[2], box[4]), + nx = 2, ny = 2, pretty = FALSE, + col = boxcol[counter], lty = "solid", + lwd = boxlwd[counter], labels = FALSE) + } + counter <- counter + 1 + } + } + + # + # PlotWind + # ~~~~~~~~~~ + # + if (!is.null(varu) && !is.null(varv)) { + # Create a two dimention array of longitude and latitude + lontab <- InsertDim(lonb$x, 2, length(latb$x[latb_plot_ind]), name = 'lat') + lattab <- InsertDim(latb$x[latb_plot_ind], 1, length(lonb$x), name = 'lon') + # Select a subsample of the points to an arrow for each "subsample" grid point + # latmin has the most arrows, and latmax (polar point) has no arrow. + sublon_max <- seq(1, length(lonb$x), arr_subsamp) + sublat_max <- seq(1, length(latb$x[latb_plot_ind]), arr_subsamp) + ## calculate the length of sublon for each lat + arr_num_at_lat <- round(seq(length(sublon_max), 0, length.out = length(lat[lat_plot_ind]))) + ## If south hemisphere, revserse arr_num_at_lat (smaller lat has less arrows) + if (center_at < 0) { + arr_num_at_lat <- rev(arr_num_at_lat) + } + for (n_lat in seq_along(sublat_max)) { + sublat <- sublat_max[n_lat] + if (arr_num_at_lat[sublat] != 0) { + sublon <- round(seq(1, length(lon), length.out = arr_num_at_lat[sublat])) + # end points (start points + varu/varv) + uaux <- lontab[sublon, sublat] + varu[lonb$ix, latb$ix[latb_plot_ind]][sublon, sublat] * 0.5 * arr_scale + vaux <- lattab[sublon, sublat] + varv[lonb$ix, latb$ix[latb_plot_ind]][sublon, sublat] * 0.5 * arr_scale + + # project the start and end points on stereographic + xy0 <- mapproj::mapproject(lontab[sublon, sublat], lattab[sublon, sublat]) + xy1 <- mapproj::mapproject(uaux, vaux) + xc0 <- xy0$x + yc0 <- xy0$y + xc1 <- xy1$x + yc1 <- xy1$y + nc <- length(xc0) + + lenshaft <- 0.18 * arr_scale * arr_scale_shaft + angleshaft <- 12 * arr_scale_shaft_angle + + # Plot Wind + arrows(xc0, yc0, + xc1, yc1, + angle = angleshaft, + length = lenshaft) + } + } + + # Plot an arrow at the bottom of the plot for the legend + # Put arrow at lon = 0, lat = lowest lat (i.e., biggest circle) - (latmax - latmin)/8 + delta_arr_lengend <- (0.5 * arr_scale * arr_ref_len) + posarlon <- c(0 - delta_arr_lengend / 2, 0 + delta_arr_lengend / 2) + posarlat <- rep(min(abs(lat[lat_plot_ind])) - diff(range(lat[lat_plot_ind]))/8, 2) +#NOTE: The following lines put legend at bottom left corner. But it's hard to put it horizontal +# delta_arr_lengend <- (0.5 * arr_scale * arr_ref_len)/sqrt(2) +# posarlat[1] <- posarlat[1] - delta_arr_lengend / 2 +# posarlat[2] <- posarlat[2] + delta_arr_lengend / 2 + ## turn into stereographic + arr_lengend <- mapproj::mapproject(posarlon, posarlat) + + arrows(arr_lengend$x[1], arr_lengend$y[1], + arr_lengend$x[2], arr_lengend$y[2], + length = lenshaft, angle = angleshaft, + xpd = TRUE) + #save the parameter value + xpdsave <- par('xpd') + #desactivate xpd to be able to plot in margen + par(xpd = NA) + #plot text + mtext(paste(as.character(arr_ref_len), arr_units, sep = ""), + line = min(arr_lengend$y) + 1.8 * abs(min(arr_lengend$y)), + side = 1, + at = mean(arr_lengend$x), + cex = units_scale) + #come back to the previous xpd value + par(xpd = xpdsave) + + } + + + # + # Colorbar + # ~~~~~~~~~~ + # + 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, + 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) + } + + # If the graphic was saved to file, close the connection with the device + if (!is.null(fileout)) dev.off() + + invisible(list(brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup)) +} diff --git a/R/VizVsLTime.R b/R/VizVsLTime.R new file mode 100644 index 0000000000000000000000000000000000000000..7dfdae95f170519e9cb1522f83dce5df3c6fee75 --- /dev/null +++ b/R/VizVsLTime.R @@ -0,0 +1,256 @@ +#'Plot a score along the forecast time with its confidence interval +#' +#'Plot the correlation (\code{Corr()}), the root mean square error +#'(\code{RMS()}) between the forecast values and their observational +#'counterpart, the slope of their trend (\code{Trend()}), the +#'InterQuartile range, maximum-mininum, standard deviation or median absolute +#'Deviation of the ensemble members (\code{Spread()}), or the ratio between +#'the ensemble spread and the RMSE of the ensemble mean (\code{RatioSDRMS()}) +#'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 +#' (nexp/nmod, 3/4 ,nltime)\cr +#' or (nexp/nmod, nobs, 3/4 ,nltime). +#'@param toptitle Main title, optional. +#'@param ytitle Title of Y-axis, optional. +#'@param monini Starting month between 1 and 12. Default = 1. +#'@param freq 1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12. +#'@param nticks Number of ticks and labels on the x-axis, optional. +#'@param limits c(lower limit, upper limit): limits of the Y-axis, optional. +#'@param listexp List of experiment names, optional. +#'@param listobs List of observation names, optional. +#'@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. +#' Default = TRUE. +#'@param siglev TRUE/FALSE if significance level should replace confidence +#' interval.\cr +#' Default = FALSE. +#'@param sizetit Multiplicative factor to change title size, optional. +#'@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, +#' pdf, bmp and tiff. The default value is NULL. +#'@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 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 ... 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 +#' csi cxy err family fg fig font font.axis font.lab font.main font.sub +#' lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +#' smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +#' For more information about the parameters see `par`. +#' +#'@details +#'Examples of input:\cr +#'Model and observed output from \code{Load()} then \code{Clim()} then +#'\code{Ano()} then \code{Smoothing()}:\cr +#'(nmod, nmemb, nsdate, nltime) and (nobs, nmemb, nsdate, nltime)\cr +#'then averaged over the members\cr +#'\code{Mean1Dim(var_exp/var_obs, posdim = 2)}:\cr +#'(nmod, nsdate, nltime) and (nobs, nsdate, nltime)\cr +#'then passed through\cr +#' \code{Corr(exp, obs, posloop = 1, poscor = 2)} or\cr +#' \code{RMS(exp, obs, posloop = 1, posRMS = 2)}:\cr +#' (nmod, nobs, 3, nltime)\cr +#'would plot the correlations or RMS between each exp & each obs as a function +#'of the forecast time. +#' +#'@examples +#'clim <- s2dv::Clim(ts_temp$exp, ts_temp$obs, time_dim = "sdate", +#' dat_dim = c("dat", "member")) +#'ano_exp <- Ano(ts_temp$exp, clim$clim_exp) +#'ano_obs <- Ano(ts_temp$obs, clim$clim_obs) +#'corr_ano <- s2dv::Corr(s2dv::MeanDims(ano_exp, 'member'), ano_obs, +#' time_dim = 'sdate', dat_dim = 'dat') +#'input_cor <- array(dim = c(dat = 1, 4, time = 5)) +#'input_cor[, 1, ] <- corr_ano$conf.lower[, 1, 1, ] +#'input_cor[, 2, ] <- corr_ano$corr[, 1, 1, ] +#'input_cor[, 3, ] <- corr_ano$conf.upper[, 1, 1, ] +#'input_cor[, 4, ] <- corr_ano$p.val[, 1, 1, ] +#'VizVsLTime(input_cor, toptitle = "Correlation", +#' monini = 11, limits = c(-1, 2), listexp = 'SEAS5', +#' listobs = 'ERA5', biglab = FALSE, hlines = c(-1, 0, 1)) +#' +#'@importFrom grDevices dev.cur dev.new dev.off +#'@importFrom stats ts +#'@importFrom s2dv InsertDim +#'@export +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, ...) { + # 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") + userArgs <- .FilterUserGraphicArgs(excludedArgs, ...) + + # If there is any filenames to store the graphics, process them + # to select the right device + if (!is.null(fileout)) { + deviceInfo <- .SelectDevice(fileout = fileout, width = width, height = height, units = size_units, res = res) + saveToFile <- deviceInfo$fun + fileout <- deviceInfo$files + } + + # + # 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 (is.null(limits) == TRUE) { + if (all(is.na(var > 0))) { + ll <- ul <- 0 + } else { + ll <- min(var, na.rm = TRUE) + ul <- max(var, na.rm = TRUE) + } + if (biglab) { + ul <- ul + 0.4 * (ul - ll) + } else { + ul <- ul + 0.3 * (ul - ll) + } + } else { + ll <- limits[1] + ul <- limits[2] + } + lastyear <- (monini + (nleadtime - 1) * 12 / freq - 1) %/% 12 + lastmonth <- (monini + (nleadtime - 1) * 12 / freq - 1) %% 12 + 1 + empty_ts <- ts(start = c(0000, (monini - 1) %/% (12 / freq) + 1), + end = c(lastyear, (lastmonth - 1) %/% (12 / freq) + 1), + frequency = freq) + empty <- array(dim = length(empty_ts)) + # + # Define some plot parameters + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + if (is.null(nticks)) { + if (biglab) { + nticks <- 5 + } else { + nticks <- 10 + } + } + labind <- seq(1, nleadtime, max(nleadtime %/% nticks, 1)) + months <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", + "Oct", "Nov", "Dec") + labyear <- ((labind - 1) * 12 / freq + monini - 1) %/% 12 + labmonth <- months[((labind - 1) * 12 / freq + monini -1 ) %% 12 + 1] + for (jx in 1:length(labmonth)) { + y2o3dig <- paste("0", as.character(labyear[jx]), sep = "") + labmonth[jx] <- paste(labmonth[jx], "\nYr ", substr(y2o3dig, nchar(y2o3dig) + - 1, nchar(y2o3dig)), sep = "") + } + color <- c("red1", "dodgerblue1", "green1", "orange1", "lightblue1", + "deeppink1", "mediumpurple1", "lightgoldenrod1", "olivedrab1", + "mediumorchid1") + type <- c(1, 3, 2, 4) + thickness <- array(dim = c(4, 4)) + thickness[, 1] <- c(1, 2, 1, 1.5) + thickness[, 2] <- c(8, 12, 8, 10) + thickness[, 3] <- thickness[, 1] + thickness[, 4] <- c(4, 6, 4, 5) + if (siglev == TRUE) { + lines <- c("n", "l", "n", "l") + } else { + lines <- c("l", "l", "l", "n") + } + # + # Define plot layout + # ~~~~~~~~~~~~~~~~~~~~ + # + + # Open connection to graphical device + if (!is.null(fileout)) { + saveToFile(fileout) + } else if (names(dev.cur()) == 'null device') { + dev.new(units = size_units, res = res, width = width, height = height) + } + + # Load the user parameters + par(userArgs) + + if (biglab) { + par(mai = c(1.25, 1.4, 0.5, 1), mgp = c(4, 2.5, 0)) + par(cex = 1.3, cex.lab = 2, cex.axis = 1.8) + cexmain <- 2.2 + legsize <- 1.5 + } else { + par(mai = c(1, 1.1, 0.5, 0), mgp = c(3, 1.8, 0)) + par(cex = 1.3, cex.lab = 1.5, cex.axis = 1.1) + cexmain <- 1.5 + legsize <- 1 + } + plot(empty, ylim = c(ll, ul), xlab = "Time (months)", ylab = ytitle, + main = toptitle, cex.main = cexmain*sizetit, axes = FALSE) + axis(1, at = labind, labels = labmonth) + axis(2) + box() + if (is.null(hlines) != TRUE) { + for (jy in 1:length(hlines)) { + par(new = TRUE) + abline(h = hlines[jy]) + } + } + # + # Loop on experimental & observational data + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + # + legendnames <- array(dim = nobs * nexp) + legendthick <- array(dim = nobs * nexp) + legendsty <- array(dim = nobs * nexp) + legendcol <- array(dim = nobs * nexp) + ind <- 1 + if (show_conf == TRUE) { + start_line <- dim(var)[3] + end_line <- 1 + } else { + start_line <- 2 + end_line <- 2 + } + for (jt in seq(start_line, end_line, -1)) { + ind <- 1 + 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), + col = color[jexp], lty = type[jobs], lwd = thickness[jobs, jt], + ylab = "", xlab = "", axes = FALSE) + legendnames[ind] <- paste(listexp[jexp], 'vs', listobs[jobs]) + legendthick[ind] <- thickness[jobs, 1] * 3 + legendsty[ind] <- type[jobs] + legendcol[ind] <- color[jexp] + ind <- ind + 1 + } + } + } + if (leg) { + if (nobs == 1) { + legendnames <- listexp[1:nexp] + } + legend(1, ul, legendnames, lty = legendsty, lwd = legendthick, + col = legendcol, cex = legsize) + } + + # If the graphic was saved to file, close the connection with the device + if(!is.null(fileout)) dev.off() +} diff --git a/R/sample_tas.R b/R/sample_tas.R new file mode 100644 index 0000000000000000000000000000000000000000..3c67204435d9d7371f233d38dec135e724ccf6b0 --- /dev/null +++ b/R/sample_tas.R @@ -0,0 +1,141 @@ +#'Sample Of Experimental And Observational Climate Spatial Data +#' +#'This sample data contain gridded seasonal forecast and corresponding +#'observational data from ECMWF-System 5 forecast system and ERA-5 +#'reconstruction. +#'Specifically, for the monthly mean 2-meter temperature ("tas") variable, the +#'first 3 ensemble members, the first 5 forecast time steps from November +#'initial month, year 2000 to 2005, the Iberian Peninsula region +#'(35N-45N, 10W-5E). +#' +#'The package "startR" is used to load the data from the data esarchive in the +#'Earth Sciences Department of Barcelona Supercomputing Center. +#' +#'\preformatted{ +#' +#' # 1. Load libraries and define common variables +#' library(startR) +#' library(CSTools) +#' +#' sdates <- sapply(2000:2005, function(x) paste0(x, '1101')) +#' lonmax <- 5 +#' lonmin <- -10 +#' latmax <- 45 +#' latmin <- 35 +#' +#' # 2. Load exp +#' +#' repos_exp <- paste0('/esarchive/exp/ecmwf/system5c3s/monthly_mean/', +#' '$var$_f6h/$var$_$sdate$.nc') +#' +#' exp <- Start(dat = repos_exp, +#' var = 'tas', +#' member = indices(1:3), +#' sdate = sdates, +#' time = indices(1:5), +#' lat = values(list(latmin, latmax)), +#' lat_reorder = Sort(decreasing = FALSE), +#' lon = values(list(lonmin, lonmax)), +#' lon_reorder = CircularSort(-180, 180), +#' synonims = list(lon = c('lon', 'longitude'), +#' lat = c('lat', 'latitude'), +#' member = c('member', 'ensemble')), +#' return_vars = list(lat = NULL, lon = NULL, time = 'sdate'), +#' retrieve = TRUE) +#' +#' +#' # 3. Load obs +#' +#' exp_time <- attr(exp, "Variables")$common$time +#' obs_date <- array(format(exp_time, "%Y%m"), dim = dim(exp_time)) +#' +#' path_obs <- '/esarchive/recon/ecmwf/era5/monthly_mean/$var$_f1h-r1440x721cds/$var$_$date$.nc' +#' obs <- Start(dat = path_obs, +#' var = 'tas', +#' date = obs_date, +#' split_multiselected_dims = TRUE, +#' lat = values(list(latmin, latmax)), +#' lat_reorder = Sort(decreasing = FALSE), +#' lon = values(list(lonmin, lonmax)), +#' lon_reorder = CircularSort(-180, 180), +#' synonims = list(lon = c('lon', 'longitude'), +#' lat = c('lat', 'latitude')), +#' transform = CDORemapper, +#' transform_extra_cells = 2, +#' transform_params = list(grid = 'r360x181', +#' method = 'conservative'), +#' transform_vars = c('lat', 'lon'), +#' return_vars = list(lon = NULL, lat = NULL, time = 'date'), +#' retrieve = TRUE) +#' +#' +#' # 4. Check data +#' +#' obs_time <- attr(obs,"Variables")$common$time +#' +#' identical(format(obs_time, "%Y%m"), format(exp_time, "%Y%m")) +#'#[1] TRUE +#' exp_lat <- attr(exp, "Variables")$common$lat +#' exp_lon <- attr(exp, "Variables")$common$lon +#' obs_lat <- attr(obs, "Variables")$common$lat +#' obs_lon <- attr(obs, "Variables")$common$lon +#' +#' all.equal(exp_lat, obs_lat, check.attributes = F) +#'#[1] TRUE +#' all.equal(exp_lon, obs_lon, check.attributes = F) +#'#[1] TRUE +#' +#' +#' # 5. Combine into one object +#' +#' map_temp <- list() +#' map_temp$exp <- exp +#' map_temp$obs <- obs +#' +#'} +#'@name map_temp +#'@docType data +NULL + +#'Sample Of Experimental And Observational Climate Time Series Data +#' +#'This sample data contain gridded seasonal forecast and corresponding +#'observational data from ECMWF-System 5 forecast system and ERA-5 +#'reconstruction. +#'Specifically, for the monthly mean 2-meter temperature ("tas") variable, the +#'first 3 ensemble members, the first 5 forecast time steps from November +#'initial month, year 2000 to 2005, spatial average of the Iberian Peninsula +#'region (35N-45N, 10W-5E). +#' +#'The package "startR" is used to load the data from the data esarchive in the +#'Earth Sciences Department of Barcelona Supercomputing Center +#'(check \code{map_temp}). Caclulate the weighted area-mean by function +#'\code{ClimProjDiags::WeightedMean}. +#' +#'\preformatted{ +#' +#' # 1. Load data "map_temp" first and load libraries +#' +#' library(ClimProjDiags) +#' +#' map_temp <- esviz::map_temp +#' attrs_exp <- attributes(map_temp$exp)[-1] +#' attrs_obs <- attributes(map_temp$obs)[-1] +#' +#' # 2. Calculate weighted area mean +#' +#' lats <- attr(map_temp$exp, "Variables")$common$lat +#' lons <- attr(map_temp$exp, "Variables")$common$lon +#' +#' ts_temp <- list() +#' ts_temp$exp <- WeightedMean(map_temp$exp, lon = lons, lat = lats) +#' ts_temp$obs <- WeightedMean(map_temp$obs, lon = lons, lat = lats) +#' +#' attributes(ts_temp$exp) <- c(attributes(ts_temp$exp), attrs_exp) +#' attributes(ts_temp$obs) <- c(attributes(ts_temp$obs), attrs_obs) +#' +#'} +#' +#'@name ts_temp +#'@docType data +NULL diff --git a/README.md b/README.md index bbe5b5edc46a27a630e65d2a8c853cca5fff5609..5929f90fa05a86661c13412b10f04ccd6f270e55 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,23 @@ -ClimPlot +esviz =============== -ClimPlot is an R plotting package for climate science. 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 integrated functinalities. +esviz is an R package developed by BSC-CNS Earth Science Department. +It includes several plotting functions for climate sciences, e.g., maps, time series, scorecards, etc. The functions can be used at all stages of the data analysis process and some specific types for the forecast verification. Some functions are origined from packages "s2dv" and "CSTools" but with more integrated functinalities. + +These functions are essential to: + - Quickly inspect the results of a newly produced experiment, i.e. to check +the physical consistency of the results. + - Assess the added value of a new prediction system, i.e. to compare new + results with a reference (observation, reconstruction or other experiment). + - Assess visually the significance of results, i.e. to display in a +user-friendly way confidence intervals and other statistics. + +The plotting functions, with a name starting with `Viz*`, can be categorized into different plot types they provide: + + - **Plotting time series**: `VizClim()`, `VizAno()`, +`VizVsLtime()`, `Viz2VarsVsLTime()`, `VizBoxWhisker()`, `VizACC()`. + - **Plotting maps**: `VizEquiMap()`, `VizRobinson()`, +`VizStereoMap()`, `VizAnimateMap()`, `VizLayout()`, `VizSection()`. Bug Report diff --git a/data/map_temp.rda b/data/map_temp.rda new file mode 100644 index 0000000000000000000000000000000000000000..ed3092875cd31c6b0b0bdfd383cb0be47edc5210 Binary files /dev/null and b/data/map_temp.rda differ diff --git a/data/ts_temp.rda b/data/ts_temp.rda new file mode 100644 index 0000000000000000000000000000000000000000..215e9c88e0d42f71761805974ef804fbe78896fe Binary files /dev/null and b/data/ts_temp.rda differ diff --git a/man/ClimPalette.Rd b/man/ClimPalette.Rd index 98b5031ae8bc32b45a8114c4f8f45e125f3e1964..dbd398dee50672deceab5e7a9fdc4f34623e4132 100644 --- a/man/ClimPalette.Rd +++ b/man/ClimPalette.Rd @@ -34,9 +34,9 @@ climate temperature variable plotting. \examples{ lims <- seq(-1, 1, length.out = 21) -ColorBar(lims, color_fun = climPalette('redyellow')) +cb <- ColorBarContinuous(lims, color_fun = ClimPalette('redyellow'), plot = FALSE) cols <- ClimColors(20) -ColorBar(lims, cols) +cb <- ColorBarContinuous(lims, cols, plot = FALSE) } diff --git a/man/ColorBarContinuous.Rd b/man/ColorBarContinuous.Rd index 78d6aa526f7b7394c20ee288b773a9081ddfb79d..f4dee97e0dd926b5c2de2fee3af25e5a09f26f50 100644 --- a/man/ColorBarContinuous.Rd +++ b/man/ColorBarContinuous.Rd @@ -190,5 +190,6 @@ format, see below). cols <- c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white", "white", "yellow", "orange", "red", "saddlebrown") lims <- seq(-1, 1, 0.2) -ColorBarContinuous(lims, cols) +cb <- ColorBarContinuous(lims, cols, plot = FALSE) + } diff --git a/man/ColorBarDiscrete.Rd b/man/ColorBarDiscrete.Rd index 9ba59d9721fa9c5cdbd236b489fb49db690a9b55..14c5ab67ae7a9b1e3bdd2cf0a44fbb6804bc3c08 100644 --- a/man/ColorBarDiscrete.Rd +++ b/man/ColorBarDiscrete.Rd @@ -93,6 +93,9 @@ colours (FALSE) or to also draw it on the current device (TRUE).} the colour rectancles of the colour bar (TRUE) or not (FALSE). FALSE by 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 the colour bar. The number of provided decimals will be conserved. Disregarded if 'plot = FALSE'.} @@ -149,9 +152,9 @@ given value of the field will be coloured in function of the interval it belongs to.\cr\cr } \examples{ -ColorBarDiscrete( +cb <- ColorBarDiscrete( brks = 0:4, cols = c("green1", "green2", "green3", "green4"), - vertical = F, labels = paste0('lev ', 1:4), label_scale = 1.5, - extra_margin = c(0.5, 2, 0.5, 2)) + vertical = FALSE, labels = paste0('lev ', 1:4), label_scale = 1.5, + extra_margin = c(0.5, 2, 0.5, 2), plot = FALSE) } diff --git a/man/PlotCombinedMap.Rd b/man/PlotCombinedMap.Rd index d9ec5badcb218b249348b3a51a261f16e12006a4..64614004bf6cff2a2f6c1ca8937c2f5a61f00ae5 100644 --- a/man/PlotCombinedMap.Rd +++ b/man/PlotCombinedMap.Rd @@ -14,7 +14,7 @@ PlotCombinedMap( brks = NULL, cols = NULL, bar_limits = NULL, - triangle_ends = c(F, F), + triangle_ends = c(FALSE, FALSE), col_inf = NULL, col_sup = NULL, col_unknown_map = "white", @@ -63,16 +63,29 @@ outside the range, it will be coloured with 'col_unknown_map'.} multiple maps are arranged. Only applies when 'maps' is provided as a 3-dimensional array. Takes the value 'map' by default.} -\item{brks}{Colour levels to be sent to PlotEquiMap. This parameter is +\item{brks}{Colour levels to be sent to VizEquiMap. This parameter is optional and adjusted automatically by the function.} -\item{cols}{List of vectors of colours to be sent to PlotEquiMap for the +\item{cols}{List of vectors of colours to be sent to VizEquiMap for the colour bar of each map. This parameter is optional and adjusted automatically by the function (up to 5 maps). The colours provided for each colour bar will be automatically interpolated to match the number of breaks. Each item in this list can be named, and the name will be used as title for the corresponding colour bar (equivalent to the parameter 'bar_titles').} +\item{bar_limits}{A numeric vector of 2 indicating the range of color bar. +The default is NULL, and the function will decide the range automatically.} + +\item{triangle_ends}{A logical vector of two indicating if the lower and upper +triangles of the color bar should be plotted. The default is +c(FALSE, FALSE).} + +\item{col_inf}{A character string of recognized color name or code indicating +the color of the lower triangle of the color bar. The default is NULL.} + +\item{col_sup}{A character string of recognized color name or code indicating +the color of the upper triangle of the color bar. The default is NULL.} + \item{col_unknown_map}{Colour to use to paint the grid cells for which a map is not possible to be chosen according to 'map_select_fun' or for those values that go beyond 'display_range'. Takes the value 'white' by default.} @@ -104,7 +117,11 @@ 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 -PlotEquiMap.} +VizEquiMap.} + +\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 +are margin lines. The default values are c(2, 0, 2, 0).} \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, bmp @@ -137,7 +154,7 @@ arguments for GradientCatsColorBar() or ColorBarContinuous() will be returned. It is convenient for users to adjust the color bars manually. The default is FALSE, the color bars will be plotted directly.} -\item{...}{Additional parameters to be passed on to \code{PlotEquiMap}.} +\item{...}{Additional parameters to be passed on to \code{VizEquiMap}.} } \description{ Plot a number a two dimensional matrices with (longitude, @@ -175,7 +192,7 @@ PlotCombinedMap(data, lon = Lon, lat = Lat, map_select_fun = max, } \seealso{ -\code{PlotCombinedMap} and \code{PlotEquiMap} +\code{PlotCombinedMap} and \code{VizEquiMap} } \author{ Nicolau Manubens, \email{nicolau.manubens@bsc.es} diff --git a/man/Viz2VarsVsLTime.Rd b/man/Viz2VarsVsLTime.Rd new file mode 100644 index 0000000000000000000000000000000000000000..1e7d388283b5101ae44745d1be1482d1598b7a3a --- /dev/null +++ b/man/Viz2VarsVsLTime.Rd @@ -0,0 +1,125 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Viz2VarsVsLTime.R +\name{Viz2VarsVsLTime} +\alias{Viz2VarsVsLTime} +\title{Plot two scores with confidence intervals in a common plot} +\usage{ +Viz2VarsVsLTime( + 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, + ... +) +} +\arguments{ +\item{var1}{Matrix of dimensions (nexp/nmod, nltime).} + +\item{var2}{Matrix of dimensions (nexp/nmod, nltime).} + +\item{toptitle}{Main title, optional.} + +\item{ytitle}{Title of Y-axis, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12.} + +\item{nticks}{Number of ticks and labels on the x-axis, optional.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{listexp}{List of experiment names, up to three, optional.} + +\item{listvars}{List of names of input variables, optional.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\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. +Default = TRUE.} + +\item{siglev}{TRUE/FALSE if significance level should replace confidence +interval.\cr +Default = FALSE.} + +\item{sizetit}{Multiplicative factor to change title size, optional.} + +\item{show_conf}{TRUE/FALSE to show/not confidence intervals for input +variables.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. The default value is NULL.} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plot two input variables that have the same dimensions in a common plot. +One plot for all experiments. +The input variables should have dimensions (nexp/nmod, nltime). +} +\examples{ +clim <- s2dv::Clim(ts_temp$exp, ts_temp$obs, time_dim = "sdate", + dat_dim = c("dat", "member")) +ano_exp <- Ano(ts_temp$exp, clim$clim_exp) +ano_obs <- Ano(ts_temp$obs, clim$clim_obs) +corr_ano <- s2dv::Corr(s2dv::MeanDims(ano_exp, 'member'), ano_obs, + time_dim = 'sdate', dat_dim = 'dat') +input_cor <- array(dim = c(dat = 1, 3, time = 5)) +input_cor[, 1, ] <- corr_ano$conf.lower[, 1, 1, ] +input_cor[, 2, ] <- corr_ano$corr[, 1, 1, ] +input_cor[, 3, ] <- corr_ano$conf.upper[, 1, 1, ] + +rms_ano <- s2dv::RMS(s2dv::MeanDims(ano_exp, 'member'), ano_obs, + time_dim = 'sdate', dat_dim = 'dat') + +input_rms <- array(dim = c(dat = 1, 3, time = 5)) +input_rms[, 1, ] <- rms_ano$conf.lower[, 1, 1, ] +input_rms[, 2, ] <- rms_ano$rms[, 1, 1, ] +input_rms[, 3, ] <- rms_ano$conf.upper[, 1, 1, ] +Viz2VarsVsLTime(input_cor, input_rms, + toptitle = "Time correlation and RMSE with ERA5", + ytitle = "K", sizetit = 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 new file mode 100644 index 0000000000000000000000000000000000000000..81a4b3e5ffa5715c71e7ddaf7479e380fc3dd2f4 --- /dev/null +++ b/man/VizACC.Rd @@ -0,0 +1,115 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizACC.R +\name{VizACC} +\alias{VizACC} +\title{Plot Plumes/Timeseries Of Anomaly Correlation Coefficients} +\usage{ +VizACC( + 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, + ... +) +} +\arguments{ +\item{ACC}{An ACC array with with dimensions:\cr +c(nexp, nobs, nsdates, nltime, 4)\cr +with the fourth dimension of length 4 containing the lower limit of the +95\% confidence interval, the ACC, the upper limit of the 95\% confidence +interval and the 95\% significance level.} + +\item{sdates}{A character vector of startdates: c('YYYYMMDD','YYYYMMDD').} + +\item{toptitle}{A character string of the main title, optional.} + +\item{sizetit}{A multiplicative factor to scale title size, optional.} + +\item{ytitle}{A character string of the title of Y-axis for each experiment: +c('', ''), optional.} + +\item{limits}{A numeric vector c(lower limit, upper limit): limits of the +Y-axis, optional.} + +\item{legends}{A character vector of flags to be written in the legend, +optional.} + +\item{freq}{A integer: 1 = yearly, 12 = monthly, 4 = seasonal, ... Default: 12.} + +\item{biglab}{A logical value for presentation/paper plot, Default = FALSE.} + +\item{fill}{A logical value if filled confidence interval. Default = FALSE.} + +\item{linezero}{A logical value if a line at y=0 should be added. Default = FALSE.} + +\item{points}{A logical value if points instead of lines. Default = TRUE.\cr +Must be TRUE if only 1 leadtime.} + +\item{vlines}{A vector of x location where to add vertical black lines, optional.} + +\item{fileout}{A character string of the output file name. Extensions allowed: +eps/ps, jpeg, png, pdf, bmp and tiff. Default is NULL.} + +\item{width}{A numeric of the file width, in the units specified in the +parameter size_units (inches by default). Takes 8 by default.} + +\item{height}{A numeric of the file height, in the units specified in the parameter +size_units (inches by default). Takes 5 by default.} + +\item{size_units}{A character string of the 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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +csi cxy err family fg fig fin font font.axis font.lab font.main font.sub +lend lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page +plt smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog\cr +For more information about the parameters see `par`.} +} +\description{ +Plots plumes/timeseries of ACC from an array with dimensions +(output from \code{ACC()}): \cr +c(nexp, nobs, nsdates, nltime, 4)\cr +where the fourth dimension is of length 4 and contains the lower limit of +the 95\% confidence interval, the ACC, the upper limit of the 95\% +confidence interval and the 95\% significance level given by a one-sided +T-test. +} +\examples{ +ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, + dat_dim = c('dat', 'member'), memb_dim = 'member') +lats <- attr(map_temp$exp, "Variables")$common$lat +lons <- attr(map_temp$exp, "Variables")$common$lon +acc <- s2dv::ACC(ano$exp, ano$obs, lat = lats, lon = lons, + dat_dim = 'dat', memb_dim = 'member') +input_acc <- array(dim = c(dim(acc$acc)[c('nexp', 'nobs', 'sdate', 'time')], 4)) +input_acc[, , , , 1] <- acc$conf.lower +input_acc[, , , , 2] <- acc$acc +input_acc[, , , , 3] <- acc$conf.upper +input_acc[, , , , 4] <- acc$p.val +sdates <- paste0(2000:2005, '1101') +VizACC(input_acc, sdates, + toptitle = "Spatial anomaly corr. coeff. with ERA5", + ytitle = "K", sizetit = 0.7, freq = 12, + legends = 'SEAS5', fileout = NULL) + +} diff --git a/man/VizAnimateMap.Rd b/man/VizAnimateMap.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ccb103442083f0adb29323a7e47bf35c032300cf --- /dev/null +++ b/man/VizAnimateMap.Rd @@ -0,0 +1,160 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizAnimateMap.R +\name{VizAnimateMap} +\alias{VizAnimateMap} +\title{Animate Maps of Forecast/Observed Values or Scores Over Forecast Time} +\usage{ +VizAnimateMap( + 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"), + ... +) +} +\arguments{ +\item{var}{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).} + +\item{lon}{Vector containing longtitudes (degrees).} + +\item{lat}{Vector containing latitudes (degrees).} + +\item{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 ...} + +\item{sizetit}{Multiplicative factor to increase title size, optional.} + +\item{units}{Units, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal ...} + +\item{msk95lev}{TRUE/FALSE grid points with dots if 95\% significance level +reached. Default = FALSE.} + +\item{brks}{Limits of colour levels, optional. For example: +seq(min(var), max(var), (max(var) - min(var)) / 10).} + +\item{cols}{Vector of colours of length(brks) - 1, optional.} + +\item{filled.continents}{Continents filled in grey (TRUE) or represented by +a black line (FALSE). Default = TRUE. Filling unavailable if crossing +Greenwich and equi = TRUE. Filling unavailable if square = FALSE and +equi = TRUE.} + +\item{lonmin}{Westward limit of the domain to plot (> 0 or < 0). +Default : 0 degrees.} + +\item{lonmax}{Eastward limit of the domain to plot (> 0 or < 0). +lonmax > lonmin. Default : 360 degrees.} + +\item{latmin}{Southward limit of the domain to plot. Default : -90 degrees.} + +\item{latmax}{Northward limit of the domain to plot. Default : 90 degrees.} + +\item{intlon}{Interval between longitude ticks on x-axis. +Default = 20 degrees.} + +\item{intlat}{Interval between latitude ticks on y-axis for equi = TRUE or +between latitude circles for equi = FALSE. Default = 30 degrees.} + +\item{drawleg}{Draw a colorbar. Can be FALSE only if square = FALSE or +equi = FALSE. Default = TRUE.} + +\item{subsampleg}{Supsampling factor of the interval between ticks on +colorbar. Default = 1 = every colour level.} + +\item{colNA}{Color used to represent NA. Default = 'white'.} + +\item{equi}{TRUE/FALSE == cylindrical equidistant/stereographic projection. +Default: TRUE.} + +\item{fileout}{c('', '', \dots) array of output file name for each animation. + If RMS, RMSSS, correlations : first exp with successive obs, then second +exp with successive obs, etc ...} + +\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 + cin col.axis col.lab col.main col.sub cra crt csi cxy err family fg fig +font font.axis font.lab font.main font.sub las lheight ljoin lmitre lty +lwd mai mar mex mfcol mfrow mfg mgp mkh oma omd omi page pch plt pty smo +srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog. \cr +For more information about the parameters see `par`.} +} +\description{ +Create animations of maps in an equi-rectangular or stereographic +projection, showing the anomalies, the climatologies, the mean InterQuartile +Range, Maximum-Mininum, Standard Deviation, Median Absolute Deviation, +the trends, the RMSE, the correlation or the RMSSS, between modelled and +observed data along the forecast time (lead-time) for all input experiments +and input observational datasets. +} +\details{ +Examples of input: +\enumerate{ + \item{ + Outputs from clim (exp, obs, memb = FALSE): + (nmod, nltime, nlat, nlon) + or (nobs, nltime, nlat, nlon) + } + \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): + (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. + } + \item{ + model and observed output from load/ano/smoothing: + (nmod, nmemb, sdate, nltime, nlat, nlon) + & (nobs, nmemb, sdate, nltime, nlat, nlon) + then averaged along members mean1dim(var_exp/var_obs, posdim = 2): + (nmod, sdate, nltime, nlat, nlon) + (nobs, sdate, nltime, nlat, nlon) + then passed through corr(exp, obs, posloop = 1, poscor = 2) + or RMS(exp, obs, posloop = 1, posRMS = 2): + (nmod, nobs, 3, nltime, nlat, nlon) + animates correlations or RMS between each exp & each obs against leadtime. + } +} +} +\examples{ +clim <- s2dv::Clim(map_temp$exp, map_temp$obs, memb = FALSE, + dat_dim = c('dat', 'member'), memb_dim = 'member') +lats <- attr(map_temp$exp, "Variables")$common$lat +lons <- attr(map_temp$exp, "Variables")$common$lon +VizAnimateMap(clim$clim_exp[1, 1, , , ], lon = lons, lat = lats, + toptitle = "climatology of decadal prediction", sizetit = 1, + units = "K", brks = seq(270, 300, 3), monini = 11, freq = 12, + msk95lev = FALSE, filled.continents = FALSE, intlon = 10, intlat = 10, + fileout = 'clim_animation.gif') + +} diff --git a/man/VizAno.Rd b/man/VizAno.Rd new file mode 100644 index 0000000000000000000000000000000000000000..3db84ec96d4e6e9097d159330be8e63324a2b6ae --- /dev/null +++ b/man/VizAno.Rd @@ -0,0 +1,113 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizAno.R +\name{VizAno} +\alias{VizAno} +\title{Plot Anomaly or Raw time series} +\usage{ +VizAno( + 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, + ... +) +} +\arguments{ +\item{exp_ano}{A numerical array containing the experimental data:\cr +c(nmod/nexp, nmemb/nparam, nsdates, nltime).} + +\item{obs_ano}{A numerical array containing the observational data:\cr +c(nobs, nmemb, nsdates, nltime)} + +\item{sdates}{A character vector of start dates in the format of +c('YYYYMMDD','YYYYMMDD').} + +\item{toptitle}{Main title for each experiment: c('',''), optional.} + +\item{ytitle}{Title of Y-axis for each experiment: c('',''), optional.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{legends}{List of observational dataset names, optional.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default: 12.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\item{fill}{TRUE/FALSE if the spread between members should be filled. +Default = TRUE.} + +\item{memb}{TRUE/FALSE if all members/only the ensemble-mean should be +plotted.\cr +Default = TRUE.} + +\item{ensmean}{TRUE/FALSE if the ensemble-mean should be plotted. +Default = TRUE.} + +\item{linezero}{TRUE/FALSE if a line at y=0 should be added. +Default = FALSE.} + +\item{points}{TRUE/FALSE if points instead of lines should be shown. +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{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 +one and it will be extended to the rest. The default value is NULL, which +the pop-up window shows.} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page plt smo +srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plots time series of raw or smoothed anomalies of any variable output from +\code{Load()} or \code{Ano()} or or \code{Ano_CrossValid()} or +\code{Smoothing()}. +} +\examples{ +dim(ts_temp$exp) <- c(dat = 1, member = 3, sdate = 6, time = 5) +dim(ts_temp$obs) <- c(dat = 1, member = 1, sdate = 6, time = 5) +sdates <- paste0(2000:2005, '1101') +VizAno(ts_temp$exp, ts_temp$obs, sdates, + toptitle = "Raw 'tas'", ytitle = 'K', legends = 'ERA5', biglab = FALSE) + +} diff --git a/man/VizBoxWhisker.Rd b/man/VizBoxWhisker.Rd new file mode 100644 index 0000000000000000000000000000000000000000..21f1a87e6222d754baa3f84b8a5e3941a8523825 --- /dev/null +++ b/man/VizBoxWhisker.Rd @@ -0,0 +1,106 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizBoxWhisker.R +\name{VizBoxWhisker} +\alias{VizBoxWhisker} +\title{Box-And-Whisker Plot of Time Series with Ensemble Distribution} +\usage{ +VizBoxWhisker( + exp, + obs, + toptitle = "", + ytitle = "", + monini = 1, + yearini = 0, + freq = 1, + expname = "exp 1", + obsname = "obs 1", + drawleg = TRUE, + fileout = NULL, + width = 8, + height = 5, + size_units = "in", + res = 100, + ... +) +} +\arguments{ +\item{exp}{Forecast array of multi-member time series, e.g., the NAO index +of one experiment. The expected dimensions are +c(members, start dates/forecast horizons). A vector with only the time +dimension can also be provided. Only monthly or lower frequency time +series are supported. See parameter freq.} + +\item{obs}{Observational vector or array of time series, e.g., the NAO index +of the observations that correspond the forecast data in \code{exp}. +The expected dimensions are c(start dates/forecast horizons) or +c(1, start dates/forecast horizons). Only monthly or lower frequency time +series are supported. See parameter freq.} + +\item{toptitle}{Character string to be drawn as figure title.} + +\item{ytitle}{Character string to be drawn as y-axis title.} + +\item{monini}{Number of the month of the first time step, from 1 to 12.} + +\item{yearini}{Year of the first time step.} + +\item{freq}{Frequency of the provided time series: 1 = yearly, 12 = monthly,} + +\item{expname}{Experimental dataset name.} + +\item{obsname}{Name of the observational reference dataset.} + +\item{drawleg}{TRUE/FALSE: whether to draw the legend or not.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. \cr +Default = 'output_PlotBox.ps'.} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\item{...}{Arguments to be passed to the method. Only accepts the following +graphical parameters:\cr +ann ask bg cex.lab cex.sub cin col.axis col.lab col.main col.sub cra crt +csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mex mfcol mfrow mfg mkh oma omd omi page pin plt pty +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\value{ +Generates a file at the path specified via \code{fileout}. +} +\description{ +Produce time series of box-and-whisker plot showing the distribution of the +members of a forecast vs. the observed evolution. The correlation between +forecast and observational data is calculated and displayed. Only works for +n-monthly to n-yearly time series. +} +\examples{ +# No example data is available over NAO region, so in this example we will +# tweak the longitude and latitude. +ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE, + dat_dim = c('dat', 'member'), memb_dim = 'member') +nao <- s2dv::NAO(ano$exp, ano$obs, lat = seq(20, 80, length.out = 11), + lon = seq(-80, 40, length.out = 16), memb_dim = "member", + ftime_dim = "time") +nao$exp <- drop(aperm(nao$exp, c(2, 1, 3, 4))) +nao$obs <- drop(nao$obs) +VizBoxWhisker(nao$exp, nao$obs, toptitle = "NAO index", + ytitle = "NAO index (PC1) TOS", monini = 11, freq = 1, + yearini = 2000, expname = "SEAS5", obsname = "ERA5") + +} +\seealso{ +EOF, ProjectField, NAO +} diff --git a/man/VizClim.Rd b/man/VizClim.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e2d0c5274d559af6a9858429ca5f748f7450afe0 --- /dev/null +++ b/man/VizClim.Rd @@ -0,0 +1,97 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizClim.R +\name{VizClim} +\alias{VizClim} +\title{Plots Climatologies} +\usage{ +VizClim( + 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, + ... +) +} +\arguments{ +\item{exp_clim}{Matrix containing the experimental data with dimensions:\cr +c(nmod/nexp, nmemb/nparam, nltime) or c(nmod/nexp, nltime)} + +\item{obs_clim}{Matrix containing the observational data (optional) with +dimensions:\cr +c(nobs, nmemb, nltime) or c(nobs, nltime)} + +\item{toptitle}{Main title, optional.} + +\item{ytitle}{Title of Y-axis, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{listexp}{List of experiment names, optional.} + +\item{listobs}{List of observational dataset names, optional.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\item{leg}{TRUE/FALSE to plot the legend or not.} + +\item{sizetit}{Multiplicative factor to scale title size, optional.} + +\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 +in a pop-up window.} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +csi cxy err family fg fig font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +smo srt tck usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plots climatologies as a function of the forecast time for any index output +from \code{Clim()} and organized in matrix with dimensions:\cr +c(nmod/nexp, nmemb/nparam, nltime) or c(nmod/nexp, nltime) for the +experiment data\cr +c(nobs, nmemb, nltime) or c(nobs, nltime) for the observational data +} +\examples{ +clim <- s2dv::Clim(ts_temp$exp, ts_temp$obs, time_dim = "sdate", + dat_dim = c("dat", "member")) +dim(clim$clim_exp) <- dim(clim$clim_exp)[-3] +dim(clim$clim_obs) <- dim(clim$clim_obs)[-2] +VizClim(clim$clim_exp, clim$clim_obs, toptitle = 'Climatologies', + ytitle = 'K', monini = 11, listexp = 'SEAS5', + listobs = 'ERA5', biglab = FALSE, fileout = NULL) + +} diff --git a/man/PlotEquiMap.Rd b/man/VizEquiMap.Rd similarity index 88% rename from man/PlotEquiMap.Rd rename to man/VizEquiMap.Rd index bc470e24f1e2a4eefe4931cd58d0e4e2c9d47771..57ba1c60f66afc8998fd6fe4ee05bfb66ba295e2 100644 --- a/man/PlotEquiMap.Rd +++ b/man/VizEquiMap.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/PlotEquiMap.R -\name{PlotEquiMap} -\alias{PlotEquiMap} +% Please edit documentation in R/VizEquiMap.R +\name{VizEquiMap} +\alias{VizEquiMap} \title{Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection} \usage{ -PlotEquiMap( +VizEquiMap( var, lon, lat, @@ -22,7 +22,7 @@ PlotEquiMap( colNA = NULL, color_fun = ClimPalette(), square = TRUE, - filled.continents = NULL, + filled.continents = FALSE, filled.oceans = FALSE, country.borders = FALSE, coast_color = NULL, @@ -152,8 +152,8 @@ the spaces in between with colours (FALSE). In the latter case, 'filled.continents' will take the value FALSE if not specified.} \item{filled.continents}{Colour to fill in drawn projected continents. -Takes the value gray(0.5) by default or, if 'square = FALSE', takes the -value FALSE. If set to FALSE, continents are not filled in.} +If 'square = FALSE', it is set as FALSE. +If set to FALSE (default), the continents are not filled.} \item{filled.oceans}{A logical value or the color name to fill in drawn projected oceans. The default value is FALSE. If it is TRUE, the default @@ -216,7 +216,7 @@ the longitudinal and latitudinal coordinate dimensions are interchanged.} \item{dot_symbol}{Single character/number or vector of characters/numbers that correspond to each of the symbol layers specified in parameter 'dots'. If a single value is specified, it will be applied to all the layers in -'dots'. Takes 15 (centered square) by default. See 'pch' in par() for +'dots'. Takes 4 (cross) by default. See 'pch' in par() for additional accepted options.} \item{dot_size}{Scale factor for the dots/symbols to be plotted, specified @@ -376,33 +376,14 @@ include continents, oceans, and lakes. This plot function is compatible with figure layouts if colour bar is disabled. } \examples{ -# See examples on Load() to understand the first lines in this example - \dontrun{ -data_path <- system.file('sample_data', package = 's2dv') -expA <- list(name = 'experiment', path = file.path(data_path, - 'model/$EXP_NAME$/$STORE_FREQ$_mean/$VAR_NAME$_3hourly', - '$VAR_NAME$_$START_DATE$.nc')) -obsX <- list(name = 'observation', path = file.path(data_path, - '$OBS_NAME$/$STORE_FREQ$_mean/$VAR_NAME$', - '$VAR_NAME$_$YEAR$$MONTH$.nc')) - -# Now we are ready to use Load(). -startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -sampleData <- Load('tos', list(expA), list(obsX), startDates, - leadtimemin = 1, leadtimemax = 4, output = 'lonlat', - latmin = 27, latmax = 48, lonmin = -12, lonmax = 40) - } - \dontshow{ -startDates <- c('19851101', '19901101', '19951101', '20001101', '20051101') -sampleData <- s2dv:::.LoadSampleData('tos', c('experiment'), - c('observation'), startDates, - leadtimemin = 1, - leadtimemax = 4, - output = 'lonlat', - latmin = 27, latmax = 48, - lonmin = -12, lonmax = 40) - } -PlotEquiMap(sampleData$mod[1, 1, 1, 1, , ], sampleData$lon, sampleData$lat, - toptitle = 'Predicted sea surface temperature for Nov 1960 from 1st Nov', - title_scale = 0.5) +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 +lons <- attr(map_temp$exp, "Variables")$common$lon + +VizEquiMap(var[1, 1, 1, 1, , ], lon = lons, lat = lats, + toptitle = 'Near-surface temperature anomaly, Nov. 2000', + filled.continents = FALSE, title_scale = 0.7) + } diff --git a/man/VizLayout.Rd b/man/VizLayout.Rd new file mode 100644 index 0000000000000000000000000000000000000000..b025a19a3c80ceed68eeb7f95b9970c66dc0253b --- /dev/null +++ b/man/VizLayout.Rd @@ -0,0 +1,279 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizLayout.R +\name{VizLayout} +\alias{VizLayout} +\title{Arrange and Fill Multi-Pannel Layouts With Optional Colour Bar} +\usage{ +VizLayout( + 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 +) +} +\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 +vector of as many function names (character strings!) can be provided in +'fun', one for each array in 'var'.} + +\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) +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 +dimensions for each. If a single vector is provided, it will be used for +all the arrays in 'var'.} + +\item{var}{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 +be labelled in order to refer to them with names in 'plot_dims'. All the +available plottable sub-arrays will be automatically plotted and arranged +in consecutive cells of an automatically arranged layout. A list of +multiple (super-)arrays can be specified. The process will be repeated for +each of them, by default applying the same plot function to all of them +or, if properly specified in 'fun', a different plot function will be +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).} + +\item{\dots}{Parameters to be sent to the plotting function 'fun'. If +multiple arrays are provided in 'var' 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'.} + +\item{special_args}{List of sub-lists, each sub-list having specific extra +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', +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 + 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 +special_args:\cr + List of 2\cr + $ :List of 2\cr + ..$ arg1: ...\cr + ..$ arg2: ...\cr + $ :List of 1\cr + ..$ arg1: ...\cr} + +\item{nrow}{Numeric value to force the number of rows in the automatically +generated layout. If higher than the required, this will yield blank cells +in the layout (which can then be populated). If lower than the required +the function will stop. By default it is configured to arrange the layout +in a shape as square as possible. Blank cells can be manually populated +after with customized plots (see SwitchTofigure).} + +\item{ncol}{Numeric value to force the number of columns in the +automatically generated layout. If higher than the required, this will +yield blank cells in the layout (which can then be populated). If lower +than the required the function will stop. By default it is configured to +arrange the layout in a shape as square as possible. Blank cells can be +manually populated after with customized plots (see SwitchTofigure).} + +\item{toptitle}{Topt title for the multi-pannel. Blank by default.} + +\item{row_titles}{Character string vector with titles for each of the rows +in the layout. Blank by default.} + +\item{col_titles}{Character string vector with titles for each of the +columns in the layout. Blank by default.} + +\item{bar_scale}{Scale factor for the common colour bar. Takes 1 by default.} + +\item{title_scale}{Scale factor for the multi-pannel title. Takes 1 by +default.} + +\item{title_margin_scale}{Scale factor for the margins surrounding the top +title. Takes 1 by default.} + +\item{title_left_shift_scale}{When plotting row titles, a shift is added +to the horizontal positioning of the top title in order to center it to +the region of the figures (without taking row titles into account). This +shift can be reduced. A value of 0 will remove the shift completely, +centering the title to the total width of the device. This parameter will +be disregarded if no 'row_titles' are provided.} + +\item{subtitle_scale}{Scale factor for the row titles and column titles +(specified in 'row_titles' and 'col_titles'). Takes 1 by default.} + +\item{subtitle_margin_scale}{Scale factor for the margins surrounding the +subtitles. Takes 1 by default.} + +\item{subplot_titles_scale}{Scale factor for the subplots top titles. 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 +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.} + +\item{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 +'down', 'd', 'D', 'bottom', 'b', 'B', 'south', 's', 'S' (default)\cr +'right', 'r', 'R', 'east', 'e', 'E'\cr +'left', 'l', 'L', 'west', 'w', 'W'} + +\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 +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{units}{Title at the top of the colour bar, most commonly the units of +the variable provided in parameter 'var'.} + +\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 +region of the figures (without taking row titles into account). This shift +can be reduced. A value of 0 will remove the shift completely, centering +the colour bar to the total width of the device. This parameter will be +disregarded if no 'row_titles' are provided.} + +\item{extra_margin}{Extra margins to be added around the layout, in the +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).} + +\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, +bmp and tiff.} + +\item{width}{Width in inches of the multi-pannel. 7 by default, or 11 if +'fielout' has been specified.} + +\item{height}{Height in inches of the multi-pannel. 7 by default, or 11 if +'fileout' has been specified.} + +\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 +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{close_device}{Whether to close the graphics device after plotting +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.} +} +\value{ +\item{brks}{ + Breaks used for colouring the map (and legend if drawleg = TRUE). +} +\item{cols}{ + Colours used for colouring the map (and legend if drawleg = TRUE). + Always of length length(brks) - 1. +} +\item{col_inf}{ + Colour used to draw the lower triangle end in the colour bar + (NULL if not drawn at all). +} +\item{col_sup}{ + Colour used to draw the upper triangle end in the colour bar + (NULL if not drawn at all). +} +\item{layout_matrix}{ + Underlying matrix of the layout. Useful to later set any of the layout + cells as current figure to add plot elements. See .SwitchToFigure. +} +} +\description{ +This function takes an array or list of arrays and loops over each of them +to plot all the sub-arrays they contain on an automatically generated +multi-pannel layout. A different plot function (not necessarily from +s2dv) can be applied over each of the provided arrays. The input +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 +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 +is provided in order to adjust the position, size and colour of the +components. Blank cells can be forced to appear and later be filled in +manually with customized plots.\cr +This function pops up a blank new device and fills it in, so it cannot be +nested in complex layouts. +} +\examples{ +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 +lons <- attr(map_temp$exp, "Variables")$common$lon + +VizLayout(fun = VizquiMap, plot_dims = c('lat', 'lon'), + var = var[, 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 new file mode 100644 index 0000000000000000000000000000000000000000..0705246f3531e0671a9a7933219abf5831d431de --- /dev/null +++ b/man/VizMatrix.Rd @@ -0,0 +1,113 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizMatrix.R +\name{VizMatrix} +\alias{VizMatrix} +\title{Function to convert any numerical table to a grid of coloured squares.} +\usage{ +VizMatrix( + 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, + ... +) +} +\arguments{ +\item{var}{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 +than the parameter 'cols'. Use ColorBarContinuous() to generate default +values.} + +\item{cols}{A vector of valid color identifiers for color bar. The length +must be one less than the parameter 'brks'. Use ColorBarContinuous() to +generate default values.} + +\item{toptitle}{A string of the title of the grid. Set NULL as default.} + +\item{title.color}{A string of valid color identifier to decide the title +color. Set "royalblue4" as default.} + +\item{xtitle}{A string of title of the x-axis. Set NULL 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.} + +\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.} + +\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 +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. +Set TRUE as default.} + +\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).} + +\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.} + +\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.} + +\item{size_units}{A string indicating the units of the size of the device +(file or window) to plot in. Set 'px' as default. See ?Devices and the +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{...}{The additional parameters to be passed to function +ColorBarContinuous() in s2dv for color legend creation.} +} +\value{ +A figure in popup window by default, or saved to the specified path. +} +\description{ +This function converts a numerical data matrix into a coloured +grid. It is useful for a slide or article to present tabular results as +colors instead of numbers. +} +\examples{ +#Example with random data +VizMatrix(var = 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), + toptitle = "Mean Absolute Error", + xtitle = "Forecast time (month)", ytitle = "Start date", + xlabels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", + "Aug", "Sep", "Oct", "Nov", "Dec")) + +} diff --git a/man/PlotRobinson.Rd b/man/VizRobinson.Rd similarity index 89% rename from man/PlotRobinson.Rd rename to man/VizRobinson.Rd index cccf0f58b5bdb5a250fe3865304190659934d2ce..7f2ee853838f31bfe9f5081cfd733bfc091216f9 100644 --- a/man/PlotRobinson.Rd +++ b/man/VizRobinson.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/PlotRobinson.R -\name{PlotRobinson} -\alias{PlotRobinson} +% Please edit documentation in R/VizRobinson.R +\name{VizRobinson} +\alias{VizRobinson} \title{Plot map in Robinson or other projections} \usage{ -PlotRobinson( +VizRobinson( data, lon, lat, @@ -159,7 +159,7 @@ Transform a regular grid longitude-latitude data to a different projection and plot the map. The target projection must be a valid CRS string, preferrably be EPSG or ESRI code; check \link[sf]{st_crs} for more explanation. This function is mainly tested for Robinson projection (ESRI:54030), but it can work with -other projection types in theory.\n +other projection types in theory.\cr The map can be plotted by points or polygon. A legend can be plotted as either a color bar or a discrete ggplot legend. Dots can be drawn on top of the data, which can be used for significance test. A mask can be added to not plot the @@ -167,21 +167,20 @@ data specified. A number of options is provided to adjust aesthetics, like position, size, colors, etc. } \examples{ -data <- array(rep(seq(-10, 10, length.out = 181), 360) + rnorm(360), +data <- array(rep(seq(-10, 10, length.out = 181), 360) + rnorm(360), dim = c(lat = 181, lon = 360)) dots <- data dots[which(dots < 4 & dots > -4)] <- 0 dots[which(dots != 0)] <- 1 -PlotRobinson(data, lon = 0:359, lat = -90:90, dots = dots, - brks = seq(-10, 10, length.out = 11), - toptitle = 'synthetic example', vertical = F, - caption = 'Robinson Global\ns2dv::PlotRobinson example', - bar_extra_margin = c(0, 1, 0, 1), width = 8, height = 6) -PlotRobinson(data, lon = 0:359, lat = -90:90, mask = dots, legend = 'ggplot2', - target_proj = "+proj=moll", brks = seq(-10, 10, length.out = 11), - color_fun = ClimPalette("purpleorange"), colNA = 'green', - toptitle = 'synthetic example', - caption = 'Mollweide Global\ns2dv::PlotRobinson example', - width = 8, height = 6) +VizRobinson(data, lon = 0:359, lat = -90:90, dots = dots, + brks = seq(-10, 10, length.out = 11), + toptitle = 'synthetic example', vertical = F, + caption = 'Robinson Projection', + bar_extra_margin = c(0, 1, 0, 1), width = 8, height = 6) +Vizobinson(data, lon = 0:359, lat = -90:90, mask = dots, legend = '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) } diff --git a/man/VizSection.Rd b/man/VizSection.Rd new file mode 100644 index 0000000000000000000000000000000000000000..f60d0aa61ed2ba8f8db555657c6976b52e1fa8ed --- /dev/null +++ b/man/VizSection.Rd @@ -0,0 +1,90 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizSection.R +\name{VizSection} +\alias{VizSection} +\title{Plots A Vertical Section} +\usage{ +VizSection( + 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, + ... +) +} +\arguments{ +\item{var}{Matrix to plot with (longitude/latitude, depth) dimensions.} + +\item{horiz}{Array of longitudes or latitudes.} + +\item{depth}{Array of depths.} + +\item{toptitle}{Title, optional.} + +\item{sizetit}{Multiplicative factor to increase title size, optional.} + +\item{units}{Units, optional.} + +\item{brks}{Colour levels, optional.} + +\item{cols}{List of colours, optional.} + +\item{axelab}{TRUE/FALSE, label the axis. Default = TRUE.} + +\item{intydep}{Interval between depth ticks on y-axis. Default: 200m.} + +\item{intxhoriz}{Interval between longitude/latitude ticks on x-axis.\cr +Default: 20deg.} + +\item{drawleg}{Draw colorbar. Default: TRUE.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. \cr +Default = NULL} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +cra crt csi cxy err family fg fig fin font font.axis font.lab font.main +font.sub lend lheight ljoin lmitre lty lwd mex mfcol mfrow mfg mkh oma omd +omi page pch pin plt pty smo srt tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs +yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plot a (longitude,depth) or (latitude,depth) section. +} +\examples{ +# Synthetic data +data <- array(rep(seq(25, 10, length.out = 7), each = 21) - rnorm(147), + dim = c(lat = 21, depth = 7)) +VizSection(data, horiz = 0:20, depth = seq(0, 300, length.out = 7), + intydep = 50, intxhoriz = 5, brks = 11, + toptitle = 'Temperature cross-section', units = "degC") +} diff --git a/man/VizStereoMap.Rd b/man/VizStereoMap.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0bd6fd231a2f9ce8682d731f90bd8cbb073b103d --- /dev/null +++ b/man/VizStereoMap.Rd @@ -0,0 +1,288 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizStereoMap.R +\name{VizStereoMap} +\alias{VizStereoMap} +\title{Maps A Two-Dimensional Variable On A Polar Stereographic Projection} +\usage{ +VizStereoMap( + 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, + ... +) +} +\arguments{ +\item{var}{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.} + +\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 +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).} + +\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 +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'.} + +\item{varv}{Array of the meridional component of wind/current/other field +with the same dimensions as 'var'.} + +\item{latlims}{Latitudinal limits of the figure.\cr +Example : c(60, 90) for the North Pole\cr + c(-90,-60) for the South Pole} + +\item{toptitle}{Top title of the figure, scalable with parameter +'title_scale'.} + +\item{sizetit}{Scale factor for the figure top title provided in parameter +'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'.} + +\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 +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.} + +\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 +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 +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{filled.continents}{Colour to fill in drawn projected continents. Takes +the value gray(0.5) by default. If set to FALSE, continents are not +filled in.} + +\item{coast_color}{Colour of the coast line of the drawn projected +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 +and displayed with contours. Parameter 'brks2' is required to define the +magnitude breaks for each contour curve.} + +\item{brks2}{A numeric value or vector of magnitude breaks where to draw +contour curves for the array provided in 'contours'. If it is a number, it +represents the number of breaks (n) that defines (n - 1) intervals to +classify 'contours'.} + +\item{contour_lwd}{Line width of the contour curves provided via 'contours' +and 'brks2'. The default value is 0.5.} + +\item{contour_color}{Line color of the contour curves provided via 'contours' +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 +contour labels (TRUE) or not (FALSE) when 'contours' is used. The default +value is TRUE.} + +\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 +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 +layers via the parameter 'dot_symbol'.} + +\item{dot_symbol}{Single character/number or vector of characters/numbers +that correspond to each of the symbol layers specified in parameter 'dots'. +If a single value is specified, it will be applied to all the layers in +'dots'. Takes 15 (centered square) by default. See 'pch' in par() for +additional accepted options.} + +\item{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.} + +\item{intlat}{Interval between latitude lines (circles), in degrees. +Defaults to 10.} + +\item{arr_subsamp}{A number as subsampling factor to select a subset of arrows +in 'varu' and 'varv' to be drawn. Only one out of arr_subsamp arrows will +be drawn. The default value is 1.} + +\item{arr_scale}{A number as scale factor for drawn arrows from 'varu' and +'varv'. The default value is 1.} + +\item{arr_ref_len}{A number of the length of the refence arrow to be drawn as +legend at the bottom of the figure (in same units as 'varu' and 'varv', only +affects the legend for the wind or variable in these arrays). The default +value is 15.} + +\item{arr_units}{Units of 'varu' and 'varv', to be drawn in the legend. +Takes 'm/s' by default.} + +\item{arr_scale_shaft}{A number for the scale of the shaft of the arrows +(which also depend on the number of figures and the arr_scale parameter). +The default value is 1.} + +\item{arr_scale_shaft_angle}{A number for the scale of the angle of the +shaft of the arrows (which also depend on the number of figure and the +arr_scale parameter). The default value is 1.} + +\item{drawleg}{Whether to plot a color bar (legend, key) or not. +Defaults to TRUE.} + +\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.} + +\item{boxcol}{Colour of the box lines. A vector with a colour for each of +the boxes is also accepted. Defaults to 'purple2'.} + +\item{boxlwd}{Line width of the box lines. A vector with a line width for +each of the boxes is also accepted. Defaults to 5.} + +\item{margin_scale}{Scale factor for the margins to be added to the plot, +with the format c(y1, x1, y2, x2). Defaults to rep(1, 4). If drawleg = TRUE, +margin_scale[1] is subtracted 1 unit.} + +\item{title_scale}{Scale factor for the figure top title. Defaults to 1.} + +\item{numbfig}{Number of figures in the layout the plot will be put into. +A higher numbfig will result in narrower margins and smaller labels, +axe labels, ticks, thinner lines, ... Defaults to 1.} + +\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, +bmp and tiff.} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +csi cxy err family fg font font.axis font.lab font.main font.sub lend +lheight ljoin lmitre mex mfcol mfrow mfg mkh omd omi page pch pin plt pty +smo srt tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\value{ +\item{brks}{ + Breaks used for colouring the map (and legend if drawleg = TRUE). +} +\item{cols}{ + Colours used for colouring the map (and legend if drawleg = TRUE). Always + of length length(brks) - 1. +} +\item{col_inf}{ + Colour used to draw the lower triangle end in the colour bar (NULL if not + drawn at all). +} +\item{col_sup}{ + Colour used to draw the upper triangle end in the colour bar (NULL if not + drawn at all). +} +} +\description{ +Map longitude-latitude array (on a regular rectangular or gaussian grid) on +a polar stereographic world projection with coloured grid cells. Only the +region within a specified latitude interval is displayed. A colour bar +(legend) can be plotted and adjusted. It is possible to draw superimposed +dots, symbols, boxes, contours, and arrows. A number of options is provided to +adjust the position, size and colour of the components. This plot function is +compatible with figure layouts if colour bar is disabled. +} +\examples{ +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, + toptitle = "This is the title") +} diff --git a/man/VizVsLTime.Rd b/man/VizVsLTime.Rd new file mode 100644 index 0000000000000000000000000000000000000000..52f79ba0f910596fccbbfcf3e9aede1323157e9c --- /dev/null +++ b/man/VizVsLTime.Rd @@ -0,0 +1,134 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/VizVsLTime.R +\name{VizVsLTime} +\alias{VizVsLTime} +\title{Plot a score along the forecast time with its confidence interval} +\usage{ +VizVsLTime( + 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, + ... +) +} +\arguments{ +\item{var}{Matrix containing any Prediction Score with dimensions:\cr +(nexp/nmod, 3/4 ,nltime)\cr +or (nexp/nmod, nobs, 3/4 ,nltime).} + +\item{toptitle}{Main title, optional.} + +\item{ytitle}{Title of Y-axis, optional.} + +\item{monini}{Starting month between 1 and 12. Default = 1.} + +\item{freq}{1 = yearly, 12 = monthly, 4 = seasonal, ... Default = 12.} + +\item{nticks}{Number of ticks and labels on the x-axis, optional.} + +\item{limits}{c(lower limit, upper limit): limits of the Y-axis, optional.} + +\item{listexp}{List of experiment names, optional.} + +\item{listobs}{List of observation names, optional.} + +\item{biglab}{TRUE/FALSE for presentation/paper plot. Default = FALSE.} + +\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. +Default = TRUE.} + +\item{siglev}{TRUE/FALSE if significance level should replace confidence +interval.\cr +Default = FALSE.} + +\item{sizetit}{Multiplicative factor to change title size, optional.} + +\item{show_conf}{TRUE/FALSE to show/not confidence intervals for input +variables.} + +\item{fileout}{Name of output file. Extensions allowed: eps/ps, jpeg, png, +pdf, bmp and tiff. The default value is NULL.} + +\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{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.} + +\item{res}{Resolution of the device (file or window) to plot in. See +?Devices and the creator function of the corresponding device.} + +\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 +csi cxy err family fg fig font font.axis font.lab font.main font.sub +lheight ljoin lmitre mar mex mfcol mfrow mfg mkh oma omd omi page pch plt +smo srt tck tcl usr xaxp xaxs xaxt xlog xpd yaxp yaxs yaxt ylbias ylog \cr +For more information about the parameters see `par`.} +} +\description{ +Plot the correlation (\code{Corr()}), the root mean square error +(\code{RMS()}) between the forecast values and their observational +counterpart, the slope of their trend (\code{Trend()}), the +InterQuartile range, maximum-mininum, standard deviation or median absolute +Deviation of the ensemble members (\code{Spread()}), or the ratio between +the ensemble spread and the RMSE of the ensemble mean (\code{RatioSDRMS()}) +along the forecast time for all the input experiments on the same figure +with their confidence intervals. +} +\details{ +Examples of input:\cr +Model and observed output from \code{Load()} then \code{Clim()} then +\code{Ano()} then \code{Smoothing()}:\cr +(nmod, nmemb, nsdate, nltime) and (nobs, nmemb, nsdate, nltime)\cr +then averaged over the members\cr +\code{Mean1Dim(var_exp/var_obs, posdim = 2)}:\cr +(nmod, nsdate, nltime) and (nobs, nsdate, nltime)\cr +then passed through\cr + \code{Corr(exp, obs, posloop = 1, poscor = 2)} or\cr + \code{RMS(exp, obs, posloop = 1, posRMS = 2)}:\cr + (nmod, nobs, 3, nltime)\cr +would plot the correlations or RMS between each exp & each obs as a function +of the forecast time. +} +\examples{ +clim <- s2dv::Clim(ts_temp$exp, ts_temp$obs, time_dim = "sdate", + dat_dim = c("dat", "member")) +ano_exp <- Ano(ts_temp$exp, clim$clim_exp) +ano_obs <- Ano(ts_temp$obs, clim$clim_obs) +corr_ano <- s2dv::Corr(s2dv::MeanDims(ano_exp, 'member'), ano_obs, + time_dim = 'sdate', dat_dim = 'dat') +input_cor <- array(dim = c(dat = 1, 4, time = 5)) +input_cor[, 1, ] <- corr_ano$conf.lower[, 1, 1, ] +input_cor[, 2, ] <- corr_ano$corr[, 1, 1, ] +input_cor[, 3, ] <- corr_ano$conf.upper[, 1, 1, ] +input_cor[, 4, ] <- corr_ano$p.val[, 1, 1, ] +VizVsLTime(input_cor, toptitle = "Correlation", + monini = 11, limits = c(-1, 2), listexp = 'SEAS5', + listobs = 'ERA5', biglab = FALSE, hlines = c(-1, 0, 1)) + +} diff --git a/man/map_temp.Rd b/man/map_temp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0cf40a91535a6fa946d8ed5b4d5ba05015814334 --- /dev/null +++ b/man/map_temp.Rd @@ -0,0 +1,102 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_tas.R +\docType{data} +\name{map_temp} +\alias{map_temp} +\title{Sample Of Experimental And Observational Climate Spatial Data} +\description{ +This sample data contain gridded seasonal forecast and corresponding +observational data from ECMWF-System 5 forecast system and ERA-5 +reconstruction. +Specifically, for the monthly mean 2-meter temperature ("tas") variable, the +first 3 ensemble members, the first 5 forecast time steps from November +initial month, year 2000 to 2005, the Iberian Peninsula region +(35N-45N, 10W-5E). +} +\details{ +The package "startR" is used to load the data from the data esarchive in the +Earth Sciences Department of Barcelona Supercomputing Center. + +\preformatted{ + + # 1. Load libraries and define common variables + library(startR) + library(CSTools) + + sdates <- sapply(2000:2005, function(x) paste0(x, '1101')) + lonmax <- 5 + lonmin <- -10 + latmax <- 45 + latmin <- 35 + + # 2. Load exp + + repos_exp <- paste0('/esarchive/exp/ecmwf/system5c3s/monthly_mean/', + '$var$_f6h/$var$_$sdate$.nc') + + exp <- Start(dat = repos_exp, + var = 'tas', + member = indices(1:3), + sdate = sdates, + time = indices(1:5), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = FALSE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(-180, 180), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble')), + return_vars = list(lat = NULL, lon = NULL, time = 'sdate'), + retrieve = TRUE) + + + # 3. Load obs + + exp_time <- attr(exp, "Variables")$common$time + obs_date <- array(format(exp_time, "%Y%m"), dim = dim(exp_time)) + + path_obs <- '/esarchive/recon/ecmwf/era5/monthly_mean/$var$_f1h-r1440x721cds/$var$_$date$.nc' + obs <- Start(dat = path_obs, + var = 'tas', + date = obs_date, + split_multiselected_dims = TRUE, + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = FALSE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(-180, 180), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r360x181', + method = 'conservative'), + transform_vars = c('lat', 'lon'), + return_vars = list(lon = NULL, lat = NULL, time = 'date'), + retrieve = TRUE) + + + # 4. Check data + + obs_time <- attr(obs,"Variables")$common$time + + identical(format(obs_time, "%Y%m"), format(exp_time, "%Y%m")) +#[1] TRUE + exp_lat <- attr(exp, "Variables")$common$lat + exp_lon <- attr(exp, "Variables")$common$lon + obs_lat <- attr(obs, "Variables")$common$lat + obs_lon <- attr(obs, "Variables")$common$lon + + all.equal(exp_lat, obs_lat, check.attributes = F) +#[1] TRUE + all.equal(exp_lon, obs_lon, check.attributes = F) +#[1] TRUE + + +# 5. Combine into one object + + map_temp <- list() + map_temp$exp <- exp + map_temp$obs <- obs + +} +} diff --git a/man/ts_temp.Rd b/man/ts_temp.Rd new file mode 100644 index 0000000000000000000000000000000000000000..04a76543c066072e363a8284a2683bad3bfe6767 --- /dev/null +++ b/man/ts_temp.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_tas.R +\docType{data} +\name{ts_temp} +\alias{ts_temp} +\title{Sample Of Experimental And Observational Climate Time Series Data} +\description{ +This sample data contain gridded seasonal forecast and corresponding +observational data from ECMWF-System 5 forecast system and ERA-5 +reconstruction. +Specifically, for the monthly mean 2-meter temperature ("tas") variable, the +first 3 ensemble members, the first 5 forecast time steps from November +initial month, year 2000 to 2005, spatial average of the Iberian Peninsula +region (35N-45N, 10W-5E). +} +\details{ +The package "startR" is used to load the data from the data esarchive in the +Earth Sciences Department of Barcelona Supercomputing Center +(check \code{map_temp}). Caclulate the weighted area-mean by function +\code{ClimProjDiags::WeightedMean}. + +\preformatted{ + + # 1. Load data "map_temp" first and load libraries + + library(ClimProjDiags) + + map_temp <- esviz::map_temp + attrs_exp <- attributes(map_temp$exp)[-1] + attrs_obs <- attributes(map_temp$obs)[-1] + + # 2. Calculate weighted area mean + + lats <- attr(map_temp$exp, "Variables")$common$lat + lons <- attr(map_temp$exp, "Variables")$common$lon + + ts_temp <- list() + ts_temp$exp <- WeightedMean(map_temp$exp, lon = lons, lat = lats) + ts_temp$obs <- WeightedMean(map_temp$obs, lon = lons, lat = lats) + + attributes(ts_temp$exp) <- c(attributes(ts_temp$exp), attrs_exp) + attributes(ts_temp$obs) <- c(attributes(ts_temp$obs), attrs_obs) + +} +} diff --git a/vignettes/Figures/maps_equimap_contour_raw_exp1.png b/vignettes/Figures/maps_equimap_contour_raw_exp1.png new file mode 100644 index 0000000000000000000000000000000000000000..805839c65f2a84ad38796285ed41468c5ee5945e Binary files /dev/null and b/vignettes/Figures/maps_equimap_contour_raw_exp1.png differ diff --git a/vignettes/Figures/maps_equimap_contour_raw_exp1_ver2.png b/vignettes/Figures/maps_equimap_contour_raw_exp1_ver2.png new file mode 100644 index 0000000000000000000000000000000000000000..54ec0a08b96ead1f8dc8a134108a32bd588b6828 Binary files /dev/null and b/vignettes/Figures/maps_equimap_contour_raw_exp1_ver2.png differ diff --git a/vignettes/Figures/maps_equimap_corr_exp1_obs.png b/vignettes/Figures/maps_equimap_corr_exp1_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..defdd2d8a8638fa00e271139c67d24011dc6ad3a Binary files /dev/null and b/vignettes/Figures/maps_equimap_corr_exp1_obs.png differ diff --git a/vignettes/Figures/maps_equimap_raw_exp1.png b/vignettes/Figures/maps_equimap_raw_exp1.png new file mode 100644 index 0000000000000000000000000000000000000000..91330833339c4e00b627146b1369228918a6cdc9 Binary files /dev/null and b/vignettes/Figures/maps_equimap_raw_exp1.png differ diff --git a/vignettes/Figures/maps_equimap_raw_exp1_boxes.png b/vignettes/Figures/maps_equimap_raw_exp1_boxes.png new file mode 100644 index 0000000000000000000000000000000000000000..a0467505cf811166511c0e7f00b160fe61eb767e Binary files /dev/null and b/vignettes/Figures/maps_equimap_raw_exp1_boxes.png differ diff --git a/vignettes/Figures/maps_equimap_raw_obs.png b/vignettes/Figures/maps_equimap_raw_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..9a365ab96fd7e1896c98f3557e4a0e4550461771 Binary files /dev/null and b/vignettes/Figures/maps_equimap_raw_obs.png differ diff --git a/vignettes/Figures/vis_acc_exp1_exp2_obs.png b/vignettes/Figures/vis_acc_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..279a53ea6a23b38dbaebd462677e639f97eccb16 Binary files /dev/null and b/vignettes/Figures/vis_acc_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_anim_clim_expA.gif b/vignettes/Figures/vis_anim_clim_expA.gif new file mode 100644 index 0000000000000000000000000000000000000000..7554148d5550fcb194effa41520b06b8a7624f4d Binary files /dev/null and b/vignettes/Figures/vis_anim_clim_expA.gif differ diff --git a/vignettes/Figures/vis_anim_clim_expA_world.gif b/vignettes/Figures/vis_anim_clim_expA_world.gif new file mode 100644 index 0000000000000000000000000000000000000000..f5980fc63ac320a6a99457e2e3c18fdc274d81c6 Binary files /dev/null and b/vignettes/Figures/vis_anim_clim_expA_world.gif differ diff --git a/vignettes/Figures/vis_anim_clim_expB.gif b/vignettes/Figures/vis_anim_clim_expB.gif new file mode 100644 index 0000000000000000000000000000000000000000..465a71528f933b7add55df5ab8d0c81572df1a94 Binary files /dev/null and b/vignettes/Figures/vis_anim_clim_expB.gif differ diff --git a/vignettes/Figures/vis_anim_clim_obsX.gif b/vignettes/Figures/vis_anim_clim_obsX.gif new file mode 100644 index 0000000000000000000000000000000000000000..c8d2aefe08a5b115e480434581210b44f5205da8 Binary files /dev/null and b/vignettes/Figures/vis_anim_clim_obsX.gif differ diff --git a/vignettes/Figures/vis_anim_clim_obsX_world.gif b/vignettes/Figures/vis_anim_clim_obsX_world.gif new file mode 100644 index 0000000000000000000000000000000000000000..1d94c28ce9ce9afa3c3c8f0a4c1b09a819fae6ea Binary files /dev/null and b/vignettes/Figures/vis_anim_clim_obsX_world.gif differ diff --git a/vignettes/Figures/vis_ano_exp_obs.png b/vignettes/Figures/vis_ano_exp_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..2047c681ebdde2fcdd4c8d8e445f4a897a5f9df3 Binary files /dev/null and b/vignettes/Figures/vis_ano_exp_obs.png differ diff --git a/vignettes/Figures/vis_ano_exp_points.png b/vignettes/Figures/vis_ano_exp_points.png new file mode 100644 index 0000000000000000000000000000000000000000..cdcfd8e5c3c8ae2adea46ccb439adedda89f2f4e Binary files /dev/null and b/vignettes/Figures/vis_ano_exp_points.png differ diff --git a/vignettes/Figures/vis_clim_exp1_exp2_obs.png b/vignettes/Figures/vis_clim_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..626e662c248b873d458cf3c2ac814cf9b98cc87f Binary files /dev/null and b/vignettes/Figures/vis_clim_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_conf_interval_exp.png b/vignettes/Figures/vis_conf_interval_exp.png new file mode 100644 index 0000000000000000000000000000000000000000..85cf56d5a37ff14720c42316ad30a853cef6c89a Binary files /dev/null and b/vignettes/Figures/vis_conf_interval_exp.png differ diff --git a/vignettes/Figures/vis_corr_exp1_exp2_obs.png b/vignettes/Figures/vis_corr_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..872f165b06342ca8e60db010d437d932e260a9e0 Binary files /dev/null and b/vignettes/Figures/vis_corr_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_corr_rms_exp1_exp2_obs.png b/vignettes/Figures/vis_corr_rms_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..9e1b27247febc3be143b0ca5ce60d65d6c227dd0 Binary files /dev/null and b/vignettes/Figures/vis_corr_rms_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_eno_exp1_exp2.png b/vignettes/Figures/vis_eno_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..edab0597838ff471cbcc8ee00d4dfb868ea2f7e0 Binary files /dev/null and b/vignettes/Figures/vis_eno_exp1_exp2.png differ diff --git a/vignettes/Figures/vis_equimap_box_expA.png b/vignettes/Figures/vis_equimap_box_expA.png new file mode 100644 index 0000000000000000000000000000000000000000..7c5686ad31e46de4e976fbb9e78e6ce505bdc7b5 Binary files /dev/null and b/vignettes/Figures/vis_equimap_box_expA.png differ diff --git a/vignettes/Figures/vis_equimap_cols_raw_expA.png b/vignettes/Figures/vis_equimap_cols_raw_expA.png new file mode 100644 index 0000000000000000000000000000000000000000..afd7550eba4cba35630387787faa43d425cc37db Binary files /dev/null and b/vignettes/Figures/vis_equimap_cols_raw_expA.png differ diff --git a/vignettes/Figures/vis_equimap_cols_raw_obsX.png b/vignettes/Figures/vis_equimap_cols_raw_obsX.png new file mode 100644 index 0000000000000000000000000000000000000000..b3cf03532291470b231ce90e295c8c79f5fc87f9 Binary files /dev/null and b/vignettes/Figures/vis_equimap_cols_raw_obsX.png differ diff --git a/vignettes/Figures/vis_equimap_contour_raw_expA.png b/vignettes/Figures/vis_equimap_contour_raw_expA.png new file mode 100644 index 0000000000000000000000000000000000000000..15b3a630fa62b4e49ec63e7529affcdb804ffeb7 Binary files /dev/null and b/vignettes/Figures/vis_equimap_contour_raw_expA.png differ diff --git a/vignettes/Figures/vis_equimap_contour_raw_obsX.png b/vignettes/Figures/vis_equimap_contour_raw_obsX.png new file mode 100644 index 0000000000000000000000000000000000000000..a526700e7c12c690de0b37fc943e5d58a48f82ec Binary files /dev/null and b/vignettes/Figures/vis_equimap_contour_raw_obsX.png differ diff --git a/vignettes/Figures/vis_equimap_raw_expA.png b/vignettes/Figures/vis_equimap_raw_expA.png new file mode 100644 index 0000000000000000000000000000000000000000..7f8441331ec7047b9e787f794abbe9a1b9077d36 Binary files /dev/null and b/vignettes/Figures/vis_equimap_raw_expA.png differ diff --git a/vignettes/Figures/vis_equimap_raw_obsX.png b/vignettes/Figures/vis_equimap_raw_obsX.png new file mode 100644 index 0000000000000000000000000000000000000000..f99ae26dd438ff43698d3d66872fcdbf5a5fb1dd Binary files /dev/null and b/vignettes/Figures/vis_equimap_raw_obsX.png differ diff --git a/vignettes/Figures/vis_error_bar.png b/vignettes/Figures/vis_error_bar.png new file mode 100644 index 0000000000000000000000000000000000000000..87718e965faac97ba5f1f866016372ea57c37719 Binary files /dev/null and b/vignettes/Figures/vis_error_bar.png differ diff --git a/vignettes/Figures/vis_iqr_exp1_exp2.png b/vignettes/Figures/vis_iqr_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..43bdcebea31dc5fa7a2cc16ddac2a24e62404165 Binary files /dev/null and b/vignettes/Figures/vis_iqr_exp1_exp2.png differ diff --git a/vignettes/Figures/vis_layout_complex.png b/vignettes/Figures/vis_layout_complex.png new file mode 100644 index 0000000000000000000000000000000000000000..dfbfc96b356901a0360b25512bd8b31da9947019 Binary files /dev/null and b/vignettes/Figures/vis_layout_complex.png differ diff --git a/vignettes/Figures/vis_layout_equimap_expA.png b/vignettes/Figures/vis_layout_equimap_expA.png new file mode 100644 index 0000000000000000000000000000000000000000..6804590a36d0c071f241c65519618f708d2fe4c1 Binary files /dev/null and b/vignettes/Figures/vis_layout_equimap_expA.png differ diff --git a/vignettes/Figures/vis_mad_exp1_exp2.png b/vignettes/Figures/vis_mad_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..ef2493271788b9196e81d40fcc4a37856a1b26a0 Binary files /dev/null and b/vignettes/Figures/vis_mad_exp1_exp2.png differ diff --git a/vignettes/Figures/vis_maxmin_exp1_exp2.png b/vignettes/Figures/vis_maxmin_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..71cd25d2897618b9b8cc4c6e5820c15ed6af78ba Binary files /dev/null and b/vignettes/Figures/vis_maxmin_exp1_exp2.png differ diff --git a/vignettes/Figures/vis_ratiorms_exp1_exp2_obs.png b/vignettes/Figures/vis_ratiorms_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..da6e168b3f6087ac81a27f1c2bc070eb20884d29 Binary files /dev/null and b/vignettes/Figures/vis_ratiorms_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_ratiosdrms_exp1_exp2_obs.png b/vignettes/Figures/vis_ratiosdrms_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..55e3ddfa11f9817f0b1e10b9566a07ff19ded09e Binary files /dev/null and b/vignettes/Figures/vis_ratiosdrms_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_ratiosdrms_exp1_obs1_obs2.png b/vignettes/Figures/vis_ratiosdrms_exp1_obs1_obs2.png new file mode 100644 index 0000000000000000000000000000000000000000..b6ec514926fea43ab1501007e2cc1dab3324ac8d Binary files /dev/null and b/vignettes/Figures/vis_ratiosdrms_exp1_obs1_obs2.png differ diff --git a/vignettes/Figures/vis_raw_exp1_obs.png b/vignettes/Figures/vis_raw_exp1_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..2ca62b6309b6d5aba1eedda0624477afdaa74b09 Binary files /dev/null and b/vignettes/Figures/vis_raw_exp1_obs.png differ diff --git a/vignettes/Figures/vis_raw_exp2_obs.png b/vignettes/Figures/vis_raw_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..72647ea3a5cbe71a42693510683175050812470c Binary files /dev/null and b/vignettes/Figures/vis_raw_exp2_obs.png differ diff --git a/vignettes/Figures/vis_regression_exp1_exp2.png b/vignettes/Figures/vis_regression_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..3f3bc6b0c39db22afcae93a15a41a5ed9ea1577b Binary files /dev/null and b/vignettes/Figures/vis_regression_exp1_exp2.png differ diff --git a/vignettes/Figures/vis_rms_exp1_exp2_obs.png b/vignettes/Figures/vis_rms_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..5c7c635a98c2da487efc9e8a85a6ae7b6a54d57e Binary files /dev/null and b/vignettes/Figures/vis_rms_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_rmsss_exp1_exp2_obs.png b/vignettes/Figures/vis_rmsss_exp1_exp2_obs.png new file mode 100644 index 0000000000000000000000000000000000000000..c8e5c492280f5374de791617ac0031d759496ee5 Binary files /dev/null and b/vignettes/Figures/vis_rmsss_exp1_exp2_obs.png differ diff --git a/vignettes/Figures/vis_sd_exp1_exp2.png b/vignettes/Figures/vis_sd_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..970408bf104f95480831f74f32743cf130101ffb Binary files /dev/null and b/vignettes/Figures/vis_sd_exp1_exp2.png differ diff --git a/vignettes/Figures/vis_stereomap_raw_expA.png b/vignettes/Figures/vis_stereomap_raw_expA.png new file mode 100644 index 0000000000000000000000000000000000000000..fb7b265f17f3208599f60be708cd619be2179b21 Binary files /dev/null and b/vignettes/Figures/vis_stereomap_raw_expA.png differ diff --git a/vignettes/Figures/vis_stereomap_raw_obsX.png b/vignettes/Figures/vis_stereomap_raw_obsX.png new file mode 100644 index 0000000000000000000000000000000000000000..4d1ffe56ed243fc73a7d136bbadf341347d5b58f Binary files /dev/null and b/vignettes/Figures/vis_stereomap_raw_obsX.png differ diff --git a/vignettes/Figures/vis_trend_exp1_exp2.png b/vignettes/Figures/vis_trend_exp1_exp2.png new file mode 100644 index 0000000000000000000000000000000000000000..234727f55e0206f97ff5dfe913b83a03e51ac5f4 Binary files /dev/null and b/vignettes/Figures/vis_trend_exp1_exp2.png differ diff --git a/vignettes/data_loading.md b/vignettes/data_loading.md new file mode 100644 index 0000000000000000000000000000000000000000..3eb4335f2fbab6f2802e115e6e63562951106086 --- /dev/null +++ b/vignettes/data_loading.md @@ -0,0 +1,97 @@ +--- +author: "An-Chi Ho" +date: "`r Sys.Date()`" +output: html_document +vignette: > + %\VignetteEngine{R.rsp::md} + %\VignetteIndexEntry{Visualisation} + %\usepackage[utf8]{inputenc} +--- + +# Data Loading + +To exihibit the usage of the plotting functions, we need to have data loaded first. +Here, we use `startR` package to load the experimental and observational data from our data archive (esarchive). +If you don't have access to esarchive, you can contact the package maintainer (an.ho@bsc.es; eva.rifarovira@bsc.es) +to obtain the sample data. + +We are going to load three datasets: the experiment data are SEAS5 and Meteo-France System 7 from ECMWF, and the observation data ERA5 from ECMWF. + +The variable to be analyzed is the monthly mean near-surface temperature (tas). +The region is Europe (20W-40E, 20N-80N), and the forecast years are 1997 to 2016. +The initial month is November. All the ensemble members and the first 6 forecast time steps are loaded. + +## Load monthly mean data + +```r +library(startR) + +sdates <- paste0(1997:2016, '1101') + +repo_exp1 <- paste0('/esarchive/exp/ecmwf/system5c3s/monthly_mean/', + '$var$_f6h/$var$_$sdate$.nc') +repo_exp2 <- paste0('/esarchive/exp/meteofrance/system7c3s/monthly_mean/', + '$var$_f6h/$var$_$sdate$.nc') + +exp <- Start(dat = list(list(name = "system5c3s", path = repo_exp1), + list(name = "meteofrance", path = repo_exp2)), + var = 'tas', + sdate = sdates, + time = 1:6, + ensemble = 'all', + lat = values(list(20, 80)), + lat_reorder = Sort(), + lon = values(list(-20, 40)), + lon_reorder = CircularSort(-180, 180), + transform = CDORemapper, + transform_params = list(grid = 'r360x181', method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = 'dat', lon = 'dat', + time = 'sdate'), + retrieve = TRUE) + +# Use exp time metadata to load obs +sdate_obs <- format(attributes(exp)$Variables$common$time, "%Y%m") +dim(sdate_obs) <- dim(attributes(exp)$Variables$common$time) + +repo_obs <- '/esarchive/recon/ecmwf/era5/monthly_mean/$var$_f1h-r1440x721cds/$var$_$sdate$.nc' + +obs <- Start(dat = repo_obs, + var = 'tas', + sdate = sdate_obs, + split_multiselected_dims = TRUE, + lat = values(list(20, 80)), + lat_reorder = Sort(), + lon = values(list(-20, 40)), + lon_reorder = CircularSort(-180, 180), + transform = CDORemapper, + transform_params = list(grid = 'r360x181', method = 'bilinear'), + transform_vars = c('lat', 'lon'), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(time = 'sdate', + lon = NULL, lat = NULL), + retrieve = TRUE) +``` + +## Calculate spatial mean + +To plot the time series type, we calculate the spatial mean by `ClimProjDiags::WeightedMean`, +and remove the redundant "var" dimension. + +```r +lat <- attributes(exp)$Variables$system5c3s$lat +lon <- attributes(exp)$Variables$system5c3s$lon + +exp_sm <- ClimProjDiags::WeightedMean(exp, lat = lat, lon = lon, latdim = "lat", londim = "lon", na.rm = T) +dim(exp_sm) <- dim(exp_sm)[c("dat", "sdate", "time", "ensemble")] + +obs_sm <- ClimProjDiags::WeightedMean(obs, lat = lat, lon = lon, latdim = "lat", londim = "lon", na.rm = T) +dim(obs_sm) <- dim(obs_sm)[c("dat", "sdate", "time")] +``` + + +Now, we have both the original data and the spatial mean data. We can move to other vignettes to see the usage of the plotting functions: +- [**time_series.md**](time_series.md): To plot different types of time series data +- [**maps.md**](maps.md): To plot different type of map data +- [**proj_map.md**](proj_map.md): To plot maps with different projections diff --git a/vignettes/visualization_projection.md b/vignettes/maps_different_projections.md similarity index 100% rename from vignettes/visualization_projection.md rename to vignettes/maps_different_projections.md diff --git a/vignettes/maps_equidistant_projection.md b/vignettes/maps_equidistant_projection.md new file mode 100644 index 0000000000000000000000000000000000000000..0424d5a4875d7f95f4b4e7d530d43a1a9bf3d30e --- /dev/null +++ b/vignettes/maps_equidistant_projection.md @@ -0,0 +1,318 @@ +--- +author: "An-Chi Ho" +date: "`r Sys.Date()`" +output: html_document +vignette: > + %\VignetteEngine{R.rsp::md} + %\VignetteIndexEntry{Visualisation} + %\usepackage[utf8]{inputenc} +--- + +We will use the data loaded in [data_loading.md](#data-loading) in this vignette. +Please follow that vignette first to get the data if you want to replicate the results in this vignette. + +# Map plotting + +In this vignette, we will go through the functions that plot the map type of figures: +`VizEquiMap()`, `VizRobinson()`, `VizStereoMap()`, `VizAnimateMap()`, `VizLayout()`, `VizSection()`. + +This group of functions allows to plot grid data (i.e. defined over latitudes +and longitudes) on a rectangular equidistant or stereographic projection, +as well as depth section (i.e. the cross section of latitudes/longitudes and heights). + +`VizEquiMap()` and `VizStereoMap()` share some traits: + - Both expect a data matrix in the parameter `var` 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 + +1 threshold magnitudes (via `brks`) that will allow to assign each grid cell +value one of the N colours. The colour for any missing values can be adjusted +with `colNA`. + - Whether to fill the map continents or only draw coast wires can be adjusted +with `filled.continents`. + - A matrix of `dots` can be plotted over the drawn map to, e.g., highlight +cells where a skill has been greatest or most significant. + - A legend can be drawn (unless disabled with `drawleg`) and the amount of +ticks on that legend can be adjusted with `subsampleg`. + - They accept any additional parameters via the parameter `...` to be sent to +the underlying R graphics `image()` function for a fine tuning. + +### VizEquiMap() + +VizEquiMap() plots the map with rectangular equidistant projection. +It has various parameters to adjust the visualization. + +#### Basic usage + +Plot the raw experimental and observational data. +```r +# Plot the first experiment, ensemble mean, first start year, first forecast time +exp1 <- ClimProjDiags::Subset(exp, c("dat", "var"), list(1, 1), drop = 'selected') +exp1 <- s2dv::MeanDims(exp1, "ensemble") +lats <- attr(exp, 'Variables')$system5c3s$lat +lons <- attr(exp, 'Variables')$system5c3s$lon + +VizEquiMap(exp1[1, 1, , ], lon = lons, lat = lats, filled.continents = FALSE, + toptitle = "SEAS5 near-surface temperature, Nov. 1997", + units = "K", bar_limits = c(250, 300), brks = 21, + width = 8, height = 8, bar_extra_margin = c(1, 0, 1, 0), + fileout = 'maps_equimap_raw_exp1.png') + +# Plot corresponding observational data +obs1 <- ClimProjDiags::Subset(obs, c("dat", "var"), list(1, 1), drop = 'selected') +VizEquiMap(obs1[1, 1, , ], lon = lons, lat = lats, filled.continents = FALSE, + toptitle = "ERA5 near-surface temperature, Nov. 1997", + units = "K", bar_limits = c(250, 300), brks = 21, + width = 8, height = 8, bar_extra_margin = c(1, 0, 1, 0), + fileout = 'maps_equimap_raw_obs.png') +``` + + + +#### dots + +Plot correlation with the significance by parameter `dots`. +Use s2dv function `Corr()` to calculate the correlation. The dotted points are the insignificant ones. + +```r +corr <- s2dv::Corr(exp1, obs1, time_dim = 'sdate', dat_dim = NULL, sign = TRUE, + conf = FALSE, pval = FALSE) +VizEquiMap(corr$corr[1, , ], lon = lons, lat = lats, filled.continents = FALSE, + dots = !drop(corr$sign)[1, , ], dot_symbol = 3, dot_size = 1.2, + toptitle = "Correlation of near-surface temperature, SEAS5 - ERA5, Nov. 1997", + title_scale = 0.7, color_fun = ClimPalette("yellowred"), + bar_limits = c(0, 1), brks = 21, + width = 8, height = 8, bar_extra_margin = c(1, 0, 1, 0), + fileout = 'maps_equimap_corr_exp1_obs.png') +``` + + + +#### contours + +To draw the contour lines, set parameter `square` as FALSE to smooth the grid borders. +The contours can be adjusted by providing a matrix to parameter `contours` with dimensions +`c(n. of longitudes, n. of latitudes)`. The contours matrix will be drawn over the map, +using the thresholds provided in `brks2`. + +You can also plot the contours of the original data without border +smoothing, to plot only some of the default contours, or to plot contours +defined by another field. + +Here, we plot the same raw data as the previous section but with contours. +```r +VizEquiMap(exp1[1, 1, , ], lon = lons, lat = lats, filled.continents = FALSE, + square = FALSE, + toptitle = "SEAS5 near-surface temperature, Nov. 1997", + units = "K", bar_limits = c(250, 300), brks = 21, + width = 8, height = 8, bar_extra_margin = c(1, 0, 1, 0), + fileout = 'maps_equimap_contour_raw_exp1.png') + +# Adjust the styles +VizEquiMap(exp1[1, 1, , ], lon = lons, lat = lats, filled.continents = FALSE, + square = TRUE, + contours = exp1[1, 1, , ], contour_lwd = 1, brks2 = seq(240, 300, 5), + contour_color = 'blue', contour_lty = 5, contour_label_scale = 0.7, + toptitle = "SEAS5 near-surface temperature, Nov. 1997", + units = "K", bar_limits = c(250, 300), brks = 21, + width = 8, height = 8, bar_extra_margin = c(1, 0, 1, 0), + fileout = 'maps_equimap_contour_raw_exp1_ver2.png') +``` + + + + +#### Boxes + +We can draw boxes on the map using parameters `boxlim`, `boxcol` and `boxlwd`. +They specify the position of the corners, color and thickness of a box to be drawn +on the map. + +We use the same raw data from the previous section and add two boxes, +one over Alpine region (green) and one over south side of Mediterranean Sea (yellow). +```r +VizEquiMap(exp1[1, 1, , ], lon = lons, lat = lats, filled.continents = FALSE, + toptitle = "SEAS5 near-surface temperature, Nov. 1997", + units = "K", bar_limits = c(250, 300), brks = 21, + width = 8, height = 8, bar_extra_margin = c(1, 0, 1, 0), + boxlim = list(c(6, 45, 15, 48), c(10, 30, 20, 36)), + boxcol = c('green', 'yellow'), boxlwd = c(2, 2), + fileout = 'maps_equimap_raw_exp1_boxes.png') +``` + + + + +### VizStereoMap() + +`VizStereoMap()` plots the map with stereographic projection. +It can be called almost identically to `VizEquiMap()`, except +that it requires the `latlims` parameter to specify which range of latitudes to +be plotted on the stereographic projection map. +The parameter `intlat` can set the interval in degrees between consecutive latitude circles on the plot. + +Next a couple of examples: + +```r +## Loading data over the entire globe +world_data <- Load('tas', list(expA, expB), list(obsX), + sdates = sdates[1], + leadtimemin = 2, leadtimemax = 13, + latmin = -90, latmax = 90, + lonmin = 0, lonmax = 360, + output = 'lonlat', grid = 't106grid', + method = 'distance-weighted') +VizStereoMap(s2dv::MeanDims(world_data$mod, 2)[1, 1, 1, , ], + world_data$lon, world_data$lat, c(40, 90), + brks = 100, bar_limits = c(240, 290), + toptitle = "Exp. A 'tas', s. date: 1990-11-01, f. time: 1 month", + title_scale = 0.5, + units = "K", filled.continents = 'black', + fileout = 'vis_stereomap_raw_expA.png') + +VizStereoMap(s2dv::MeanDims(world_data$obs, 2)[1, 1, 10, , ], + world_data$lon, world_data$lat, c(-90, -60), intlat = 10, + brks = 100, bar_limits = c(240, 290), + boxlim = list(c(0, -85, 135, -70)), + toptitle = "Obs. X 'tas', 1990-12-01", + title_scale = 0.5, + units = "K", fileout = 'vis_stereomap_raw_obsX.png') +``` + + + + +### VizAnimateMap() + +`VizAnimateMap()` generates animations of maps from `VizEquiMap()` or +`VizStereoMap()` and saves them in GIF files at the paths specified in the +parameter `fileout`. It receives an array with the dimensions: +```r + c(n. of experiments/observations, n. of observations, 3, n. of forecast times, n. of latitudes, n. of longitudes) +``` +the first 3 being optional and the 3rd dimension corresponding to the lower +confidence interval, the actual value and the upper confidence interval. This +means it can plot maps of a field of one or multiple experimental or +observational datasets, averaged across ensemble members and starting dates +(climatologies) or indices or scores computed across starting dates against +one or more observations. The confidence intervals, if provided, are used to +draw black dots on grid cells that reach a 95% significance level, if +requested via `msk95lev`. + +The provided data is assumed to be in a monthly frequency and to start at +January. Otherwise it can be adjusted with `monini` and `freq`. + +Whether to plot with a equidistant rectangular projection or a stereographic +projection can be chosen with the parameter `equi`. The plot can be limited to +a sub-region of the provided data via the parameters `lonmin`, `lonmax`, +`latmin` and `latmax`. + +`AnimateMap()` allows for the typical adjustments in the map plotting +functions: specifying the palette colors and breaks (`col` and `brk`), +displaying or not a legend (`drawleg`, `subsampleg`), selecting a color for +the NA values (`colNA`) and filling or not the continents +(`filled.continents`). + +Further title and axis tick adjustments can be achieved with `toptitle`, +`sizetit`, `units`, `intlon` and `intlat`. +brk col drawleg subsampleg colNA filled.continents + +Next a few examples: + +```r +map_clim <- s2dv::Clim(map_data$mod, map_data$obs, memb = FALSE) + +cols <- ClimColors(50) + +data_min <- min(map_data$mod, map_data$obs, na.rm = TRUE) +data_max <- max(map_data$mod, map_data$obs, na.rm = TRUE) +brks <- round(seq(data_min, data_max, length.out = length(cols) + 1), 2) + +AnimateMap(ClimProjDiags::Subset(map_clim$exp, 'dataset', 1), + map_data$lon, map_data$lat, monini = 12, + toptitle = "Exp. A climatologies.", + units = "K", brks = brks, cols = cols, + fileout = "vis_anim_clim_expA.gif") +``` + + +And, as seen in [**Snippet 2**](snippets.md#snippet2), the animations of the +actual time correlations of Experiment A and B against Observation X over the +Atlantic, with black dots on values that reach a 95% significance level: + + + + + +Also the entire globe and stereographic projection maps can be animated: + +```r +world_clim <- s2dv::Clim(world_data$mod, world_data$obs, memb = FALSE) +AnimateMap(ClimProjDiags::Subset(world_clim$exp, 'dataset', 1), + world_data$lon, world_data$lat, + filled.continents = FALSE, monini = 12, + toptitle = "Exp. A climatologies.", units = "K", + brks = brks, cols = cols, + fileout = 'vis_anim_clim_expA_world.gif') +AnimateMap(world_clim$obs, + world_data$lon, world_data$lat, equi = FALSE, + latmin = 60, latmax = 90, monini = 12, + toptitle = "Obs. X climatologies.", + units = "K", brks = brks, cols = cols, + fileout = "vis_anim_clim_obsX_world.gif") +``` + + + + + +### VizLayout() + +This function allows to easily combine plots from any R plot function in +layouts. The input data can be provided in multiple data arrays, and a common +colour bar can be set for the multi-panel. + +A common use case is to plot the ensemble members at a given time step: + +```r +VizLayout(VizEquiMap, c('lat', 'lon'), + ClimProjDiags::Subset(map_data$mod, + list('dataset', 'sdate', 'ftime'), + list(1, 1, 1)), + map_data$lon, map_data$lat, units = 'K', + toptitle = "Exp. A 'tas', s. date: 1990-11-01, f.time: 1 month", + titles = paste("Member", 1:dim(map_data$mod)[2]), + brks = 50, bar_limits = c(250, 300), coast_color = 'black', + fileout = "vis_layout_equimap_expA.png") +``` + + + +But really complex layouts can be achieved thanks to the great number of +available parameters: + +```r +ens_mean <- ClimProjDiags::Subset(world_data$mod, + list('dataset', 'sdate', 'ftime'), + list(1, 1, 1)) +layout <- VizLayout(fun = c('VizEquiMap', 'plot', 'plot', 'VizStereoMap'), + plot_dims = c('lat', 'lon'), + var = list(ens_mean, array(1:10), + array(10:1), ens_mean), + lon = world_data$lon, lat = world_data$lat, + fill = 'black', sizetit = 0.5, axes_label_scale = 0.6, + coast_color = 'yellow', + titles = paste('Fig.', 1:12), toptitle = 'Multipanel', + row_titles = paste('Row', 1:3), col_titles = paste('Col', 1:4), + drawleg = 'E', units = 'K', units_scale = 2, + bar_limits = c(275, 300), brks = 26, + bar_extra_labels = 281:284, + width = 12, height = 10, res = 200, + fileout = 'vis_layout_complex.png') +``` + + + +### VizSection() + +WIP. diff --git a/vignettes/time_series.md b/vignettes/time_series.md new file mode 100644 index 0000000000000000000000000000000000000000..c42847326311559a2ee6ecbd9dfb3df15822f1f0 --- /dev/null +++ b/vignettes/time_series.md @@ -0,0 +1,484 @@ +--- +author: "An-Chi Ho" +date: "2023-11-03" +output: html_document +vignette: > + %\VignetteEngine{R.rsp::md} + %\VignetteIndexEntry{Visualisation} + %\usepackage[utf8]{inputenc} +--- + +# Time series plotting + +In this vignette, we will go through the functions that plot the time series type of figures: +`VizAno()`, `VizClim()`, `VizVsLtime()`, `Viz2VarsVsLTime()`, `VizBoxWhisker()`, `VizACC()`. + +We will use the data loaded in [data_loading.md](#data-loading). +Please follow that vignette first to get the data if you want to replicate the results in this vignette. + +All the functions devoted to plotting time series have some common traits and +parameters: + - Aimed to plot monthly, seasonal or yearly time series, adjustable via the +parameter `freq`. + - All of them generate plots and save them to PostScript files the path and +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`, +`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 +the underlying R graphics `plot()` function for a fine tuning. + +## Multi-member raw data or anomalies + +`VizAno()` also takes one or two data arrays as inputs with 4 dimensions each: +```r + c(n. of datasets, n. of members, n. of start dates, n. of forecast times) +``` +The data in the provided arrays can be raw data, anomalies or any other kind +of data, as long as it is arranged with the required dimensions. +If any dimension is missing, `s2dv::InsertDim` can insert it to make the function work. + +For each dataset, a thick line with the ensemble mean is plotted +together with a finer line for each member, unless any of these are +disabled with `ensmean` or `memb`, respectively. +The area delimited by the minimum and maximum ensemble values at each forecast time is filled with a +different color for each start date, unless disabled with `fill`. +A fine black line is plotted for the observational data alongside each +starting date. +The function creates separate plots for each experimental dataset provided in the experimental data array. + +The start dates of the data need to be provided with the parameter `sdates` for them to be plotted accordingly along the x axis. + +`linezero` draws a line at y = 0 to help perceiving whether the anomaly is +positive or negative, and `vlines` draws vertical lines at any specified location. The parameter `points` can draw all the lines in pointed style. + +We need to adjust the data arrays before putting them in `VizAno()`: Reorder the dimension order and insert missing dimension 'ensemble' for obs data. +```r +exp_sm <- s2dv::Reorder(exp_sm, c("dat", "ensemble", "sdate", "time")) +obs_sm <- s2dv::Reorder(obs_sm, c("dat", "sdate", "time")) +obs_sm <- s2dv::InsertDim(obs_sm, 2, 1, "ensemble") + +sdates <- paste0(1997:2016, '1101') + +VizAno(exp_sm, obs_sm, sdates, + toptitle = paste0(c('SEAS5', 'Meteo-France System 7'), ": Raw 'tas' over Europe"), + ytitle = c("K", "K"), legends = "ERA5", + fileout = paste0("vis_raw_exp", 1:2, "_obs.png")) +``` + + + + +## Climatologies + +`VizClim()` takes an experimental and/or an observational array of 2 to 3 dimensions each as inputs: +```r + c(n. of datasets, n. of members, n. of forecast times) +``` +The latitude and longitude dimensions must have been removed either because working on area-averages or +because working on a single grid point. And the start dates dimension +must have also been removed by time average, i.e. climatologies. + +A curve is plotted for each member of each experiment or observation. The +members of the same dataset are colored with the same color whereas the +different datasets are plotted with different colors. +`VizClim()` assumes by default that the provided climatologies start in +January. Otherwise the initial month can be specified with the parameter `monini`. + +We firstly take the spatial mean data to calculate climatology by `s2dv::Clim`, then put the outputs in `VizClim()`. + +```r +clim_sm <- s2dv::Clim(exp_sm, obs_sm, dat_dim = c("dat", "ensemble"), memb_dim = "ensemble") + +VizClim(clim_sm$clim_exp, clim_sm$clim_obs, monini = 11, + toptitle = "Per-pair 'tas' climatologies, Europe", + ytitle = "K", + listexp = c('SEAS5', 'Meteo-France System 7'), listobs = c('ERA5'), + fileout = "vis_clim_exp1_exp2_obs.png") +``` + + + +## Statistics and scores + +The functions `VizVsLTime()`, `Viz2VarsVsLTime()` and `VizACC()` serve to +plot time series of indices or scores that usually come +together with confidence intervals and significance levels. +We use the statistical functions from package "s2dv" to process the data. + + +### VizVsLTime + +`VizVsLTime()` takes as main input an array of data with the following dimensions: + +```r + c(n. of experiments, n. of observational datasets, 3 or 4, n. of forecast times) +``` + +The second dimension is optional, and the third one is corresponding to the lower +limit of a confidence interval, the measurement or index or score, the upper +limit of a confidence interval and, optionally, a significance level. +This dimension format requires that the index or score to be plotted is computed +along the actual time (start dates) and over the average of the ensemble member, +either at a single grid point or from an area average. + +A curve is drawn for each pair of (experiment, observation) with a different +color and line style. The scores or indices that corresponds to the same +experiment are coloured equally, and a different line style is used for each +observation that the experiment has been compared with. +The confidence intervals are plotted with a finer line of the same color and +line style, unless disabled with `show_conf`. +To plot the significance level instead, the parameter `siglev` can be set to `TRUE`. + +The start month of each curve is January as default, and it can be adjusted by parameter `monini`. +Additionally the number of ticks along the x axis can be adjusted with +`nticks` and any number of horizontal lines can be drawn by specifying the +target ordinates to `hlines`. + +`VizVsLTime()` can be useful in the following situations: + 1. To plot trend or regression fitted coefficients of ensemble-mean data + 2. To plot the spread (i.e., interquartile range, maximum minus minimum, standard deviation +or median absolute deviation) across ensemble members and starting dates + 3. To plot the correlation, RMSE, and RMSSS between ensemble-mean experiments and observations + 4. To plot the ratio of RMSE between two experiments + 5. To plot the ratio between the standard deviation and RMSE of the experiment + 6. To plot effective number of independent data + + +#### 1. Trend and Regression + +First, we use s2dv function `Ano_CrossValid` to get the anomalies of experimental data, +`MeanDims` to calculate the ensemble mean, then use `Trend` to calculate the temporal trend of anomaly. + +```r +# Calculate anomalies and trend +ano <- s2dv::Ano_CrossValid(exp_sm, obs_sm, memb = FALSE, dat_dim = c("dat", "ensemble"), memb_dim = "ensemble") + +trend_exp <- s2dv::Trend(s2dv::MeanDims(ano$exp, 'ensemble'), time_dim = "sdate") +``` + +The output of `s2dv::Trend` has the following elements: `trend`, `conf.lower`, +`conf.upper`, `p.val`, and `detrended`. The dimension `stats` of the first four elements +contains the regression coefficients from the lowest order (i.e., intercept) to the highest degree. + +`VizVsLTime` requires the input to have the dimensions (dat, 4, time) and the 4 elements +together in the following order: `conf.lower`, slope , `conf.upper`, intercept. +So, we need to resemble the trend output first. After that, we plot the trend +along with the confidence level of two experiements in the same plot. + +```r +input_trend <- array(dim = c(dat = 2, 4, time = 6)) +input_trend[, 1, ] <- trend_exp$conf.lower[2, , ] +input_trend[, 2, ] <- trend_exp$trend[2, , ] +input_trend[, 3, ] <- trend_exp$conf.upper[2, , ] +input_trend[, 4, ] <- trend_exp$trend[1, , ] + +VizVsLTime(input_trend, + toptitle = "Trend of 'tas' over Europe", + ytitle = "K/year", limits = c(-0.05, 0.1), + monini = 11, freq = 1, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_trend_exp1_exp2.png') +``` + + +We use the ensemble-mean anomaly as well to calculate regression between two +experiments by `s2dv::Regression`. Regression() has the same output elements +like Trend() output, and we also need to reorganize them to have a proper +input for VizVsLTime(). + +```r +reg_ano <- s2dv::Regression(s2dv::MeanDims(ano$exp, 'ensemble')[, 1, ], + s2dv::MeanDims(ano$exp, 'ensemble')[, 2, ], + reg_dim = "sdate") + +input_reg <- array(dim = c(dat = 1, 4, time = 6)) +input_reg[1, 1, ] <- reg_ano$conf.lower[2, ] +input_reg[1, 2, ] <- reg_ano$regression[2, ] +input_reg[1, 3, ] <- reg_ano$conf.upper[2, ] +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, + fileout = 'vis_regression_exp1_exp2.png') +``` + + + +#### 2. Spread + +We use the anomalies to calculate the following statstical numbers: +interquartile range, maximum minus minimum, standard deviation, +and median absolute deviation by `s2dv::Spread`, across ensemble members +and start dates. + +```r +spread <- s2dv::Spread(ano$exp, compute_dim = c("ensemble", "sdate")) +spread <- lapply(spread, aperm, c(2, 1, 3)) + +spr_stats <- list('IQR', 'Max.-min', 'SD', 'MAD') +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, + monini = 11, freq = 1, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = paste0('vis_', names(spr_stats)[i_plot], '_exp1_exp2.png')) + + do.call(VizVsLTime, inputs) +} +``` + + + + + + +#### 3. Correlation, RMSE, and RMSSS + +We use s2dv function `Corr()`, `RMS()`, and `RMSSS()` to calculate correlation, +RMSE (root mean square error), and RMSSS (root mean square error skill score) correspondingly +between ensemble-mean experiments and the observation, then adjust the outputs to fit in +`VizVsLTime()`. + +```r +corr_ano <- s2dv::Corr(s2dv::MeanDims(ano$exp, 'ensemble'), + s2dv::MeanDims(ano$obs, 'ensemble'), + time_dim = 'sdate', dat_dim = 'dat') + +input_cor <- array(dim = c(dat = 2, 4, time = 6)) +input_cor[, 1, ] <- corr_ano$conf.lower[, 1, ] +input_cor[, 2, ] <- corr_ano$corr[, 1, ] +input_cor[, 3, ] <- corr_ano$conf.upper[, 1, ] +input_cor[, 4, ] <- corr_ano$p.val[, 1, ] + +VizVsLTime(input_cor, + toptitle = "Time correlation with ERA5, over Europe", + ytitle = "K", sizetit = 0.7, + monini = 11, freq = 1, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_corr_exp1_exp2_obs.png') +``` + + +```r +rms_ano <- s2dv::RMS(s2dv::MeanDims(ano$exp, 'ensemble'), + s2dv::MeanDims(ano$obs, 'ensemble'), + time_dim = 'sdate', dat_dim = 'dat') + +input_rms <- array(dim = c(dat = 2, 3, time = 6)) +input_rms[, 1, ] <- rms_ano$conf.lower[, 1, ] +input_rms[, 2, ] <- rms_ano$rms[, 1, ] +input_rms[, 3, ] <- rms_ano$conf.upper[, 1, ] + +VizVsLTime(input_rms, + toptitle = "RMSE against ERA5, over Europe", + ytitle = "K", sizetit = 0.7, + monini = 11, freq = 1, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_rms_exp1_exp2_obs.png') +``` + + + +```r +rmsss <- s2dv::RMSSS(s2dv::MeanDims(ano$exp, 'ensemble'), + s2dv::MeanDims(ano$obs, 'ensemble'), + dat_dim = 'dat') +input_rmsss <- array(dim = c(nexp = 2, nobs = 1, 4, time = 6)) +input_rmsss[, 1, 2, ] <- rmsss$rmsss +input_rmsss[, 1, 4, ] <- rmsss$p.val + +VizVsLTime(input_rmsss, + toptitle = "RMSSS against ERA5 , Europe", + ytitle = "K", sizetit = 0.7, + monini = 11, freq = 1, siglev = TRUE, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_rmsss_exp1_exp2_obs.png') +``` + + + +#### 4. The ratio of RMSE between two experiments + +Another s2dv function `RatioRMS` calculates the ratio of two experiments against +the same observation. P-value is plotted along the ratio. + +```r +ratio_rms <- s2dv::RatioRMS(s2dv::MeanDims(ano$exp[, 1, , ], 'ensemble'), + s2dv::MeanDims(ano$exp[, 2, , ], 'ensemble'), + ano$obs[, 1, 1, ]) + +input_ratio_rms <- array(dim = c(1, 4, time = 6)) +input_ratio_rms[1, 2, ] <- ratio_rms$ratiorms +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, + fileout = 'vis_ratiorms_exp1_exp2_obs.png') +``` + + + +#### 5. The ratio between standard deviation and RMSE + +To plot the ratio between the standard deviation and RMSE of the experiment, we can use +s2dv function `RatioSDRMS()`. P-value is plotted along with the ratios. + +```r +ratio_sdrms <- s2dv::RatioSDRMS(ano$exp, ano$obs, dat_dim = 'dat', memb_dim = 'ensemble') + +input_ratio_sdrms <- array(dim = c(nexp = 2, nobs = 1, 4, time = 6)) +input_ratio_sdrms[, 1, 2, ] <- ratio_sdrms$ratio +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, + monini = 11, freq = 1, siglev = TRUE, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_ratiosdrms_exp1_exp2_obs.png') +``` + + +We can also calculate the ration of SD and RMS for one experiment only but against +two observational data. Since only one observational data is loaded, we create another +one by adding a little disturbance. + +```r +# Create another obs by adding random turbulance +obs2 <- abind::abind(ano$obs, + ano$obs + rnorm(length(ano$obs), 0, 0.1), + along = 2) +names(dim(obs2)) <- names(dim(ano$obs)) + +ratio_sdrms <- s2dv::RatioSDRMS(ClimProjDiags::Subset(ano$exp, 'dat', 1, drop = F), + obs2, + dat_dim = 'dat', memb_dim = 'ensemble') + +input_ratio_sdrms <- array(dim = c(nexp = 1, nobs = 2, 4, time = 6)) +input_ratio_sdrms[1, , 2, ] <- ratio_sdrms$ratio +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, + monini = 11, freq = 1, siglev = TRUE, + listexp = c('SEAS5'), + listobs = c('ERA5', 'ERA5 with random turbulance'), + fileout = 'vis_ratiosdrms_exp1_obs1_obs2.png') +``` + + + +#### 6. Effective number of independent data + +We use s2dv function `Eno()` to get the effective number of independent data. + +```r +eno <- s2dv::Eno(s2dv::MeanDims(ano$exp, 'ensemble'), time_dim = 'sdate') + +input_eno <- array(dim = c(dat = 2, 4, time = 6)) +input_eno[, 2, ] <- eno + +VizVsLTime(input_eno, + toptitle = "Effective n. of independent data, Europe", + sizetit = 0.7, + monini = 11, freq = 1, siglev = FALSE, show_conf = FALSE, + listexp = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_eno_exp1_exp2.png') +``` + + + +### Viz2VarsVsLTime + +`Viz2VarsVsLTime()` allows to plot two indices or scores on the same plot, +each with its confidence intervals. It accepts as inputs arrays of only 3 dimensions: + +```r + c(n. of experiments, 3/4, n. of forecast times) +``` + +i.e., it accepts only indices or scores from a set of experimental datasets against +a single observation. +The usage is similar to `VizVsLTime()`, with one parameter `listvars`to create legend for variables. +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, + monini = 11, freq = 1, limits = c(-0.8, 2.2), + listexp = c('SEAS5', 'Meteo-France System 7'), + listvars = c('Corr', 'RMSE'), + fileout = 'vis_corr_rms_exp1_exp2_obs.png') +``` + + + +### VizACC + +`VizACC()` plots the time series of anomaly correlation coefficients. The accepted +input dimensions are: +```r + c(n. of experiments, n. of observational datasets, n. of starting dates, n. of forecast times, 4) +``` +The last dimension includes the lower limit of the 95% confidence interval, ACC, the upper limit of +the 95% confidence interval, and the 95% significance level. + +The ACCs and confidence intervals of all forecast times and starting dates of +all experiments are plotted. The consecutive start dates are overlapped to make +comparison easier. + +All the start dates of an experiment are painted with the same color. +There are two possible styles controled by the parameter `points`: + - Drawing curves along forecast times, as in `VizVsLTime()`. In that case +`fill` can enable filling the area limited by the confidence intervals. + - Drawing a point for each forecast time, with vertical lines joined to the +extremes of the confidence interval, limited with notches (default). + +Besides, `linezero` draws a line at ordinate 0 and `vlines` draws vertical +lines at any specified set of abscissae. + +We need to calculate the anomalies (by `s2dv::Ano_CrossValid`) with all the spatial data first, +then use `s2dv::ACC` to calculate the anomaly correlation coefficients. After that, +adjust the outputs to fit in `VizACC()`. + +```r +ano_latlon <- s2dv::Ano_CrossValid(exp, obs, memb = FALSE, dat_dim = c('dat', 'ensemble'), memb_dim = 'ensemble') + +acc <- s2dv::ACC(ano_latlon$exp, ano_latlon$obs, + lat = lat, lon = lon, + dat_dim = 'dat', memb_dim = 'ensemble') + +input_acc <- array(dim = c(dim(acc$acc)[c('nexp', 'nobs', 'sdate', 'time')], 4)) +input_acc[, , , , 1] <- acc$conf.lower +input_acc[, , , , 2] <- acc$acc +input_acc[, , , , 3] <- acc$conf.upper +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), + legends = c('SEAS5', 'Meteo-France System 7'), + fileout = 'vis_acc_exp1_exp2_obs.png') +``` + + + +### VizBoxWhisker + +WIP. + + +