Nothing
R/VizEquiMap.R
In esviz: Plotting Functions for Climate Science and Services
Defines functions
VizEquiMap
Documented in
VizEquiMap
#'Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection
#'
#'Map longitude-latitude array (on a regular rectangular or gaussian grid)
#'on a cylindrical equidistant latitude and longitude projection with coloured
#'grid cells. Only the region for which data has been provided is displayed.
#'A colour bar (legend) can be plotted and adjusted. It is possible to draw
#'superimposed arrows, dots, symbols, contour lines and boxes. A number of
#'options is provided to adjust the position, size and colour of the
#'components. Some parameters are provided to add and adjust the masks that
#'include continents, oceans, and lakes. This plot function is compatible with
#'figure layouts if colour bar is disabled.
#'
#'@param data Array with the values at each cell of a grid on a regular
#' rectangular or gaussian grid. The array is expected to have two
#' dimensions: c(latitude, longitude). Longitudes can be in ascending or
#' descending order and latitudes in any order. It can contain NA values
#' (coloured with 'colNA'). Arrays with dimensions c(longitude, latitude)
#' will also be accepted but 'lon' and 'lat' will be used to disambiguate so
#' this alternative is not appropriate for square arrays. It is allowed that
#' the positions of the longitudinal and latitudinal coordinate dimensions
#' are interchanged.
#'@param var Deprecated. Use 'data' instead.
#'@param lon Numeric vector of longitude locations of the cell centers of the
#' grid of 'data', in ascending or descending order (same as 'data'). Expected
#' to be regularly spaced, within either of the ranges [-180, 180] or
#' [0, 360]. Data for two adjacent regions split by the limits of the
#' longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)}
#' ('data' must be provided consitently).
#'@param lat Numeric vector of latitude locations of the cell centers of the
#' grid of 'data', in any order (same as 'data'). Expected to be from a regular
#' rectangular or gaussian grid, within the range [-90, 90].
#'@param varu Array of the zonal component of wind/current/other field with
#' the same dimensions as 'data'. It is allowed that the positions of the
#' longitudinal and latitudinal coordinate dimensions are interchanged.
#'@param varv Array of the meridional component of wind/current/other field
#' with the same dimensions as 'data'. It is allowed that the positions of the
#' longitudinal and latitudinal coordinate dimensions are interchanged.
#'@param toptitle Top title of the figure, scalable with parameter
#' 'title_scale'.
#'@param sizetit Scale factor for the figure top title provided in parameter
#' 'toptitle'. Deprecated. Use 'title_scale' instead.
#'@param caption A character string of the caption located at the left-bottom of
#' the plot. Captions with multiple lines can be constructed using string
#' manipulation functions like \code{paste()} or \code{paste0()}, using
#' \code{"\n"} to indicate line breaks.
#'@param units Title at the top of the colour bar, most commonly the units of
#' the variable provided in parameter 'data'.
#'@param brks,cols,bar_limits,triangle_ends Usually only providing 'brks' is
#' enough to generate the desired colour bar. These parameters allow to
#' define n breaks that define n - 1 intervals to classify each of the values
#' in 'data'. The corresponding grid cell of a given value in 'data' will be
#' coloured in function of the interval it belongs to. These parameters are
#' sent to \code{ColorBar()} to generate the breaks and colours. Additional
#' colours for values beyond the limits of the colour bar are also generated
#' and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are
#' properly provided to do so. See ?ColorBar for a full explanation.
#'@param col_inf,col_sup,colNA Colour identifiers to colour the values in
#' 'data' that go beyond the extremes of the colour bar and to colour NA
#' values, respectively. 'colNA' takes attr(cols, 'na_color') if available by
#' default, where cols is the parameter 'cols' if provided or the vector of
#' colors returned by 'color_fun'. If not available, it takes 'pink' by
#' default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not
#' specified. See ?ColorBar for a full explanation on 'col_inf' and 'col_sup'.
#'@param color_fun,subsampleg,bar_extra_labels,draw_bar_ticks Set of
#' parameters to control the visual aspect of the drawn colour bar
#' (1/3). See ?ColorBar for a full explanation.
#'@param draw_separators,triangle_ends_scale,bar_label_digits Set of
#' parameters to control the visual aspect of the drawn colour bar
#' (2/3). See ?ColorBar for a full explanation.
#'@param bar_label_scale,units_scale,bar_tick_scale,bar_extra_margin Set of
#' parameters to control the visual aspect of the drawn colour bar (3/3).
#' See ?ColorBar for a full explanation.
#'@param square Logical value to choose either to draw a coloured square for
#' each grid cell in 'data' (TRUE; default) or to draw contour lines and fill
#' the spaces in between with colours (FALSE). In the latter case,
#' 'filled.continents' will take the value FALSE if not specified.
#'@param filled.continents Colour to fill in drawn projected continents.
#' 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".
#'@param country.borders A logical value indicating if the country borders
#' should be plotted (TRUE) or not (FALSE). It only works when
#' 'filled.continents' is FALSE. The default value is FALSE.
#'@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 lake_color Colour of the lake or other water body inside continents.
#' The default value is NULL.
#'@param shapefile A character string of the path to a .rds file or a list
#' object containinig shape file data. If it is a .rds file, it should contain
#' a list. The list should contains 'x' and 'y' at least, which indicate the
#' location of the shape. The default value is NULL.
#'@param shapefile_color Line color of the shapefile.
#'@param shapefile_lwd Line width of the shapefile. The default value is 1.
#'@param contours Array of same dimensions as 'data' to be added to the plot
#' and displayed with contours. Parameter 'brks2' is required to define the
#' magnitude breaks for each contour curve. Disregarded if 'square = FALSE'.
#' It is allowed that the positions of the longitudinal and latitudinal
#' coordinate dimensions are interchanged.
#'@param brks2 Vector of magnitude breaks where to draw contour curves for the
#' array provided in 'contours' or if 'square = FALSE'.
#'@param contour_lwd Line width of the contour curves provided via 'contours'
#' and 'brks2', or if 'square = FALSE'.
#'@param contour_color Line color of the contour curves provided via 'contours'
#' and 'brks2', or if 'square = FALSE'.
#'@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_draw_label A logical value indicating whether to draw the
#' contour labels or not. The default value is TRUE.
#'@param contour_label_scale Scale factor for the superimposed labels when
#' drawing contour levels.
#'@param dots Array of same dimensions as 'data' or with dimensions
#' c(n, dim(data)), where n is the number of dot/symbol layers to add to the
#' plot. A value of TRUE at a grid cell will draw a dot/symbol on the
#' corresponding square of the plot. By default all layers provided in 'dots'
#' are plotted with dots, but a symbol can be specified for each of the
#' layers via the parameter 'dot_symbol'. It is allowed that the positions of
#' the longitudinal and latitudinal coordinate dimensions are interchanged.
#'@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 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
#' layers in 'dots'. Takes 1 by default.
#'@param mask An array with the same dimensions as 'data' with values in the
#' range of [0, 1] or logical, indicating the opacity of the mask over each
#' grid point. Cells with a 0 or FALSE will result in a totally opaque
#' superimposed pixel coloured in 'mask_color', whereas cells with a 1 or TRUE
#' will have no mask and remain totally visible. If the array is numeric, values
#' between 0 and 1 will have shades of transparency.
#'@param mask_color Color of the mask. The default value is 'white'.
#'@param arr_subsamp 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. Takes 1 by default.
#'@param arr_scale Scale factor for drawn arrows from 'varu' and 'varv'.
#' Takes 1 by default.
#'@param arr_ref_len 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). Defaults to 15.
#'@param arr_units Units of 'varu' and 'varv', to be drawn in the legend.
#' Takes 'm/s' by default.
#'@param arr_scale_shaft Parameter for the scale of the shaft of the arrows
#' (which also depend on the number of figures and the arr_scale parameter).
#' Defaults to 1.
#'@param arr_scale_shaft_angle Parameter 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). Defaults to 1.
#'@param axelab Whether to draw longitude and latitude axes or not.
#' TRUE by default.
#'@param labW Whether to label the longitude axis with a 'W' instead of minus
#' for negative values. Defaults to FALSE.
#'@param lab_dist_x A numeric of the distance of the longitude labels to the
#' box borders. The default value is NULL and is automatically adjusted by
#' the function.
#'@param lab_dist_y A numeric of the distance of the latitude labels to the
#' box borders. The default value is NULL and is automatically adjusted by
#' the function.
#'@param degree_sym A logical indicating whether to include degree symbol
#' (30° N) or not (30N; default).
#'@param intylat Interval between latitude ticks on y-axis, in degrees.
#' Defaults to 20.
#'@param intxlon Interval between latitude ticks on x-axis, in degrees.
#' Defaults to 20.
#'@param xlonshft A numeric of the degrees to shift the latitude ticks. The
#' default value is 0.
#'@param ylatshft A numeric of the degrees to shift the longitude ticks. The
#' default value is 0.
#'@param xlabels A vector of character string of the custumized x-axis labels.
#' The values should correspond to each tick, which is decided by the longitude
#' and parameter 'intxlon'. The default value is NULL and the labels will be
#' automatically generated.
#'@param ylabels A vector of character string of the custumized y-axis labels.
#' The values should correspond to each tick, which is decided by the latitude
#' and parameter 'intylat'. The default value is NULL and the labels will be
#' automatically generated.
#'@param axes_tick_scale Scale factor for the tick lines along the longitude
#' and latitude axes.
#'@param axes_label_scale Scale factor for the labels along the longitude
#' and latitude axes.
#'@param drawleg Whether to plot a color bar (legend, key) or not. Defaults to
#' TRUE. It is not possible to plot the colour bar if 'add = TRUE'. Use
#' ColorBar() and the return values of PlotEquiMap() instead.
#'@param vertical TRUE/FALSE for vertical/horizontal colour bar. Default is
#' FALSE. Parameters 'width' and 'height' might need to be modified to
#' accommodate the vertical colour bar.
#'@param include_lower_boundary Logical value indicating whether to include
#' the minimum value of the field. Takes TRUE by default.
#'@param include_upper_boundary Logical value indicating whether to include
#' the maximum value of the field. Takes TRUE by default.
#'@param hatching_mask Logical or binary (0/1) array with two named dimensions:
#' c(latitude, longitude). Hatching is applied to grid cells where
#' 'hatching_mask' is TRUE (or 1). Arrays with dimensions c(longitude, latitude)
#' are also accepted, but the resulting hatching may appear transposed. To
#' ensure correct alignment with the map, provide 'data'. The function will
#' compare the dimension order of 'hatching_mask' and 'data', and automatically
#' transpose 'hatching_mask' if the latitude and longitude dimensions appear to
#' be reversed.
#'@param hatching_density The density of shading lines, in lines per inch. A
#' zero value of density means no shading nor filling, whereas negative values
#' and NA suppress shading (and so allow color filling). NULL means that no
#' shading lines are drawn. Default is 10.
#'@param hatching_angle The slope of shading lines, given as an angle in degrees
#' (counter-clockwise). Default is 45.
#'@param hatching_color Color of the hatching lines. Default is
#' \code{"#252525"}.
#'@param hatching_lwd The line width, a positive number. The interpretation is
#' device-specific, and some devices do not implement line widths less than
#' one. Default is 0.5.
#'@param hatching_cross A logical value indicating crosshatching. If TRUE, adds
#' a second set of lines in the opposite angle. Default is FALSE.
#'@param boxlim Limits of a box to be added to the plot, in degrees:
#' c(x1, y1, x2, y2). A list with multiple box specifications can also be
#' provided.
#'@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 around the map plot, with
#' the format c(y1, x1, y2, x2). Defaults to rep(1, 4). If drawleg = TRUE,
#' then margin_scale[1] is subtracted 1 unit.
#'@param title_scale Scale factor for the figure top title. Defaults to 1.
#'@param caption_size Scale factor for the figure caption. Default is 0.8 (1 if
#' vertical = TRUE).
#'@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
#'ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE,
#' dat_dim = c('dat', 'member'), memb_dim = 'member')
#'data <- s2dv::MeanDims(ano$exp, "member")
#'lats <- attr(map_temp$exp, "Variables")$common$lat
#'lons <- attr(map_temp$exp, "Variables")$common$lon
#'
#'VizEquiMap(data[1, 1, 1, 1, , ], lon = lons, lat = lats,
#' toptitle = 'Near-surface temperature anomaly, Nov. 2000',
#' filled.continents = FALSE, title_scale = 0.7,
#' caption = paste0("This is a test caption."))
#'
#'@import graphics maps utils
#'@importFrom grDevices dev.cur dev.new dev.off gray
#'@importFrom stats cor
#'@importFrom s2dv InsertDim
#'@export
VizEquiMap <- function(data, lon, lat, varu = NULL, varv = NULL,
toptitle = NULL, sizetit = NULL, caption = NULL,
units = NULL, brks = NULL, cols = NULL, bar_limits = NULL,
triangle_ends = NULL, col_inf = NULL, col_sup = NULL,
colNA = NULL, color_fun = ClimPalette(),
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,
contours = NULL, brks2 = NULL, contour_lwd = 0.5,
contour_color = 'black', contour_lty = 1,
contour_draw_label = TRUE, contour_label_scale = 1,
dots = NULL, dot_symbol = 4, dot_size = 1,
mask = NULL, mask_color = 'white',
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,
axelab = TRUE, labW = FALSE,
lab_dist_x = NULL, lab_dist_y = NULL, degree_sym = FALSE,
intylat = 20, intxlon = 20,
xlonshft = 0, ylatshft = 0, xlabels = NULL, ylabels = NULL,
axes_tick_scale = 1, axes_label_scale = 1,
drawleg = TRUE, vertical = FALSE, 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),
include_lower_boundary = TRUE,
include_upper_boundary = TRUE, hatching_mask = NULL,
hatching_density = 10, hatching_angle = 45,
hatching_color = "#252525", hatching_lwd = 0.5,
hatching_cross = FALSE,
boxlim = NULL, boxcol = 'purple2', boxlwd = 5,
margin_scale = rep(1, 4), title_scale = 1,
caption_size = 0.8, numbfig = NULL, fileout = NULL,
width = 8, height = 5, size_units = 'in',
res = 100, var = NULL, ...) {
# Process the user graphical parameters that may be passed in the call
## Graphical parameters to exclude
excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "din", "fig", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "oma", "ps", "tck")
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
}
# Check lon, lat
if (!is.numeric(lon) || !is.numeric(lat)) {
stop("Parameters 'lon' and 'lat' must be numeric vectors.")
}
# Check data
if (missing(data) || is.null(data)) {
if (!is.null(var)) {
data <- var
warning("The parameter 'var' is deprecated. Use 'data' instead.")
} else {
stop("Parameter 'data' cannot be NULL.")
}
} else if (!is.null(var)) {
warning("The parameter 'var' is deprecated. 'data' will be used instead.")
}
if (!is.array(data)) {
stop("Parameter 'data' must be a numeric array.")
}
transpose <- FALSE
if (!is.null(names(dim(data)))) {
if (any(names(dim(data)) %in% .KnownLonNames()) &&
any(names(dim(data)) %in% .KnownLatNames())) {
lon_dim <- names(dim(data))[names(dim(data)) %in% .KnownLonNames()]
lat_dim <- names(dim(data))[names(dim(data)) %in% .KnownLatNames()]
} else {
names(dim(data)) <- NULL
lat_dim <- NULL
lon_dim <- NULL
warning("Dimension names of 'data' doesn't correspond to any coordinates names supported by s2dv package.")
}
} else {
lon_dim <- NULL
lat_dim <- NULL
warning("Parameter 'data' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
if (length(dim(data)) > 2) {
if (!is.null(lon_dim) & !is.null(lat_dim)) {
dimnames <- names(dim(data))
dim(data) <- dim(data)[which((dimnames == lon_dim | dimnames == lat_dim | dim(data) != 1))]
} else {
if (all(dim(data) == 1)) {
dim(data) <- c(1, 1)
} else if (length(dim(data)[which(dim(data) > 1)]) == 2) {
data <- drop(data)
} else if (length(dim(data)[which(dim(data) > 1)]) == 1) {
dim(data) <- c(dim(data)[which(dim(data) > 1)], 1)
}
}
}
if (length(dim(data)) != 2) {
stop("Parameter 'data' must be a numeric array with two dimensions.")
}
if ((dim(data)[1] == length(lon) && dim(data)[2] == length(lat)) ||
(dim(data)[2] == length(lon) && dim(data)[1] == length(lat))) {
if (dim(data)[2] == length(lon) && dim(data)[1] == length(lat)) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(data)))) {
warning("Parameter 'data' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(data)[1]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'data'.")
}
if (!is.null(names(dim(data)))) {
if (names(dim(data)[1]) == lon_dim) {
if (transpose) {
stop("Coordinates dimensions of 'data' doesn't correspond to lat or lon.")
}
} else if (names(dim(data)[2]) == lon_dim) {
if (!transpose) {
stop("Coordinates dimensions of 'data' doesn't correspond to lat or lon.")
}
}
}
# Transpose the input matrices because the base plot functions work directly
# with dimensions c(lon, lat).
if (transpose) {
data <- t(data)
}
transpose <- FALSE
names(dim(data)) <- c(lon_dim, lat_dim)
dims <- dim(data)
# 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 (!all(dim(varu) %in% dim(varv)) || !all(names(dim(varv)) %in% names(dim(varu)))) {
stop("Parameter 'varu' and 'varv' must have equal dimensions and dimension names.")
} else if (any(dim(varu) != dim(varv)) || any(names(dim(varv)) != names(dim(varu)))) {
varv <- t(varv)
names(dim(varv)) <- names(dim(varu))
}
if (is.null(lon_dim)) {
names(dim(varu)) <- NULL
names(dim(varv)) <- NULL
} else {
if (!is.null(names(dim(varu)))) {
if (!(lon_dim %in% names(dim(varu)) && lat_dim %in% names(dim(varu)))) {
stop("Parameters 'varu' and 'varv' must have same dimension names as 'data'.")
} else if (dim(varu)[lon_dim] != dim(data)[lon_dim] || dim(varu)[lat_dim] != dim(data)[lat_dim]) {
stop("Parameters 'varu' and 'varv' must have same dimensions as 'data'.")
}
} else {
warning("Parameters 'varu' and 'varv' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
}
if ((dim(varu)[1] == dims[1] && dim(varu)[2] == dims[2]) ||
(dim(varu)[2] == dims[1] && dim(varu)[1] == dims[2])) {
if (dim(varu)[2] == dims[1] && dim(varu)[1] == dims[2]) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(varu)))) {
warning("Parameters 'varu' and 'varv' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(varu)[1]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'varu' and 'varv'.")
}
if (transpose) {
varu <- t(varu)
varv <- t(varv)
}
transpose <- FALSE
}
# Check contours
if (!is.null(contours)) {
if (!is.array(contours) || !(length(dim(contours)) == 2)) {
stop("Parameter 'contours' must be a numerical array with two dimensions.")
}
}
if (!is.null(contours)) {
if (is.null(lon_dim)) {
names(dim(contours)) <- NULL
} else {
if (!is.null(names(dim(contours)))) {
if (!(lon_dim %in% names(dim(contours)) && lat_dim %in% names(dim(contours)))) {
stop("Parameters 'contours' must have same dimension names as 'data'.")
} else if (dim(contours)[lon_dim] != dim(data)[lon_dim] || dim(contours)[lat_dim] != dim(data)[lat_dim]) {
stop("Parameters 'contours' must have same dimensions as 'data'.")
}
} else {
warning("Parameters 'contours' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
}
transpose <- FALSE
if ((dim(contours)[1] == dims[1] && dim(contours)[2] == dims[2]) ||
(dim(contours)[2] == dims[1] && dim(contours)[1] == dims[2])) {
if (dim(contours)[2] == dims[1] && dim(contours)[1] == dims[2]) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(contours)))) {
warning("Parameter 'contours' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(contours)[1]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'contours'.")
}
if (transpose) {
contours <- t(contours)
}
transpose <- FALSE
}
# 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 caption
if (!is.null(caption)) {
if (!is.character(caption)) {
stop("Parameter 'caption' must be a character string.")
} else {
num_lines <- length(strsplit(caption, "\n")[[1]])
}
}
# Check include_lower_boundary and include_upper_boundary
if (!is.null(include_lower_boundary) && (!is.logical(include_lower_boundary) || length(include_lower_boundary) != 1)) {
stop("Parameter 'include_lower_boundary' must be a logical element.")
}
if (!is.null(include_upper_boundary) && (!is.logical(include_upper_boundary) || length(include_upper_boundary) != 1)) {
stop("Parameter 'include_upper_boundary' must be a logical element.")
}
# Check vertical
if (!is.logical(vertical)) {
stop("Parameter 'vertical' must be TRUE or FALSE.")
}
tmp <- .create_var_limits(data = data, brks = brks,
bar_limits = bar_limits, drawleg = drawleg)
var_limits <- tmp$var_limits
drawleg <- tmp$drawleg
# Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks
# draw_separators, triangle_ends_scale, bar_label_scale, units, units_scale,
# bar_label_digits
# Build: brks, cols, bar_limits, col_inf, col_sup
colorbar <- ColorBarContinuous(brks, cols, vertical = vertical, subsampleg, bar_limits,
var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE,
bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks,
draw_separators = draw_separators,
triangle_ends_scale = triangle_ends_scale,
bar_label_scale = bar_label_scale, title = units,
title_scale = units_scale, bar_tick_scale = bar_tick_scale,
bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits)
brks <- colorbar$brks
cols <- colorbar$cols
col_inf <- colorbar$col_inf
col_sup <- colorbar$col_sup
bar_limits <- c(head(brks, 1), tail(brks, 1))
# Adjust 'data' values according to 'include_lower_boundary' and 'include_upper_boundary'.
# This adjustment ensures that, by default, values at the lower limit of the color bars ('brks[1]') are included.
# Refer to issue #15 in the esviz GitLab for more details.
if (include_lower_boundary) {
data[data == head(brks, 1)] <- head(brks, 1) + head(diff(brks), 1)/10
}
if (!include_upper_boundary) {
data[data == tail(brks, 1)] <- tail(brks, 1) + tail(diff(brks), 1)/10
}
# 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 square
if (!is.logical(square)) {
stop("Parameter 'square' must be logical.")
}
# Check filled.continents
if (is.null(filled.continents)) {
if (!square) {
filled.continents <- FALSE
} else {
filled.continents <- TRUE
}
}
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 {
continent_color <- gray(0.5)
}
# Check filled.oceans
if (!.IsColor(filled.oceans) & !is.logical(filled.oceans)) {
stop("Parameter 'filled.oceans' must be logical or a colour identifier.")
} else if (!is.logical(filled.oceans)) {
ocean_color <- filled.oceans
filled.oceans <- TRUE
} else if (filled.oceans) {
ocean_color <- "light blue"
}
# Check country.borders
if (!is.logical(country.borders)) {
stop("Parameter 'country.borders' must be logical.")
}
# 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 lake_color
if (!is.null(lake_color)) {
if (!.IsColor(lake_color)) {
stop("Parameter 'lake_color' must be a valid colour identifier.")
}
}
# Check shapefile
if (!is.null(shapefile)) {
if (is.list(shapefile)) {
shape <- shapefile
if (any(!c('x', 'y') %in% names(shape))) {
stop("The list names of the object in 'shapefile' .rds file should ",
"have at least 'x' and 'y'.")
}
if (length(shape$x) != length(shape$y)) {
stop("The length of x and y in 'shapefile' list should be equal.")
}
} else if (!is.character(shapefile)) {
stop("Parameter 'shapefile' must be a .rds file or a list.")
} else { # .rds file
if (!file.exists(shapefile)) {
stop("Parameter 'shapefile' is not a valid file.")
}
if (!grepl("\\.rds$", shapefile)) {
stop("Parameter 'shapefile' must be a .rds file or a list.")
}
shape <- readRDS(file = shapefile)
if (!is.list(shape)) {
stop("Parameter 'shapefile' should be a .rds file of a list object.")
}
if (any(!c('x', 'y') %in% names(shape))) {
stop("The list names of the object in 'shapefile' .rds file should ",
"have at least 'x' and 'y'.")
}
if (length(shape$x) != length(shape$y)) {
stop("The length of x and y in 'shapefile' list should be equal.")
}
}
}
# Check shapefile_col
if (is.null(shapefile_color)) {
if (filled.continents) {
shapefile_color <- continent_color
} else {
shapefile_color <- 'black'
}
}
if (!.IsColor(shapefile_color)) {
stop("Parameter 'shapefile_color' must be a valid colour identifier.")
}
# Check brks2
if (is.null(brks2)) {
if (is.null(contours)) {
if (!square) {
brks2 <- brks
contours <- data
}
} else {
ll <- signif(min(contours, na.rm = TRUE), 2)
ul <- signif(max(contours, na.rm = TRUE), 2)
brks2 <- signif(seq(ll, ul, length.out = length(brks)), 2)
}
}
# 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_draw_label
if (!is.logical(contour_draw_label)) {
stop("Parameter 'contour_draw_label' must be logical.")
}
# Check contour_label_scale
if (!is.numeric(contour_label_scale)) {
stop("Parameter 'contour_label_scale' must be numeric.")
}
# Check dots
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.null(lon_dim)) {
names(dim(dots)) <- NULL
} else {
if (!is.null(names(dim(dots)))) {
if (!(lon_dim %in% names(dim(dots)) && lat_dim %in% names(dim(dots)))) {
stop("Parameters 'dots' must have same dimension names as 'data'.")
} else if (dim(dots)[lon_dim] != dim(data)[lon_dim] || dim(dots)[lat_dim] != dim(data)[lat_dim]) {
stop("Parameters 'dots' must have same dimensions as 'data'.")
}
} else {
warning("Parameters 'dots' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
}
transpose <- FALSE
if ((dim(dots)[2] == dims[1] && dim(dots)[3] == dims[2]) ||
(dim(dots)[3] == dims[1] && dim(dots)[2] == dims[2])) {
if (dim(dots)[3] == dims[1] && dim(dots)[2] == dims[2]) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(dots)))) {
warning("Parameter 'dots' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(dots)[2]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameter 'dots' must have same number of longitudes and latitudes as 'data'.")
}
if (transpose) {
dots <- aperm(dots, c(1, 3, 2))
}
transpose <- FALSE
}
# Check dot_symbol and dot_size
if (!is.null(dots)) {
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 mask
if (!is.null(mask)) {
mask <- drop(mask)
if (!is.array(mask) || any(!names(dim(mask)) %in% c(lon_dim, lat_dim))) {
stop("Parameter 'mask' must have two dimensions named as the longitude and latitude dimensions in 'data'.")
} else {
if (!identical(names(dim(mask)), names(dim(data)))) {
mask <- aperm(mask, match(names(dim(mask)), names(dim(data))))
}
}
if (!identical(dim(mask), dim(data))) {
stop("Parameter 'mask' must have the same dimensions as 'data'.")
}
if (is.logical(mask)) {
if (!all(mask %in% c(TRUE, FALSE))) {
stop("Parameter 'mask' must contain only TRUE/FALSE or values in the range [0, 1].")
}
mask <- as.numeric(mask)
} else if (is.numeric(mask)) {
if (any(mask < 0 | mask > 1, na.rm = TRUE)) {
stop("Parameter 'mask' must contain only TRUE/FALSE or values in the range [0, 1].")
}
} else {
stop("Parameter 'mask' must be a logical or numerical array.")
}
}
# Check mask_color
if (!is.null(mask_color)) {
if (!.IsColor(mask_color)) {
stop("Parameter 'mask_color' must be a valid colour identifier.")
}
}
# Check hatching_mask
if (!is.null(hatching_mask)) {
hatching_mask <- drop(hatching_mask)
if (!is.array(hatching_mask) || any(!names(dim(hatching_mask)) %in% c(lon_dim, lat_dim))) {
stop("Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'data'.")
}
}
# 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 axis parameters
if (!is.logical(axelab)) {
stop("Parameter 'axelab' must be logical.")
}
if (!is.logical(labW)) {
stop("Parameter 'labW' must be logical.")
}
if (!is.null(lab_dist_x)) {
if (!is.numeric(lab_dist_x)) {
stop("Parameter 'lab_dist_x' must be numeric.")
}
}
if (!is.null(lab_dist_y)) {
if (!is.numeric(lab_dist_y)) {
stop("Parameter 'lab_dist_y' must be numeric.")
}
}
if (!is.numeric(intylat)) {
stop("Parameter 'intylat' must be numeric.")
} else {
intylat <- round(intylat)
}
if (!is.numeric(intxlon)) {
stop("Parameter 'intxlon' must be numeric.")
} else {
intxlon <- round(intxlon)
}
if (!is.numeric(xlonshft) | length(xlonshft) != 1) {
stop("Parameter 'xlonshft' must be a number.")
}
if (!is.numeric(ylatshft) | length(ylatshft) != 1) {
stop("Parameter 'ylatshft' must be a number.")
}
if (!is.null(xlabels)) {
if (!is.character(xlabels) | !is.vector(xlabels)) {
stop("Parameter 'xlabels' must be a vector of character string.")
}
}
if (!is.null(ylabels)) {
if (!is.character(ylabels) | !is.vector(ylabels)) {
stop("Parameter 'ylabels' must be a vector of character string.")
}
}
# Check legend parameters
if (!is.logical(drawleg)) {
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 caption_size
if (!is.numeric(caption_size)) {
stop("Parameter 'caption_size' must be numeric.")
}
if (vertical) {
if (missing(caption_size)) {
caption_size <- 1
}
}
# Check axes_tick_scale
if (!is.numeric(axes_tick_scale)) {
stop("Parameter 'axes_tick_scale' must be numeric.")
}
# Check axes_label_scale
if (!is.numeric(axes_label_scale)) {
stop("Parameter 'axes_label_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
axes_tick_scale <- axes_tick_scale * scale
axes_label_scale <- axes_label_scale * scale
title_scale <- title_scale * scale
margin_scale <- margin_scale * scale
arr_scale <- arr_scale * scale
dot_size <- dot_size * scale
contour_label_scale <- contour_label_scale * scale
contour_lwd <- contour_lwd * scale
}
}
#
# Input arguments
# ~~~~~~~~~~~~~~~~~
#
latb <- sort(lat, index.return = TRUE)
dlon <- diff(lon)
wher <- which(dlon > (mean(dlon) + 1))
if (length(wher) > 0) {
warning("Detect gap in 'lon' vector, which is considered as crossing the border.")
lon[(wher + 1):dims[1]] <- lon[(wher + 1):dims[1]] - 360
}
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
#
# 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)
}
oldpar <- par(c("mar", "cex.main", "cex.axis", "mgp", "las", "lwd", "xpd"))
on.exit(par(oldpar), add = TRUE)
#
# Defining the layout
# ~~~~~~~~~~~~~~~~~~~~~
#
if (drawleg) {
margin_scale[1] <- margin_scale[1] - 1
}
margins <- rep(0.4, 4) * margin_scale
margins[4] <- margins[4] + 1
cex_title <- 2 * title_scale
cex_axes_labels <- 1.3 * axes_label_scale
cex_axes_ticks <- -0.5 * axes_tick_scale
spaceticklab <- 0
if (axelab) {
# Y axis label
if (!is.null(ylabels)) {
ypos <- seq(latmin, latmax, intylat) + ylatshft
if (length(ypos) != length(ylabels)) {
stop(paste0("Parameter 'ylabels' must have the same length as the latitude ",
"vector spaced by 'intylat' (length = ", length(ypos), ")."))
}
ylabs <- ylabels
} else {
ypos <- seq(latmin, latmax, intylat) + ylatshft
letters <- array('', length(ypos))
if (degree_sym == FALSE) {
letters[ypos < 0] <- 'S'
letters[ypos > 0] <- 'N'
} else {
letters[ypos < 0] <- paste(intToUtf8(176), 'S')
letters[ypos > 0] <- paste(intToUtf8(176), 'N')
}
ylabs <- paste(as.character(abs(ypos)), letters, sep = '')
}
# X axis label
if (!is.null(xlabels)) {
xpos <- seq(lonmin, lonmax, intxlon) + xlonshft
if (length(xpos) != length(xlabels)) {
stop(paste0("Parameter 'xlabels' must have the same length as the longitude ",
"vector spaced by 'intxlon' (length = ", length(xpos), ")."))
}
xlabs <- xlabels
} else {
xpos <- seq(lonmin, lonmax, intxlon) + xlonshft
letters <- array('', length(xpos))
if (labW) {
xpos2 <- xpos
xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180]
}
if (degree_sym == FALSE) {
letters[xpos < 0] <- 'W'
letters[xpos > 0] <- 'E'
} else {
letters[xpos < 0] <- paste(intToUtf8(176), 'W')
letters[xpos > 0] <- paste(intToUtf8(176), 'E')
}
if (labW) {
letters[xpos == 0] <- ' '
letters[xpos == 180] <- ' '
if (degree_sym == FALSE) {
letters[xpos > 180] <- 'W'
} else {
letters[xpos > 180] <- paste(intToUtf8(176), 'W')
}
xlabs <- paste(as.character(abs(xpos2)), letters, sep = '')
} else {
xlabs <- paste(as.character(abs(xpos)), letters, sep = '')
}
}
spaceticklab <- max(-cex_axes_ticks, 0)
margins[1] <- margins[1] + 1.2 * cex_axes_labels + spaceticklab
margins[2] <- margins[2] + 1.2 * cex_axes_labels + spaceticklab
}
bar_extra_margin[2] <- bar_extra_margin[2] + margins[2]
bar_extra_margin[4] <- bar_extra_margin[4] + margins[4]
if (toptitle != '') {
margins[3] <- margins[3] + cex_title + 1
}
if (!is.null(varu)) {
margins[1] <- margins[1] + 2.2 * units_scale
}
if (drawleg) {
if (!is.null(caption)) {
margins[2] <- margins[2] + num_lines*0.5
margins[4] <- margins[4] + num_lines*0.5
if (vertical) { # vertical bar, caption
layout(matrix(c(1, 2, 3, 3), ncol = 2, nrow = 2, byrow = TRUE),
widths = c(5, 1.3),
heights = c(5, 0.2 + num_lines*caption_size/6))
} else { # horizontal bar, caption
layout(matrix(c(1, 2, 3), ncol = 1, nrow = 3),
heights = c(5, 1, 0.2 + num_lines*caption_size/4))
}
} else {
if (vertical) { # vertical bar, no caption
layout(matrix(c(1, 2, 1, 3), ncol = 2, nrow = 2, byrow = TRUE),
widths = c(5, 1.3),
heights = c(0.1, 5))
} else { # horizontal bar, no caption
layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5, 1))
}
}
} else {
if (!is.null(caption)) {
margins[2] <- margins[2] + num_lines*0.4
margins[4] <- margins[4] + num_lines*0.4
layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5, 0.1 + num_lines*caption_size/4))
}
}
plot.new()
# Load the user parameters
par(userArgs)
par(mar = margins, cex.main = cex_title, cex.axis = cex_axes_labels,
mgp = c(0, spaceticklab, 0), las = 0)
#NOTE: Here creates the window for later plot. If 'usr' for par() is not specified,
# use the lat/lon as the borders. If 'usr' is specified, use the assigned values.
if (is.null(userArgs$usr)) {
#NOTE: The grids are assumed to be equally spaced
xlim_cal <- c(lonb$x[1] - (lonb$x[2] - lonb$x[1]) / 2,
lonb$x[length(lonb$x)] + (lonb$x[2] - lonb$x[1]) / 2)
ylim_cal <- c(latb$x[1] - (latb$x[2] - latb$x[1]) / 2,
latb$x[length(latb$x)] + (latb$x[2] - latb$x[1]) / 2)
plot.window(xlim = xlim_cal, ylim = ylim_cal, xaxs = 'i', yaxs = 'i')
# Below is Old code. The border grids are only half plotted.
# plot.window(xlim = range(lonb$x, finite = TRUE), ylim = range(latb$x, finite = TRUE),
# xaxs = 'i', yaxs = 'i')
} else {
plot.window(xlim = par("usr")[1:2], ylim = par("usr")[3:4], xaxs = 'i', yaxs = 'i')
}
if (axelab) {
lab_distance_y <- ifelse(is.null(lab_dist_y), spaceticklab + 0.2, lab_dist_y)
lab_distance_x <- ifelse(is.null(lab_dist_x), spaceticklab + cex_axes_labels / 2 - 0.3, lab_dist_x)
axis(2, at = ypos, labels = ylabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks,
mgp = c(0, lab_distance_y, 0))
axis(1, at = xpos, labels = xlabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks,
mgp = c(0, lab_distance_x, 0))
}
title(toptitle, cex.main = cex_title)
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = colNA)
col_inf_image <- ifelse(is.null(col_inf), colNA, col_inf)
col_sup_image <- ifelse(is.null(col_sup), colNA, col_sup)
if (square) {
# If lat and lon are both regular-spaced, "useRaster = TRUE" can avoid
# artifact white lines on the figure. If not, useRaster has to be FALSE (default)
tryCatch({
image(lonb$x, latb$x, data[lonb$ix, latb$ix],
col = c(col_inf_image, cols, col_sup_image),
breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax),
axes = FALSE, xlab = "", ylab = "", add = TRUE, useRaster = TRUE)
}, error = function(x) {
image(lonb$x, latb$x, data[lonb$ix, latb$ix],
col = c(col_inf_image, cols, col_sup_image),
breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax),
axes = FALSE, xlab = "", ylab = "", add = TRUE)
})
} else {
.filled.contour(lonb$x, latb$x, data[lonb$ix, latb$ix],
levels = c(.Machine$double.xmin, brks, .Machine$double.xmax),
col = c(col_inf_image, cols, col_sup_image))
}
if (!is.null(contours)) {
#NOTE: 'labcex' is the absolute size of contour labels. Parameter 'contour_label_scale'
# is provided in PlotEquiMap() but it was not used. Here, 'cex_axes_labels' was used
# and it was calculated from 'axes_label_scale', the size of lat/lon axis label.
# It is changed to use contour_label_scale*par('cex').
contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2,
method = "edge", add = TRUE,
# labcex = cex_axes_labels,
labcex = contour_label_scale * par("cex"),
lwd = contour_lwd, lty = contour_lty,
col = contour_color, drawlabels = contour_draw_label)
}
#
# Adding black dots or symbols
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#
if (!is.null(dots)) {
data_avail <- !is.na(data)
for (counter in 1:(dim(dots)[1])) {
points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE)
points(lon[points[, 1]], lat[points[, 2]],
pch = dot_symbol[counter],
cex = dot_size[counter] * 3 / sqrt(sqrt(length(data))),
lwd = dot_size[counter] * 3 / sqrt(sqrt(length(data))))
}
}
#
# Adding hatching
# ~~~~~~~~~~~~~~~~~
#
if (!is.null(hatching_mask)) {
Hatching(hatching_mask = hatching_mask, lat = lat, lon = lon, data = data,
hatching_density = hatching_density,
hatching_angle = hatching_angle,
hatching_color = hatching_color, hatching_lwd = hatching_lwd,
hatching_cross = hatching_cross)
}
#
# Adding a mask
# ~~~~~~~~~~~~~~~
#
if (!is.null(mask)) {
for (i in 1:length(mask)) {
# Partial/fully masked areas
if (!is.na(mask[i]) && mask[i] < 1) {
# Calculate the longitude and latitude indices
lon_idx <- (i - 1) %% length(lon) + 1
lat_idx <- ceiling(i / length(lon))
# Get the longitude and latitude for this point
lon_current <- lon[lon_idx]
lat_current <- lat[lat_idx]
# Coordinates for the corners of the rectangle (entire grid cell)
lon_min <- ifelse(lon_idx == 1,
lon_current - (lon[2] - lon[1])/2,
(lon[lon_idx] + lon[lon_idx - 1]) / 2)
lon_max <- ifelse(lon_idx == length(lon),
lon_current + (lon[lon_idx] - lon[lon_idx - 1])/2,
(lon[lon_idx + 1] + lon[lon_idx]) / 2)
lat_min <- ifelse(lat_idx == 1,
lat_current - (lat[2] - lat[1])/2,
(lat[lat_idx] + lat[lat_idx - 1]) / 2)
lat_max <- ifelse(lat_idx == length(lat),
lat_current + (lat[lat_idx] - lat[lat_idx - 1])/2,
(lat[lat_idx + 1] + lat[lat_idx]) / 2)
# Draw a rectangle over the masked area
rect(lon_min, lat_min, lon_max, lat_max,
col = adjustcolor(mask_color, alpha.f = 1 - mask[i]), border = NA)
}
}
}
#
# Plotting continents
# ~~~~~~~~~~~~~~~~~~~~~
#
lonb_c <- lonb
lonb_c$x[1] <- lonb_c$x[1] - abs(diff(lonb_c$x)[1])
wrap_vec <- c(lonb_c$x[1], lonb_c$x[1] + 360)
old_lwd <- par('lwd')
par(lwd = coast_width)
# If [0, 360], use GEOmap; if [-180, 180], use maps::map
# UPDATE: Use maps::map for both cases. The difference between GEOmap and
# maps is trivial. The only thing we can see for now is that
# GEOmap has better lakes.
coast <- maps::map(interior = country.borders, wrap = wrap_vec,
fill = filled.continents, add = TRUE, plot = FALSE)
if (filled.continents) {
polygon(coast, col = continent_color, border = coast_color, lwd = coast_width)
} else {
lines(coast, col = coast_color, lwd = coast_width)
}
if (!is.null(lake_color)) {
maps::map('lakes', add = TRUE, wrap = wrap_vec, fill = filled.continents, col = lake_color)
}
par(lwd = old_lwd)
# filled.oceans
if (filled.oceans) {
old_lwd <- par('lwd')
par(lwd = coast_width)
outline <- maps::map(wrap = wrap_vec, fill = T, plot = FALSE) # must be fill = T
xbox <- wrap_vec + c(-2, 2)
ybox <- c(-92, 92)
outline$x <- c(outline$x, NA, c(xbox, rev(xbox), xbox[1]))
outline$y <- c(outline$y, NA, rep(ybox, each = 2), ybox[1])
polypath(outline, col = ocean_color, rule = 'evenodd', border = NA)
par(lwd = old_lwd)
}
# Plot shapefile
#NOTE: the longitude range cannot cut shapefile range, or not all the shapefile will be plotted.
if (!is.null(shapefile)) {
maps::map(shape, interior = country.borders, #wrap = wrap_vec,
fill = filled.continents, add = TRUE, plot = TRUE,
lwd = shapefile_lwd, col = shapefile_color)
}
box()
# Draw rectangle 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 (box[2] < latmin || box[4] > latmax ||
box[1] < lonmin || box[3] > lonmax) {
stop(paste("The limits of the", counter, "st box defined in the parameter 'boxlim' are invalid."))
} else if (box[1] < 0 && box[3] > 0) {
#segments south
segments(box[1], box[2], 0, box[2], col = boxcol[counter], lwd = boxlwd[counter])
segments(0, box[2], box[3], box[2], col = boxcol[counter], lwd = boxlwd[counter])
#segments north
segments(box[1], box[4], 0, box[4], col = boxcol[counter], lwd = boxlwd[counter])
segments(0, box[4], box[3], box[4], col = boxcol[counter], lwd = boxlwd[counter])
#segments west
segments(box[1], box[2], box[1], box[4], col = boxcol[counter],
lwd = boxlwd[counter])
#segments est
segments(box[3], box[2], box[3],box[4], col = boxcol[counter],
lwd = boxlwd[counter])
} else {
rect(box[1], box[2], box[3], box[4], border = boxcol[counter], col = NULL,
lwd = boxlwd[counter], lty = 'solid')
}
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), name = 'lat')
lattab <- InsertDim(latb$x, 1, length(lonb$x), name = 'lon')
varplotu <- varu[lonb$ix, latb$ix]
varplotv <- varv[lonb$ix, latb$ix]
# Select a subsample af the points to an arrow
#for each "subsample" grid point
sublon <- seq(1,length(lon), arr_subsamp)
sublat <- seq(1,length(lat), arr_subsamp)
uaux <- lontab[sublon, sublat] + varplotu[sublon, sublat] * 0.5 * arr_scale
vaux <- lattab[sublon, sublat] + varplotv[sublon, sublat] * 0.5 * arr_scale
lenshaft <- 0.18 * arr_scale * arr_scale_shaft
angleshaft <- 12 * arr_scale_shaft_angle
# Plot Wind
arrows(lontab[sublon, sublat], lattab[sublon, sublat],
uaux, vaux,
angle = angleshaft,
length = lenshaft)
# Plotting an arrow at the bottom of the plot for the legend
posarlon <- lonb$x[1] + (lonmax - lonmin) * 0.1
posarlat <- latmin - ((latmax - latmin) + 1) / par('pin')[2] *
(spaceticklab + 0.2 + cex_axes_labels + 0.6 * units_scale) * par('csi')
arrows(posarlon, posarlat,
posarlon + 0.5 * arr_scale * arr_ref_len, posarlat,
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 = spaceticklab + 0.2 + cex_axes_labels + 1.2 * units_scale, side = 1,
at = posarlon + (0.5 * arr_scale * arr_ref_len) / 2,
cex = units_scale)
#come back to the previous xpd value
par(xpd = xpdsave)
}
#
# Adding a caption
# ~~~~~~~~~~~~~~~~~
#
if (!is.null(caption)) {
if (drawleg) {
if (vertical) {
par(mfg = c(2, 1))
at_value <- par("usr")[1] - (0.38 + (num_lines - 1) * 0.15)
} else {
par(mfg = c(3, 1))
at_value <- NA
}
} else {
par(mfg = c(2, 1))
at_value <- NA
}
base_line <- 1
mtext(caption, side = 1, line = base_line,
at = at_value, # left placement
adj = 0,
cex = caption_size, col = "black")
}
#
# Colorbar
# ~~~~~~~~~~
#
if (drawleg) {
if (vertical) {
if(is.null(caption)) {
par(mfg = c(2, 1))
} else {
par(mfg = c(1, 2))
}
} else {
if (!is.null(caption)) {
par(mfg = c(2, 1))
}
}
ColorBarContinuous(brks, cols, vertical = vertical, subsampleg, bar_limits,
var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup,
bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks,
draw_separators = draw_separators, title = units,
title_scale = units_scale, triangle_ends_scale = triangle_ends_scale,
bar_label_scale = bar_label_scale, bar_tick_scale = bar_tick_scale,
bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits)
}
# If the graphic was saved to file, close the connection with the device
if (!is.null(fileout)) dev.off()
invisible(list(brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup))
}
Try the esviz package in your browser
Any scripts or data that you put into this service are public.
esviz documentation built on Feb. 4, 2026, 5:13 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions VizEquiMap
Documented in VizEquiMap
#'Maps A Two-Dimensional Variable On A Cylindrical Equidistant Projection
#'
#'Map longitude-latitude array (on a regular rectangular or gaussian grid)
#'on a cylindrical equidistant latitude and longitude projection with coloured
#'grid cells. Only the region for which data has been provided is displayed.
#'A colour bar (legend) can be plotted and adjusted. It is possible to draw
#'superimposed arrows, dots, symbols, contour lines and boxes. A number of
#'options is provided to adjust the position, size and colour of the
#'components. Some parameters are provided to add and adjust the masks that
#'include continents, oceans, and lakes. This plot function is compatible with
#'figure layouts if colour bar is disabled.
#'
#'@param data Array with the values at each cell of a grid on a regular
#' rectangular or gaussian grid. The array is expected to have two
#' dimensions: c(latitude, longitude). Longitudes can be in ascending or
#' descending order and latitudes in any order. It can contain NA values
#' (coloured with 'colNA'). Arrays with dimensions c(longitude, latitude)
#' will also be accepted but 'lon' and 'lat' will be used to disambiguate so
#' this alternative is not appropriate for square arrays. It is allowed that
#' the positions of the longitudinal and latitudinal coordinate dimensions
#' are interchanged.
#'@param var Deprecated. Use 'data' instead.
#'@param lon Numeric vector of longitude locations of the cell centers of the
#' grid of 'data', in ascending or descending order (same as 'data'). Expected
#' to be regularly spaced, within either of the ranges [-180, 180] or
#' [0, 360]. Data for two adjacent regions split by the limits of the
#' longitude range can also be provided, e.g. \code{lon = c(0:50, 300:360)}
#' ('data' must be provided consitently).
#'@param lat Numeric vector of latitude locations of the cell centers of the
#' grid of 'data', in any order (same as 'data'). Expected to be from a regular
#' rectangular or gaussian grid, within the range [-90, 90].
#'@param varu Array of the zonal component of wind/current/other field with
#' the same dimensions as 'data'. It is allowed that the positions of the
#' longitudinal and latitudinal coordinate dimensions are interchanged.
#'@param varv Array of the meridional component of wind/current/other field
#' with the same dimensions as 'data'. It is allowed that the positions of the
#' longitudinal and latitudinal coordinate dimensions are interchanged.
#'@param toptitle Top title of the figure, scalable with parameter
#' 'title_scale'.
#'@param sizetit Scale factor for the figure top title provided in parameter
#' 'toptitle'. Deprecated. Use 'title_scale' instead.
#'@param caption A character string of the caption located at the left-bottom of
#' the plot. Captions with multiple lines can be constructed using string
#' manipulation functions like \code{paste()} or \code{paste0()}, using
#' \code{"\n"} to indicate line breaks.
#'@param units Title at the top of the colour bar, most commonly the units of
#' the variable provided in parameter 'data'.
#'@param brks,cols,bar_limits,triangle_ends Usually only providing 'brks' is
#' enough to generate the desired colour bar. These parameters allow to
#' define n breaks that define n - 1 intervals to classify each of the values
#' in 'data'. The corresponding grid cell of a given value in 'data' will be
#' coloured in function of the interval it belongs to. These parameters are
#' sent to \code{ColorBar()} to generate the breaks and colours. Additional
#' colours for values beyond the limits of the colour bar are also generated
#' and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are
#' properly provided to do so. See ?ColorBar for a full explanation.
#'@param col_inf,col_sup,colNA Colour identifiers to colour the values in
#' 'data' that go beyond the extremes of the colour bar and to colour NA
#' values, respectively. 'colNA' takes attr(cols, 'na_color') if available by
#' default, where cols is the parameter 'cols' if provided or the vector of
#' colors returned by 'color_fun'. If not available, it takes 'pink' by
#' default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not
#' specified. See ?ColorBar for a full explanation on 'col_inf' and 'col_sup'.
#'@param color_fun,subsampleg,bar_extra_labels,draw_bar_ticks Set of
#' parameters to control the visual aspect of the drawn colour bar
#' (1/3). See ?ColorBar for a full explanation.
#'@param draw_separators,triangle_ends_scale,bar_label_digits Set of
#' parameters to control the visual aspect of the drawn colour bar
#' (2/3). See ?ColorBar for a full explanation.
#'@param bar_label_scale,units_scale,bar_tick_scale,bar_extra_margin Set of
#' parameters to control the visual aspect of the drawn colour bar (3/3).
#' See ?ColorBar for a full explanation.
#'@param square Logical value to choose either to draw a coloured square for
#' each grid cell in 'data' (TRUE; default) or to draw contour lines and fill
#' the spaces in between with colours (FALSE). In the latter case,
#' 'filled.continents' will take the value FALSE if not specified.
#'@param filled.continents Colour to fill in drawn projected continents.
#' 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".
#'@param country.borders A logical value indicating if the country borders
#' should be plotted (TRUE) or not (FALSE). It only works when
#' 'filled.continents' is FALSE. The default value is FALSE.
#'@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 lake_color Colour of the lake or other water body inside continents.
#' The default value is NULL.
#'@param shapefile A character string of the path to a .rds file or a list
#' object containinig shape file data. If it is a .rds file, it should contain
#' a list. The list should contains 'x' and 'y' at least, which indicate the
#' location of the shape. The default value is NULL.
#'@param shapefile_color Line color of the shapefile.
#'@param shapefile_lwd Line width of the shapefile. The default value is 1.
#'@param contours Array of same dimensions as 'data' to be added to the plot
#' and displayed with contours. Parameter 'brks2' is required to define the
#' magnitude breaks for each contour curve. Disregarded if 'square = FALSE'.
#' It is allowed that the positions of the longitudinal and latitudinal
#' coordinate dimensions are interchanged.
#'@param brks2 Vector of magnitude breaks where to draw contour curves for the
#' array provided in 'contours' or if 'square = FALSE'.
#'@param contour_lwd Line width of the contour curves provided via 'contours'
#' and 'brks2', or if 'square = FALSE'.
#'@param contour_color Line color of the contour curves provided via 'contours'
#' and 'brks2', or if 'square = FALSE'.
#'@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_draw_label A logical value indicating whether to draw the
#' contour labels or not. The default value is TRUE.
#'@param contour_label_scale Scale factor for the superimposed labels when
#' drawing contour levels.
#'@param dots Array of same dimensions as 'data' or with dimensions
#' c(n, dim(data)), where n is the number of dot/symbol layers to add to the
#' plot. A value of TRUE at a grid cell will draw a dot/symbol on the
#' corresponding square of the plot. By default all layers provided in 'dots'
#' are plotted with dots, but a symbol can be specified for each of the
#' layers via the parameter 'dot_symbol'. It is allowed that the positions of
#' the longitudinal and latitudinal coordinate dimensions are interchanged.
#'@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 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
#' layers in 'dots'. Takes 1 by default.
#'@param mask An array with the same dimensions as 'data' with values in the
#' range of [0, 1] or logical, indicating the opacity of the mask over each
#' grid point. Cells with a 0 or FALSE will result in a totally opaque
#' superimposed pixel coloured in 'mask_color', whereas cells with a 1 or TRUE
#' will have no mask and remain totally visible. If the array is numeric, values
#' between 0 and 1 will have shades of transparency.
#'@param mask_color Color of the mask. The default value is 'white'.
#'@param arr_subsamp 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. Takes 1 by default.
#'@param arr_scale Scale factor for drawn arrows from 'varu' and 'varv'.
#' Takes 1 by default.
#'@param arr_ref_len 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). Defaults to 15.
#'@param arr_units Units of 'varu' and 'varv', to be drawn in the legend.
#' Takes 'm/s' by default.
#'@param arr_scale_shaft Parameter for the scale of the shaft of the arrows
#' (which also depend on the number of figures and the arr_scale parameter).
#' Defaults to 1.
#'@param arr_scale_shaft_angle Parameter 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). Defaults to 1.
#'@param axelab Whether to draw longitude and latitude axes or not.
#' TRUE by default.
#'@param labW Whether to label the longitude axis with a 'W' instead of minus
#' for negative values. Defaults to FALSE.
#'@param lab_dist_x A numeric of the distance of the longitude labels to the
#' box borders. The default value is NULL and is automatically adjusted by
#' the function.
#'@param lab_dist_y A numeric of the distance of the latitude labels to the
#' box borders. The default value is NULL and is automatically adjusted by
#' the function.
#'@param degree_sym A logical indicating whether to include degree symbol
#' (30° N) or not (30N; default).
#'@param intylat Interval between latitude ticks on y-axis, in degrees.
#' Defaults to 20.
#'@param intxlon Interval between latitude ticks on x-axis, in degrees.
#' Defaults to 20.
#'@param xlonshft A numeric of the degrees to shift the latitude ticks. The
#' default value is 0.
#'@param ylatshft A numeric of the degrees to shift the longitude ticks. The
#' default value is 0.
#'@param xlabels A vector of character string of the custumized x-axis labels.
#' The values should correspond to each tick, which is decided by the longitude
#' and parameter 'intxlon'. The default value is NULL and the labels will be
#' automatically generated.
#'@param ylabels A vector of character string of the custumized y-axis labels.
#' The values should correspond to each tick, which is decided by the latitude
#' and parameter 'intylat'. The default value is NULL and the labels will be
#' automatically generated.
#'@param axes_tick_scale Scale factor for the tick lines along the longitude
#' and latitude axes.
#'@param axes_label_scale Scale factor for the labels along the longitude
#' and latitude axes.
#'@param drawleg Whether to plot a color bar (legend, key) or not. Defaults to
#' TRUE. It is not possible to plot the colour bar if 'add = TRUE'. Use
#' ColorBar() and the return values of PlotEquiMap() instead.
#'@param vertical TRUE/FALSE for vertical/horizontal colour bar. Default is
#' FALSE. Parameters 'width' and 'height' might need to be modified to
#' accommodate the vertical colour bar.
#'@param include_lower_boundary Logical value indicating whether to include
#' the minimum value of the field. Takes TRUE by default.
#'@param include_upper_boundary Logical value indicating whether to include
#' the maximum value of the field. Takes TRUE by default.
#'@param hatching_mask Logical or binary (0/1) array with two named dimensions:
#' c(latitude, longitude). Hatching is applied to grid cells where
#' 'hatching_mask' is TRUE (or 1). Arrays with dimensions c(longitude, latitude)
#' are also accepted, but the resulting hatching may appear transposed. To
#' ensure correct alignment with the map, provide 'data'. The function will
#' compare the dimension order of 'hatching_mask' and 'data', and automatically
#' transpose 'hatching_mask' if the latitude and longitude dimensions appear to
#' be reversed.
#'@param hatching_density The density of shading lines, in lines per inch. A
#' zero value of density means no shading nor filling, whereas negative values
#' and NA suppress shading (and so allow color filling). NULL means that no
#' shading lines are drawn. Default is 10.
#'@param hatching_angle The slope of shading lines, given as an angle in degrees
#' (counter-clockwise). Default is 45.
#'@param hatching_color Color of the hatching lines. Default is
#' \code{"#252525"}.
#'@param hatching_lwd The line width, a positive number. The interpretation is
#' device-specific, and some devices do not implement line widths less than
#' one. Default is 0.5.
#'@param hatching_cross A logical value indicating crosshatching. If TRUE, adds
#' a second set of lines in the opposite angle. Default is FALSE.
#'@param boxlim Limits of a box to be added to the plot, in degrees:
#' c(x1, y1, x2, y2). A list with multiple box specifications can also be
#' provided.
#'@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 around the map plot, with
#' the format c(y1, x1, y2, x2). Defaults to rep(1, 4). If drawleg = TRUE,
#' then margin_scale[1] is subtracted 1 unit.
#'@param title_scale Scale factor for the figure top title. Defaults to 1.
#'@param caption_size Scale factor for the figure caption. Default is 0.8 (1 if
#' vertical = TRUE).
#'@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
#'ano <- s2dv::Ano_CrossValid(map_temp$exp, map_temp$obs, memb = FALSE,
#' dat_dim = c('dat', 'member'), memb_dim = 'member')
#'data <- s2dv::MeanDims(ano$exp, "member")
#'lats <- attr(map_temp$exp, "Variables")$common$lat
#'lons <- attr(map_temp$exp, "Variables")$common$lon
#'
#'VizEquiMap(data[1, 1, 1, 1, , ], lon = lons, lat = lats,
#' toptitle = 'Near-surface temperature anomaly, Nov. 2000',
#' filled.continents = FALSE, title_scale = 0.7,
#' caption = paste0("This is a test caption."))
#'
#'@import graphics maps utils
#'@importFrom grDevices dev.cur dev.new dev.off gray
#'@importFrom stats cor
#'@importFrom s2dv InsertDim
#'@export
VizEquiMap <- function(data, lon, lat, varu = NULL, varv = NULL,
toptitle = NULL, sizetit = NULL, caption = NULL,
units = NULL, brks = NULL, cols = NULL, bar_limits = NULL,
triangle_ends = NULL, col_inf = NULL, col_sup = NULL,
colNA = NULL, color_fun = ClimPalette(),
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,
contours = NULL, brks2 = NULL, contour_lwd = 0.5,
contour_color = 'black', contour_lty = 1,
contour_draw_label = TRUE, contour_label_scale = 1,
dots = NULL, dot_symbol = 4, dot_size = 1,
mask = NULL, mask_color = 'white',
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,
axelab = TRUE, labW = FALSE,
lab_dist_x = NULL, lab_dist_y = NULL, degree_sym = FALSE,
intylat = 20, intxlon = 20,
xlonshft = 0, ylatshft = 0, xlabels = NULL, ylabels = NULL,
axes_tick_scale = 1, axes_label_scale = 1,
drawleg = TRUE, vertical = FALSE, 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),
include_lower_boundary = TRUE,
include_upper_boundary = TRUE, hatching_mask = NULL,
hatching_density = 10, hatching_angle = 45,
hatching_color = "#252525", hatching_lwd = 0.5,
hatching_cross = FALSE,
boxlim = NULL, boxcol = 'purple2', boxlwd = 5,
margin_scale = rep(1, 4), title_scale = 1,
caption_size = 0.8, numbfig = NULL, fileout = NULL,
width = 8, height = 5, size_units = 'in',
res = 100, var = NULL, ...) {
# Process the user graphical parameters that may be passed in the call
## Graphical parameters to exclude
excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "din", "fig", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "oma", "ps", "tck")
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
}
# Check lon, lat
if (!is.numeric(lon) || !is.numeric(lat)) {
stop("Parameters 'lon' and 'lat' must be numeric vectors.")
}
# Check data
if (missing(data) || is.null(data)) {
if (!is.null(var)) {
data <- var
warning("The parameter 'var' is deprecated. Use 'data' instead.")
} else {
stop("Parameter 'data' cannot be NULL.")
}
} else if (!is.null(var)) {
warning("The parameter 'var' is deprecated. 'data' will be used instead.")
}
if (!is.array(data)) {
stop("Parameter 'data' must be a numeric array.")
}
transpose <- FALSE
if (!is.null(names(dim(data)))) {
if (any(names(dim(data)) %in% .KnownLonNames()) &&
any(names(dim(data)) %in% .KnownLatNames())) {
lon_dim <- names(dim(data))[names(dim(data)) %in% .KnownLonNames()]
lat_dim <- names(dim(data))[names(dim(data)) %in% .KnownLatNames()]
} else {
names(dim(data)) <- NULL
lat_dim <- NULL
lon_dim <- NULL
warning("Dimension names of 'data' doesn't correspond to any coordinates names supported by s2dv package.")
}
} else {
lon_dim <- NULL
lat_dim <- NULL
warning("Parameter 'data' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
if (length(dim(data)) > 2) {
if (!is.null(lon_dim) & !is.null(lat_dim)) {
dimnames <- names(dim(data))
dim(data) <- dim(data)[which((dimnames == lon_dim | dimnames == lat_dim | dim(data) != 1))]
} else {
if (all(dim(data) == 1)) {
dim(data) <- c(1, 1)
} else if (length(dim(data)[which(dim(data) > 1)]) == 2) {
data <- drop(data)
} else if (length(dim(data)[which(dim(data) > 1)]) == 1) {
dim(data) <- c(dim(data)[which(dim(data) > 1)], 1)
}
}
}
if (length(dim(data)) != 2) {
stop("Parameter 'data' must be a numeric array with two dimensions.")
}
if ((dim(data)[1] == length(lon) && dim(data)[2] == length(lat)) ||
(dim(data)[2] == length(lon) && dim(data)[1] == length(lat))) {
if (dim(data)[2] == length(lon) && dim(data)[1] == length(lat)) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(data)))) {
warning("Parameter 'data' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(data)[1]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'data'.")
}
if (!is.null(names(dim(data)))) {
if (names(dim(data)[1]) == lon_dim) {
if (transpose) {
stop("Coordinates dimensions of 'data' doesn't correspond to lat or lon.")
}
} else if (names(dim(data)[2]) == lon_dim) {
if (!transpose) {
stop("Coordinates dimensions of 'data' doesn't correspond to lat or lon.")
}
}
}
# Transpose the input matrices because the base plot functions work directly
# with dimensions c(lon, lat).
if (transpose) {
data <- t(data)
}
transpose <- FALSE
names(dim(data)) <- c(lon_dim, lat_dim)
dims <- dim(data)
# 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 (!all(dim(varu) %in% dim(varv)) || !all(names(dim(varv)) %in% names(dim(varu)))) {
stop("Parameter 'varu' and 'varv' must have equal dimensions and dimension names.")
} else if (any(dim(varu) != dim(varv)) || any(names(dim(varv)) != names(dim(varu)))) {
varv <- t(varv)
names(dim(varv)) <- names(dim(varu))
}
if (is.null(lon_dim)) {
names(dim(varu)) <- NULL
names(dim(varv)) <- NULL
} else {
if (!is.null(names(dim(varu)))) {
if (!(lon_dim %in% names(dim(varu)) && lat_dim %in% names(dim(varu)))) {
stop("Parameters 'varu' and 'varv' must have same dimension names as 'data'.")
} else if (dim(varu)[lon_dim] != dim(data)[lon_dim] || dim(varu)[lat_dim] != dim(data)[lat_dim]) {
stop("Parameters 'varu' and 'varv' must have same dimensions as 'data'.")
}
} else {
warning("Parameters 'varu' and 'varv' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
}
if ((dim(varu)[1] == dims[1] && dim(varu)[2] == dims[2]) ||
(dim(varu)[2] == dims[1] && dim(varu)[1] == dims[2])) {
if (dim(varu)[2] == dims[1] && dim(varu)[1] == dims[2]) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(varu)))) {
warning("Parameters 'varu' and 'varv' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(varu)[1]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'varu' and 'varv'.")
}
if (transpose) {
varu <- t(varu)
varv <- t(varv)
}
transpose <- FALSE
}
# Check contours
if (!is.null(contours)) {
if (!is.array(contours) || !(length(dim(contours)) == 2)) {
stop("Parameter 'contours' must be a numerical array with two dimensions.")
}
}
if (!is.null(contours)) {
if (is.null(lon_dim)) {
names(dim(contours)) <- NULL
} else {
if (!is.null(names(dim(contours)))) {
if (!(lon_dim %in% names(dim(contours)) && lat_dim %in% names(dim(contours)))) {
stop("Parameters 'contours' must have same dimension names as 'data'.")
} else if (dim(contours)[lon_dim] != dim(data)[lon_dim] || dim(contours)[lat_dim] != dim(data)[lat_dim]) {
stop("Parameters 'contours' must have same dimensions as 'data'.")
}
} else {
warning("Parameters 'contours' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
}
transpose <- FALSE
if ((dim(contours)[1] == dims[1] && dim(contours)[2] == dims[2]) ||
(dim(contours)[2] == dims[1] && dim(contours)[1] == dims[2])) {
if (dim(contours)[2] == dims[1] && dim(contours)[1] == dims[2]) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(contours)))) {
warning("Parameter 'contours' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(contours)[1]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameters 'lon' and 'lat' must have as many elements as the number of cells along longitudes and latitudes in the input array 'contours'.")
}
if (transpose) {
contours <- t(contours)
}
transpose <- FALSE
}
# 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 caption
if (!is.null(caption)) {
if (!is.character(caption)) {
stop("Parameter 'caption' must be a character string.")
} else {
num_lines <- length(strsplit(caption, "\n")[[1]])
}
}
# Check include_lower_boundary and include_upper_boundary
if (!is.null(include_lower_boundary) && (!is.logical(include_lower_boundary) || length(include_lower_boundary) != 1)) {
stop("Parameter 'include_lower_boundary' must be a logical element.")
}
if (!is.null(include_upper_boundary) && (!is.logical(include_upper_boundary) || length(include_upper_boundary) != 1)) {
stop("Parameter 'include_upper_boundary' must be a logical element.")
}
# Check vertical
if (!is.logical(vertical)) {
stop("Parameter 'vertical' must be TRUE or FALSE.")
}
tmp <- .create_var_limits(data = data, brks = brks,
bar_limits = bar_limits, drawleg = drawleg)
var_limits <- tmp$var_limits
drawleg <- tmp$drawleg
# Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks
# draw_separators, triangle_ends_scale, bar_label_scale, units, units_scale,
# bar_label_digits
# Build: brks, cols, bar_limits, col_inf, col_sup
colorbar <- ColorBarContinuous(brks, cols, vertical = vertical, subsampleg, bar_limits,
var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE,
bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks,
draw_separators = draw_separators,
triangle_ends_scale = triangle_ends_scale,
bar_label_scale = bar_label_scale, title = units,
title_scale = units_scale, bar_tick_scale = bar_tick_scale,
bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits)
brks <- colorbar$brks
cols <- colorbar$cols
col_inf <- colorbar$col_inf
col_sup <- colorbar$col_sup
bar_limits <- c(head(brks, 1), tail(brks, 1))
# Adjust 'data' values according to 'include_lower_boundary' and 'include_upper_boundary'.
# This adjustment ensures that, by default, values at the lower limit of the color bars ('brks[1]') are included.
# Refer to issue #15 in the esviz GitLab for more details.
if (include_lower_boundary) {
data[data == head(brks, 1)] <- head(brks, 1) + head(diff(brks), 1)/10
}
if (!include_upper_boundary) {
data[data == tail(brks, 1)] <- tail(brks, 1) + tail(diff(brks), 1)/10
}
# 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 square
if (!is.logical(square)) {
stop("Parameter 'square' must be logical.")
}
# Check filled.continents
if (is.null(filled.continents)) {
if (!square) {
filled.continents <- FALSE
} else {
filled.continents <- TRUE
}
}
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 {
continent_color <- gray(0.5)
}
# Check filled.oceans
if (!.IsColor(filled.oceans) & !is.logical(filled.oceans)) {
stop("Parameter 'filled.oceans' must be logical or a colour identifier.")
} else if (!is.logical(filled.oceans)) {
ocean_color <- filled.oceans
filled.oceans <- TRUE
} else if (filled.oceans) {
ocean_color <- "light blue"
}
# Check country.borders
if (!is.logical(country.borders)) {
stop("Parameter 'country.borders' must be logical.")
}
# 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 lake_color
if (!is.null(lake_color)) {
if (!.IsColor(lake_color)) {
stop("Parameter 'lake_color' must be a valid colour identifier.")
}
}
# Check shapefile
if (!is.null(shapefile)) {
if (is.list(shapefile)) {
shape <- shapefile
if (any(!c('x', 'y') %in% names(shape))) {
stop("The list names of the object in 'shapefile' .rds file should ",
"have at least 'x' and 'y'.")
}
if (length(shape$x) != length(shape$y)) {
stop("The length of x and y in 'shapefile' list should be equal.")
}
} else if (!is.character(shapefile)) {
stop("Parameter 'shapefile' must be a .rds file or a list.")
} else { # .rds file
if (!file.exists(shapefile)) {
stop("Parameter 'shapefile' is not a valid file.")
}
if (!grepl("\\.rds$", shapefile)) {
stop("Parameter 'shapefile' must be a .rds file or a list.")
}
shape <- readRDS(file = shapefile)
if (!is.list(shape)) {
stop("Parameter 'shapefile' should be a .rds file of a list object.")
}
if (any(!c('x', 'y') %in% names(shape))) {
stop("The list names of the object in 'shapefile' .rds file should ",
"have at least 'x' and 'y'.")
}
if (length(shape$x) != length(shape$y)) {
stop("The length of x and y in 'shapefile' list should be equal.")
}
}
}
# Check shapefile_col
if (is.null(shapefile_color)) {
if (filled.continents) {
shapefile_color <- continent_color
} else {
shapefile_color <- 'black'
}
}
if (!.IsColor(shapefile_color)) {
stop("Parameter 'shapefile_color' must be a valid colour identifier.")
}
# Check brks2
if (is.null(brks2)) {
if (is.null(contours)) {
if (!square) {
brks2 <- brks
contours <- data
}
} else {
ll <- signif(min(contours, na.rm = TRUE), 2)
ul <- signif(max(contours, na.rm = TRUE), 2)
brks2 <- signif(seq(ll, ul, length.out = length(brks)), 2)
}
}
# 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_draw_label
if (!is.logical(contour_draw_label)) {
stop("Parameter 'contour_draw_label' must be logical.")
}
# Check contour_label_scale
if (!is.numeric(contour_label_scale)) {
stop("Parameter 'contour_label_scale' must be numeric.")
}
# Check dots
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.null(lon_dim)) {
names(dim(dots)) <- NULL
} else {
if (!is.null(names(dim(dots)))) {
if (!(lon_dim %in% names(dim(dots)) && lat_dim %in% names(dim(dots)))) {
stop("Parameters 'dots' must have same dimension names as 'data'.")
} else if (dim(dots)[lon_dim] != dim(data)[lon_dim] || dim(dots)[lat_dim] != dim(data)[lat_dim]) {
stop("Parameters 'dots' must have same dimensions as 'data'.")
}
} else {
warning("Parameters 'dots' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the corresponding coordinates dimensions.")
}
}
transpose <- FALSE
if ((dim(dots)[2] == dims[1] && dim(dots)[3] == dims[2]) ||
(dim(dots)[3] == dims[1] && dim(dots)[2] == dims[2])) {
if (dim(dots)[3] == dims[1] && dim(dots)[2] == dims[2]) {
if (length(lon) == length(lat)) {
if (is.null(names(dim(dots)))) {
warning("Parameter 'dots' should have dimension names. Coordinates 'lon' and 'lat' have been assigned into the first and second dimensions.")
} else {
if (names(dim(dots)[2]) == lat_dim) {
transpose <- TRUE
}
}
} else {
transpose <- TRUE
}
}
} else {
stop("Parameter 'dots' must have same number of longitudes and latitudes as 'data'.")
}
if (transpose) {
dots <- aperm(dots, c(1, 3, 2))
}
transpose <- FALSE
}
# Check dot_symbol and dot_size
if (!is.null(dots)) {
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 mask
if (!is.null(mask)) {
mask <- drop(mask)
if (!is.array(mask) || any(!names(dim(mask)) %in% c(lon_dim, lat_dim))) {
stop("Parameter 'mask' must have two dimensions named as the longitude and latitude dimensions in 'data'.")
} else {
if (!identical(names(dim(mask)), names(dim(data)))) {
mask <- aperm(mask, match(names(dim(mask)), names(dim(data))))
}
}
if (!identical(dim(mask), dim(data))) {
stop("Parameter 'mask' must have the same dimensions as 'data'.")
}
if (is.logical(mask)) {
if (!all(mask %in% c(TRUE, FALSE))) {
stop("Parameter 'mask' must contain only TRUE/FALSE or values in the range [0, 1].")
}
mask <- as.numeric(mask)
} else if (is.numeric(mask)) {
if (any(mask < 0 | mask > 1, na.rm = TRUE)) {
stop("Parameter 'mask' must contain only TRUE/FALSE or values in the range [0, 1].")
}
} else {
stop("Parameter 'mask' must be a logical or numerical array.")
}
}
# Check mask_color
if (!is.null(mask_color)) {
if (!.IsColor(mask_color)) {
stop("Parameter 'mask_color' must be a valid colour identifier.")
}
}
# Check hatching_mask
if (!is.null(hatching_mask)) {
hatching_mask <- drop(hatching_mask)
if (!is.array(hatching_mask) || any(!names(dim(hatching_mask)) %in% c(lon_dim, lat_dim))) {
stop("Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'data'.")
}
}
# 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 axis parameters
if (!is.logical(axelab)) {
stop("Parameter 'axelab' must be logical.")
}
if (!is.logical(labW)) {
stop("Parameter 'labW' must be logical.")
}
if (!is.null(lab_dist_x)) {
if (!is.numeric(lab_dist_x)) {
stop("Parameter 'lab_dist_x' must be numeric.")
}
}
if (!is.null(lab_dist_y)) {
if (!is.numeric(lab_dist_y)) {
stop("Parameter 'lab_dist_y' must be numeric.")
}
}
if (!is.numeric(intylat)) {
stop("Parameter 'intylat' must be numeric.")
} else {
intylat <- round(intylat)
}
if (!is.numeric(intxlon)) {
stop("Parameter 'intxlon' must be numeric.")
} else {
intxlon <- round(intxlon)
}
if (!is.numeric(xlonshft) | length(xlonshft) != 1) {
stop("Parameter 'xlonshft' must be a number.")
}
if (!is.numeric(ylatshft) | length(ylatshft) != 1) {
stop("Parameter 'ylatshft' must be a number.")
}
if (!is.null(xlabels)) {
if (!is.character(xlabels) | !is.vector(xlabels)) {
stop("Parameter 'xlabels' must be a vector of character string.")
}
}
if (!is.null(ylabels)) {
if (!is.character(ylabels) | !is.vector(ylabels)) {
stop("Parameter 'ylabels' must be a vector of character string.")
}
}
# Check legend parameters
if (!is.logical(drawleg)) {
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 caption_size
if (!is.numeric(caption_size)) {
stop("Parameter 'caption_size' must be numeric.")
}
if (vertical) {
if (missing(caption_size)) {
caption_size <- 1
}
}
# Check axes_tick_scale
if (!is.numeric(axes_tick_scale)) {
stop("Parameter 'axes_tick_scale' must be numeric.")
}
# Check axes_label_scale
if (!is.numeric(axes_label_scale)) {
stop("Parameter 'axes_label_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
axes_tick_scale <- axes_tick_scale * scale
axes_label_scale <- axes_label_scale * scale
title_scale <- title_scale * scale
margin_scale <- margin_scale * scale
arr_scale <- arr_scale * scale
dot_size <- dot_size * scale
contour_label_scale <- contour_label_scale * scale
contour_lwd <- contour_lwd * scale
}
}
#
# Input arguments
# ~~~~~~~~~~~~~~~~~
#
latb <- sort(lat, index.return = TRUE)
dlon <- diff(lon)
wher <- which(dlon > (mean(dlon) + 1))
if (length(wher) > 0) {
warning("Detect gap in 'lon' vector, which is considered as crossing the border.")
lon[(wher + 1):dims[1]] <- lon[(wher + 1):dims[1]] - 360
}
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
#
# 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)
}
oldpar <- par(c("mar", "cex.main", "cex.axis", "mgp", "las", "lwd", "xpd"))
on.exit(par(oldpar), add = TRUE)
#
# Defining the layout
# ~~~~~~~~~~~~~~~~~~~~~
#
if (drawleg) {
margin_scale[1] <- margin_scale[1] - 1
}
margins <- rep(0.4, 4) * margin_scale
margins[4] <- margins[4] + 1
cex_title <- 2 * title_scale
cex_axes_labels <- 1.3 * axes_label_scale
cex_axes_ticks <- -0.5 * axes_tick_scale
spaceticklab <- 0
if (axelab) {
# Y axis label
if (!is.null(ylabels)) {
ypos <- seq(latmin, latmax, intylat) + ylatshft
if (length(ypos) != length(ylabels)) {
stop(paste0("Parameter 'ylabels' must have the same length as the latitude ",
"vector spaced by 'intylat' (length = ", length(ypos), ")."))
}
ylabs <- ylabels
} else {
ypos <- seq(latmin, latmax, intylat) + ylatshft
letters <- array('', length(ypos))
if (degree_sym == FALSE) {
letters[ypos < 0] <- 'S'
letters[ypos > 0] <- 'N'
} else {
letters[ypos < 0] <- paste(intToUtf8(176), 'S')
letters[ypos > 0] <- paste(intToUtf8(176), 'N')
}
ylabs <- paste(as.character(abs(ypos)), letters, sep = '')
}
# X axis label
if (!is.null(xlabels)) {
xpos <- seq(lonmin, lonmax, intxlon) + xlonshft
if (length(xpos) != length(xlabels)) {
stop(paste0("Parameter 'xlabels' must have the same length as the longitude ",
"vector spaced by 'intxlon' (length = ", length(xpos), ")."))
}
xlabs <- xlabels
} else {
xpos <- seq(lonmin, lonmax, intxlon) + xlonshft
letters <- array('', length(xpos))
if (labW) {
xpos2 <- xpos
xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180]
}
if (degree_sym == FALSE) {
letters[xpos < 0] <- 'W'
letters[xpos > 0] <- 'E'
} else {
letters[xpos < 0] <- paste(intToUtf8(176), 'W')
letters[xpos > 0] <- paste(intToUtf8(176), 'E')
}
if (labW) {
letters[xpos == 0] <- ' '
letters[xpos == 180] <- ' '
if (degree_sym == FALSE) {
letters[xpos > 180] <- 'W'
} else {
letters[xpos > 180] <- paste(intToUtf8(176), 'W')
}
xlabs <- paste(as.character(abs(xpos2)), letters, sep = '')
} else {
xlabs <- paste(as.character(abs(xpos)), letters, sep = '')
}
}
spaceticklab <- max(-cex_axes_ticks, 0)
margins[1] <- margins[1] + 1.2 * cex_axes_labels + spaceticklab
margins[2] <- margins[2] + 1.2 * cex_axes_labels + spaceticklab
}
bar_extra_margin[2] <- bar_extra_margin[2] + margins[2]
bar_extra_margin[4] <- bar_extra_margin[4] + margins[4]
if (toptitle != '') {
margins[3] <- margins[3] + cex_title + 1
}
if (!is.null(varu)) {
margins[1] <- margins[1] + 2.2 * units_scale
}
if (drawleg) {
if (!is.null(caption)) {
margins[2] <- margins[2] + num_lines*0.5
margins[4] <- margins[4] + num_lines*0.5
if (vertical) { # vertical bar, caption
layout(matrix(c(1, 2, 3, 3), ncol = 2, nrow = 2, byrow = TRUE),
widths = c(5, 1.3),
heights = c(5, 0.2 + num_lines*caption_size/6))
} else { # horizontal bar, caption
layout(matrix(c(1, 2, 3), ncol = 1, nrow = 3),
heights = c(5, 1, 0.2 + num_lines*caption_size/4))
}
} else {
if (vertical) { # vertical bar, no caption
layout(matrix(c(1, 2, 1, 3), ncol = 2, nrow = 2, byrow = TRUE),
widths = c(5, 1.3),
heights = c(0.1, 5))
} else { # horizontal bar, no caption
layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5, 1))
}
}
} else {
if (!is.null(caption)) {
margins[2] <- margins[2] + num_lines*0.4
margins[4] <- margins[4] + num_lines*0.4
layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5, 0.1 + num_lines*caption_size/4))
}
}
plot.new()
# Load the user parameters
par(userArgs)
par(mar = margins, cex.main = cex_title, cex.axis = cex_axes_labels,
mgp = c(0, spaceticklab, 0), las = 0)
#NOTE: Here creates the window for later plot. If 'usr' for par() is not specified,
# use the lat/lon as the borders. If 'usr' is specified, use the assigned values.
if (is.null(userArgs$usr)) {
#NOTE: The grids are assumed to be equally spaced
xlim_cal <- c(lonb$x[1] - (lonb$x[2] - lonb$x[1]) / 2,
lonb$x[length(lonb$x)] + (lonb$x[2] - lonb$x[1]) / 2)
ylim_cal <- c(latb$x[1] - (latb$x[2] - latb$x[1]) / 2,
latb$x[length(latb$x)] + (latb$x[2] - latb$x[1]) / 2)
plot.window(xlim = xlim_cal, ylim = ylim_cal, xaxs = 'i', yaxs = 'i')
# Below is Old code. The border grids are only half plotted.
# plot.window(xlim = range(lonb$x, finite = TRUE), ylim = range(latb$x, finite = TRUE),
# xaxs = 'i', yaxs = 'i')
} else {
plot.window(xlim = par("usr")[1:2], ylim = par("usr")[3:4], xaxs = 'i', yaxs = 'i')
}
if (axelab) {
lab_distance_y <- ifelse(is.null(lab_dist_y), spaceticklab + 0.2, lab_dist_y)
lab_distance_x <- ifelse(is.null(lab_dist_x), spaceticklab + cex_axes_labels / 2 - 0.3, lab_dist_x)
axis(2, at = ypos, labels = ylabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks,
mgp = c(0, lab_distance_y, 0))
axis(1, at = xpos, labels = xlabs, cex.axis = cex_axes_labels, tcl = cex_axes_ticks,
mgp = c(0, lab_distance_x, 0))
}
title(toptitle, cex.main = cex_title)
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = colNA)
col_inf_image <- ifelse(is.null(col_inf), colNA, col_inf)
col_sup_image <- ifelse(is.null(col_sup), colNA, col_sup)
if (square) {
# If lat and lon are both regular-spaced, "useRaster = TRUE" can avoid
# artifact white lines on the figure. If not, useRaster has to be FALSE (default)
tryCatch({
image(lonb$x, latb$x, data[lonb$ix, latb$ix],
col = c(col_inf_image, cols, col_sup_image),
breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax),
axes = FALSE, xlab = "", ylab = "", add = TRUE, useRaster = TRUE)
}, error = function(x) {
image(lonb$x, latb$x, data[lonb$ix, latb$ix],
col = c(col_inf_image, cols, col_sup_image),
breaks = c(-.Machine$double.xmax, brks, .Machine$double.xmax),
axes = FALSE, xlab = "", ylab = "", add = TRUE)
})
} else {
.filled.contour(lonb$x, latb$x, data[lonb$ix, latb$ix],
levels = c(.Machine$double.xmin, brks, .Machine$double.xmax),
col = c(col_inf_image, cols, col_sup_image))
}
if (!is.null(contours)) {
#NOTE: 'labcex' is the absolute size of contour labels. Parameter 'contour_label_scale'
# is provided in PlotEquiMap() but it was not used. Here, 'cex_axes_labels' was used
# and it was calculated from 'axes_label_scale', the size of lat/lon axis label.
# It is changed to use contour_label_scale*par('cex').
contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2,
method = "edge", add = TRUE,
# labcex = cex_axes_labels,
labcex = contour_label_scale * par("cex"),
lwd = contour_lwd, lty = contour_lty,
col = contour_color, drawlabels = contour_draw_label)
}
#
# Adding black dots or symbols
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#
if (!is.null(dots)) {
data_avail <- !is.na(data)
for (counter in 1:(dim(dots)[1])) {
points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE)
points(lon[points[, 1]], lat[points[, 2]],
pch = dot_symbol[counter],
cex = dot_size[counter] * 3 / sqrt(sqrt(length(data))),
lwd = dot_size[counter] * 3 / sqrt(sqrt(length(data))))
}
}
#
# Adding hatching
# ~~~~~~~~~~~~~~~~~
#
if (!is.null(hatching_mask)) {
Hatching(hatching_mask = hatching_mask, lat = lat, lon = lon, data = data,
hatching_density = hatching_density,
hatching_angle = hatching_angle,
hatching_color = hatching_color, hatching_lwd = hatching_lwd,
hatching_cross = hatching_cross)
}
#
# Adding a mask
# ~~~~~~~~~~~~~~~
#
if (!is.null(mask)) {
for (i in 1:length(mask)) {
# Partial/fully masked areas
if (!is.na(mask[i]) && mask[i] < 1) {
# Calculate the longitude and latitude indices
lon_idx <- (i - 1) %% length(lon) + 1
lat_idx <- ceiling(i / length(lon))
# Get the longitude and latitude for this point
lon_current <- lon[lon_idx]
lat_current <- lat[lat_idx]
# Coordinates for the corners of the rectangle (entire grid cell)
lon_min <- ifelse(lon_idx == 1,
lon_current - (lon[2] - lon[1])/2,
(lon[lon_idx] + lon[lon_idx - 1]) / 2)
lon_max <- ifelse(lon_idx == length(lon),
lon_current + (lon[lon_idx] - lon[lon_idx - 1])/2,
(lon[lon_idx + 1] + lon[lon_idx]) / 2)
lat_min <- ifelse(lat_idx == 1,
lat_current - (lat[2] - lat[1])/2,
(lat[lat_idx] + lat[lat_idx - 1]) / 2)
lat_max <- ifelse(lat_idx == length(lat),
lat_current + (lat[lat_idx] - lat[lat_idx - 1])/2,
(lat[lat_idx + 1] + lat[lat_idx]) / 2)
# Draw a rectangle over the masked area
rect(lon_min, lat_min, lon_max, lat_max,
col = adjustcolor(mask_color, alpha.f = 1 - mask[i]), border = NA)
}
}
}
#
# Plotting continents
# ~~~~~~~~~~~~~~~~~~~~~
#
lonb_c <- lonb
lonb_c$x[1] <- lonb_c$x[1] - abs(diff(lonb_c$x)[1])
wrap_vec <- c(lonb_c$x[1], lonb_c$x[1] + 360)
old_lwd <- par('lwd')
par(lwd = coast_width)
# If [0, 360], use GEOmap; if [-180, 180], use maps::map
# UPDATE: Use maps::map for both cases. The difference between GEOmap and
# maps is trivial. The only thing we can see for now is that
# GEOmap has better lakes.
coast <- maps::map(interior = country.borders, wrap = wrap_vec,
fill = filled.continents, add = TRUE, plot = FALSE)
if (filled.continents) {
polygon(coast, col = continent_color, border = coast_color, lwd = coast_width)
} else {
lines(coast, col = coast_color, lwd = coast_width)
}
if (!is.null(lake_color)) {
maps::map('lakes', add = TRUE, wrap = wrap_vec, fill = filled.continents, col = lake_color)
}
par(lwd = old_lwd)
# filled.oceans
if (filled.oceans) {
old_lwd <- par('lwd')
par(lwd = coast_width)
outline <- maps::map(wrap = wrap_vec, fill = T, plot = FALSE) # must be fill = T
xbox <- wrap_vec + c(-2, 2)
ybox <- c(-92, 92)
outline$x <- c(outline$x, NA, c(xbox, rev(xbox), xbox[1]))
outline$y <- c(outline$y, NA, rep(ybox, each = 2), ybox[1])
polypath(outline, col = ocean_color, rule = 'evenodd', border = NA)
par(lwd = old_lwd)
}
# Plot shapefile
#NOTE: the longitude range cannot cut shapefile range, or not all the shapefile will be plotted.
if (!is.null(shapefile)) {
maps::map(shape, interior = country.borders, #wrap = wrap_vec,
fill = filled.continents, add = TRUE, plot = TRUE,
lwd = shapefile_lwd, col = shapefile_color)
}
box()
# Draw rectangle 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 (box[2] < latmin || box[4] > latmax ||
box[1] < lonmin || box[3] > lonmax) {
stop(paste("The limits of the", counter, "st box defined in the parameter 'boxlim' are invalid."))
} else if (box[1] < 0 && box[3] > 0) {
#segments south
segments(box[1], box[2], 0, box[2], col = boxcol[counter], lwd = boxlwd[counter])
segments(0, box[2], box[3], box[2], col = boxcol[counter], lwd = boxlwd[counter])
#segments north
segments(box[1], box[4], 0, box[4], col = boxcol[counter], lwd = boxlwd[counter])
segments(0, box[4], box[3], box[4], col = boxcol[counter], lwd = boxlwd[counter])
#segments west
segments(box[1], box[2], box[1], box[4], col = boxcol[counter],
lwd = boxlwd[counter])
#segments est
segments(box[3], box[2], box[3],box[4], col = boxcol[counter],
lwd = boxlwd[counter])
} else {
rect(box[1], box[2], box[3], box[4], border = boxcol[counter], col = NULL,
lwd = boxlwd[counter], lty = 'solid')
}
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), name = 'lat')
lattab <- InsertDim(latb$x, 1, length(lonb$x), name = 'lon')
varplotu <- varu[lonb$ix, latb$ix]
varplotv <- varv[lonb$ix, latb$ix]
# Select a subsample af the points to an arrow
#for each "subsample" grid point
sublon <- seq(1,length(lon), arr_subsamp)
sublat <- seq(1,length(lat), arr_subsamp)
uaux <- lontab[sublon, sublat] + varplotu[sublon, sublat] * 0.5 * arr_scale
vaux <- lattab[sublon, sublat] + varplotv[sublon, sublat] * 0.5 * arr_scale
lenshaft <- 0.18 * arr_scale * arr_scale_shaft
angleshaft <- 12 * arr_scale_shaft_angle
# Plot Wind
arrows(lontab[sublon, sublat], lattab[sublon, sublat],
uaux, vaux,
angle = angleshaft,
length = lenshaft)
# Plotting an arrow at the bottom of the plot for the legend
posarlon <- lonb$x[1] + (lonmax - lonmin) * 0.1
posarlat <- latmin - ((latmax - latmin) + 1) / par('pin')[2] *
(spaceticklab + 0.2 + cex_axes_labels + 0.6 * units_scale) * par('csi')
arrows(posarlon, posarlat,
posarlon + 0.5 * arr_scale * arr_ref_len, posarlat,
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 = spaceticklab + 0.2 + cex_axes_labels + 1.2 * units_scale, side = 1,
at = posarlon + (0.5 * arr_scale * arr_ref_len) / 2,
cex = units_scale)
#come back to the previous xpd value
par(xpd = xpdsave)
}
#
# Adding a caption
# ~~~~~~~~~~~~~~~~~
#
if (!is.null(caption)) {
if (drawleg) {
if (vertical) {
par(mfg = c(2, 1))
at_value <- par("usr")[1] - (0.38 + (num_lines - 1) * 0.15)
} else {
par(mfg = c(3, 1))
at_value <- NA
}
} else {
par(mfg = c(2, 1))
at_value <- NA
}
base_line <- 1
mtext(caption, side = 1, line = base_line,
at = at_value, # left placement
adj = 0,
cex = caption_size, col = "black")
}
#
# Colorbar
# ~~~~~~~~~~
#
if (drawleg) {
if (vertical) {
if(is.null(caption)) {
par(mfg = c(2, 1))
} else {
par(mfg = c(1, 2))
}
} else {
if (!is.null(caption)) {
par(mfg = c(2, 1))
}
}
ColorBarContinuous(brks, cols, vertical = vertical, subsampleg, bar_limits,
var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup,
bar_extra_labels = bar_extra_labels, draw_bar_ticks = draw_bar_ticks,
draw_separators = draw_separators, title = units,
title_scale = units_scale, triangle_ends_scale = triangle_ends_scale,
bar_label_scale = bar_label_scale, bar_tick_scale = bar_tick_scale,
bar_extra_margin = bar_extra_margin, bar_label_digits = bar_label_digits)
}
# If the graphic was saved to file, close the connection with the device
if (!is.null(fileout)) dev.off()
invisible(list(brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup))
}
Try the esviz package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.