Commit 12ba4c4d authored by aho's avatar aho
Browse files

Refine labels of contour lines

parent 3d1ad03a
Pipeline #5533 passed with stage
in 6 minutes and 18 seconds
......@@ -61,14 +61,19 @@
#'@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 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'.
#'@param contour_color Line color 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
......@@ -159,7 +164,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
coast_width = 1,
contours = NULL, brks2 = NULL, contour_lwd = 0.5,
contour_color = 'black', contour_lty = 1,
contour_label_scale = 0.6,
contour_label_draw = TRUE, contour_label_scale = 0.6,
dots = NULL, dot_symbol = 4, dot_size = 0.8,
intlat = 10,
drawleg = TRUE, subsampleg = NULL,
......@@ -349,11 +354,18 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
}
# Check brks2
if (is.null(brks2)) {
if (!is.null(contours)) {
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 <- signif(seq(ll, ul, length.out = length(brks)), 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.")
}
}
......@@ -372,6 +384,11 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
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.")
......@@ -554,7 +571,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
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])],
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) {
......@@ -563,11 +580,47 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90),
xc <- xy$x
yc <- xy$y
nc <- length(xc)
lines(xc, yc, col = contour_color) #, lwd=lwd[n_brks2], lty=lty[n_brks2])
lines(xc, yc, col = contour_color, lwd = contour_lwd, lty = contour_lty)
# 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])
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)
}
}
}
}
}
......
......@@ -28,6 +28,7 @@ PlotStereoMap(
contour_lwd = 0.5,
contour_color = "black",
contour_lty = 1,
contour_label_draw = TRUE,
contour_label_scale = 0.6,
dots = NULL,
dot_symbol = 4,
......@@ -126,18 +127,24 @@ continents. Takes the value 1 by default.}
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{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'.}
and 'brks2'. The default value is 0.5.}
\item{contour_color}{Line color of the contour curves provided via 'contours'
\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.}
......
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