Commit 4c2716d3 authored by aho's avatar aho
Browse files

Merge branch 'develop_PlotStereoMap_contour' into 'master'

Develop PlotStereoMap contour

See merge request !62
parents fbf597f6 12ba4c4d
Pipeline #5549 passed with stage
in 5 minutes and 51 seconds
......@@ -732,9 +732,15 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL,
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, lwd = contour_lwd, lty = contour_lty,
method = "edge", add = TRUE,
# labcex = cex_axes_labels,
labcex = contour_label_scale * par("cex"),
lwd = contour_lwd, lty = contour_lty,
col = contour_color)
}
......
......@@ -58,6 +58,24 @@
#' continents. Takes the value gray(0.5) by default.
#'@param coast_width Line width of the coast line of the drawn projected
#' continents. Takes the value 1 by default.
#'@param contours Array of same dimensions as 'var' to be added to the plot
#' and displayed with contours. Parameter 'brks2' is required to define the
#' magnitude breaks for each contour curve.
#'@param brks2 A numeric value or vector of magnitude breaks where to draw
#' contour curves for the array provided in 'contours'. If it is a number, it
#' represents the number of breaks (n) that defines (n - 1) intervals to
#' classify 'contours'.
#'@param contour_lwd Line width of the contour curves provided via 'contours'
#' and 'brks2'. The default value is 0.5.
#'@param contour_color Line color of the contour curves provided via 'contours'
#' and 'brks2'.
#'@param contour_lty Line type of the contour curves. Takes 1 (solid) by
#' default. See help on 'lty' in par() for other accepted values.
#'@param contour_label_draw A logical value indicating whether to draw the
#' contour labels (TRUE) or not (FALSE) when 'contours' is used. The default
#' value is TRUE.
#'@param contour_label_scale Scale factor for the superimposed labels when
#' drawing contour levels. The default value is 0.6.
#'@param dots Array of same dimensions as 'var' or with dimensions
#' c(n, dim(var)), where n is the number of dot/symbol layers to add to the
#' plot. A value of TRUE at a grid cell will draw a dot/symbol on the
......@@ -144,6 +162,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_draw = TRUE, contour_label_scale = 0.6,
dots = NULL, dot_symbol = 4, dot_size = 0.8,
intlat = 10,
drawleg = TRUE, subsampleg = NULL,
......@@ -309,6 +330,69 @@ 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(contours)) {
if (is.null(brks2)) {
ll <- signif(min(contours, na.rm = TRUE), 2)
ul <- signif(max(contours, na.rm = TRUE), 2)
brks2 <- unique(signif(seq(ll, ul, length.out = length(brks)), 2))
} else if (is.numeric(brks2) & length(brks2) == 1) {
ll <- signif(min(contours, na.rm = TRUE), 2)
ul <- signif(max(contours, na.rm = TRUE), 2)
brks2 <- unique(signif(seq(ll, ul, length.out = brks2), 2))
} else if (!is.numeric(brks2)) {
stop("Parameter 'brks2' must be a numeric value or vector.")
}
}
# Check contour_lwd
if (!is.numeric(contour_lwd)) {
stop("Parameter 'contour_lwd' must be numeric.")
}
# Check contour_color
if (!.IsColor(contour_color)) {
stop("Parameter 'contour_color' must be a valid colour identifier.")
}
# Check contour_lty
if (!is.numeric(contour_lty) && !is.character(contour_lty)) {
stop("Parameter 'contour_lty' must be either a number or a character string.")
}
# Check contour_label_draw
if (!is.logical(contour_label_draw)) {
stop("Parameter 'contour_label_draw' must be a logical value.")
}
# Check contour_label_scale
if (!is.numeric(contour_label_scale)) {
stop("Parameter 'contour_label_scale' must be numeric.")
}
# Check dots, dot_symbol and dot_size
if (!is.null(dots)) {
......@@ -482,6 +566,66 @@ 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 = contour_lwd, lty = contour_lty)
# draw label
if (contour_label_draw) {
label_char <- as.character(signif(brks2[n_brks2], 2))
## Check if the label has enough space to draw first.
last_slope <- Inf
put_label <- FALSE
for (p1 in 1:nc) {
p2 <- p1
while (p2 < nc) {
dist <- sqrt((yc[p2] - yc[p1])^2 + (xc[p2] - xc[p1])^2)
if (!is.infinite(dist) &
dist > 1.2 * strwidth(label_char, cex = contour_label_scale)) {
put_label <- TRUE
slope <- (yc[p2] - yc[p1]) / (xc[p2] - xc[p1])
# flatter is better
if (abs(slope) < abs(last_slope)) {
last_slope <- slope
last_p1 <- p1
last_p2 <- p2
}
break # Found a proper space for label. Move to the next p1.
}
p2 <- p2 + 1 # If the dist is not enough, try next p2.
}
}
## If label can be put
if (put_label) {
# Label should be at the middle of p1 and p2
p_label <- (last_p1 + last_p2) / 2
# string rotation angle is calculated from the slope
srt_label <- atan(last_slope) * 57.2958 # radian to degree
#NOTE: 'cex' in text() is the scale factor. The actual size will be
# contour_label_scale * par("cex")
text(xc[p_label], yc[p_label], label_char,
cex = contour_label_scale, col = contour_color, srt = srt_label)
}
}
}
}
}
}
# Draw the dots
if (!is.null(dots)) {
numbfig <- 1 # for compatibility with PlotEquiMap code
......
......@@ -23,6 +23,13 @@ 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_draw = TRUE,
contour_label_scale = 0.6,
dots = NULL,
dot_symbol = 4,
dot_size = 0.8,
......@@ -116,6 +123,31 @@ continents. Takes the value gray(0.5) by default.}
\item{coast_width}{Line width of the coast line of the drawn projected
continents. Takes the value 1 by default.}
\item{contours}{Array of same dimensions as 'var' to be added to the plot
and displayed with contours. Parameter 'brks2' is required to define the
magnitude breaks for each contour curve.}
\item{brks2}{A numeric value or vector of magnitude breaks where to draw
contour curves for the array provided in 'contours'. If it is a number, it
represents the number of breaks (n) that defines (n - 1) intervals to
classify 'contours'.}
\item{contour_lwd}{Line width of the contour curves provided via 'contours'
and 'brks2'. The default value is 0.5.}
\item{contour_color}{Line color of the contour curves provided via 'contours'
and 'brks2'.}
\item{contour_lty}{Line type of the contour curves. Takes 1 (solid) by
default. See help on 'lty' in par() for other accepted values.}
\item{contour_label_draw}{A logical value indicating whether to draw the
contour labels (TRUE) or not (FALSE) when 'contours' is used. The default
value is TRUE.}
\item{contour_label_scale}{Scale factor for the superimposed labels when
drawing contour levels. The default value is 0.6.}
\item{dots}{Array of same dimensions as 'var' or with dimensions
c(n, dim(var)), where n is the number of dot/symbol layers to add to the
plot. A value of TRUE at a grid cell will draw a dot/symbol on the
......
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