Commit 3c830c38 authored by aho's avatar aho
Browse files

Add contour function.

parent fe00469e
Pipeline #5507 passed with stage
in 6 minutes and 24 seconds
......@@ -58,6 +58,19 @@
#' continents. Takes the value gray(0.5) by default.
#'@param coast_width Line width of the coast line of the drawn projected
#' continents. Takes the value 1 by default.
#'@param contours Array of same dimensions as 'var' to be added to the plot
#' and displayed with contours. Parameter 'brks2' is required to define the
#' magnitude breaks for each contour curve.
#'@param brks2 Vector of magnitude breaks where to draw contour curves for the
#' array provided in 'contours'.
#'@param contour_lwd Line width of the contour curves provided via 'contours'
#' and 'brks2'.
#'@param contour_color Line color of the contour curves provided via 'contours'
#' and 'brks2'.
#'@param contour_lty Line type of the contour curves. Takes 1 (solid) by
#' default. See help on 'lty' in par() for other accepted values.
#'@param contour_label_scale Scale factor for the superimposed labels when
#' drawing contour levels. The default value is 0.6.
#'@param dots Array of same dimensions as 'var' or with dimensions
#' c(n, dim(var)), where n is the number of dot/symbol layers to add to the
#' plot. A value of TRUE at a grid cell will draw a dot/symbol on the
......@@ -144,6 +157,9 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
colNA = NULL, color_fun = clim.palette(),
filled.continents = FALSE, coast_color = NULL,
coast_width = 1,
contours = NULL, brks2 = NULL, contour_lwd = 0.5,
contour_color = 'black', contour_lty = 1,
contour_label_scale = 0.6,
dots = NULL, dot_symbol = 4, dot_size = 0.8,
intlat = 10,
drawleg = TRUE, subsampleg = NULL,
......@@ -309,6 +325,57 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
if (!is.numeric(coast_width)) {
stop("Parameter 'coast_width' must be numeric.")
}
# Check contours
if (!is.null(contours)) {
if (!is.array(contours)) {
stop("Parameter 'contours' must be a numeric array.")
}
if (length(dim(contours)) > 2) {
contours <- drop(contours)
dim(contours) <- head(c(dim(contours), 1, 1), 2)
}
if (length(dim(contours)) > 2) {
stop("Parameter 'contours' must be a numeric array with two dimensions.")
} else if (length(dim(contours)) < 2) {
stop("Parameter 'contours' must be a numeric array with two dimensions.")
}
# Transpose the input matrices because the base plot functions work directly
# with dimensions c(lon, lat).
if (dim(contours)[1] == dims[2] & dim(contours)[2] == dims[1]) {
contours <- t(contours)
} else {
stop("Parameter 'contours' must have the same number of longitudes and latitudes as 'var'.")
}
}
# Check brks2
if (is.null(brks2)) {
if (!is.null(contours)) {
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_label_scale
if (!is.numeric(contour_label_scale)) {
stop("Parameter 'contour_label_scale' must be numeric.")
}
# Check dots, dot_symbol and dot_size
if (!is.null(dots)) {
......@@ -482,6 +549,30 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
}
}
}
# contours
if (!is.null(contours)) {
nbrks2 <- length(brks2)
for (n_brks2 in 1:nbrks2) {
cl <- grDevices::contourLines(x = lon, y = lat[which(lat >= latlims[1] & lat <= latlims[2])],
z = contours[, which(lat >= latlims[1] & lat <= latlims[2])],
levels = brks2[n_brks2])
if (length(cl) > 0) {
for (i in seq_along(cl)) {
xy <- mapproj::mapproject(cl[[i]]$x, cl[[i]]$y)
xc <- xy$x
yc <- xy$y
nc <- length(xc)
lines(xc, yc, col = contour_color) #, lwd=lwd[n_brks2], lty=lty[n_brks2])
# draw label
text(xc[1], yc[1], as.character(round(brks2[n_brks2], 2)), cex = contour_label_scale)
# text(xc[labelj], yc[labelj], label, col=col[n_brks2], srt=angle*180/pi, cex=labcex[n_brks2])
}
}
}
}
# Draw the dots
if (!is.null(dots)) {
numbfig <- 1 # for compatibility with PlotEquiMap code
......
......@@ -23,6 +23,12 @@ PlotStereoMap(
filled.continents = FALSE,
coast_color = NULL,
coast_width = 1,
contours = NULL,
brks2 = NULL,
contour_lwd = 0.5,
contour_color = "black",
contour_lty = 1,
contour_label_scale = 0.6,
dots = NULL,
dot_symbol = 4,
dot_size = 0.8,
......@@ -116,6 +122,25 @@ continents. Takes the value gray(0.5) by default.}
\item{coast_width}{Line width of the coast line of the drawn projected
continents. Takes the value 1 by default.}
\item{contours}{Array of same dimensions as 'var' to be added to the plot
and displayed with contours. Parameter 'brks2' is required to define the
magnitude breaks for each contour curve.}
\item{brks2}{Vector of magnitude breaks where to draw contour curves for the
array provided in 'contours'.}
\item{contour_lwd}{Line width of the contour curves provided via 'contours'
and 'brks2'.}
\item{contour_color}{Line color of the contour curves provided via 'contours'
and 'brks2'.}
\item{contour_lty}{Line type of the contour curves. Takes 1 (solid) by
default. See help on 'lty' in par() for other accepted values.}
\item{contour_label_scale}{Scale factor for the superimposed labels when
drawing contour levels. The default value is 0.6.}
\item{dots}{Array of same dimensions as 'var' or with dimensions
c(n, dim(var)), where n is the number of dot/symbol layers to add to the
plot. A value of TRUE at a grid cell will draw a dot/symbol on the
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment