diff --git a/R/Hatching.R b/R/Hatching.R new file mode 100644 index 0000000000000000000000000000000000000000..0a0b82e159c635ecccbc46740394eb8d2567b2bf --- /dev/null +++ b/R/Hatching.R @@ -0,0 +1,172 @@ +#' Draws hatching or crosshatching over a mask on a map +#' +#' Adds hatching or crosshatching lines over grid cells of a map based on a +#' logical mask. The hatching is applied only to grid cells where the mask is +#' TRUE (or 1). A number of graphical options are available to customize the +#' appearance of the hatching, such as line density, angle, line width, and +#' color. Optionally, crosshatching can be drawn using a second set of lines in +#' the opposite direction. +#' The function assumes that the input mask is a 2D array with dimensions +#' corresponding to latitude (rows) and longitude (columns), and it is designed +#' to be used as a layer over existing map plots (e.g., within a call to +#' \code{VizEquiMap}) and does not initiate a plot by itself. +#' +#'@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 lat Numeric vector of latitude locations of the cell centers of the +#' grid. +#'@param lon Numeric vector of longitude locations of the cell centers of the +#' grid. +#'@param data Array of the data that the hatching will be drawn over. The array +#' should have named latidude and longitude dimensions. If the dimension order +#' is reversed relative to 'hatching_mask', the mask is automatically +#' transposed. Default is NULL. +#'@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. +#'@examples +#' \dontrun{ +#'hatching_mask <- array(c(TRUE, FALSE, TRUE, FALSE), dim = c(lat = 2, lon = 2)) +#'lats <- 1:2 +#'lons <- 1:2 +#'image(lon_small, lat_small, matrix(1:4, nrow = 2)) +#'Hatching(hatching_mask = mask_small, lat = lat_small, lon = lon_small, +#' hatching_lwd = 2) +#' } +#'@export + +Hatching <- function(hatching_mask, lat, lon, data = NULL, + hatching_density = 10, hatching_angle = 45, + hatching_color = '#252525', hatching_lwd = 0.5, + hatching_cross = FALSE) { + + if (length(dim(hatching_mask)) != 2 || is.null(names(dim(hatching_mask)))) { + stop("The 'hatching_mask' array should have two named latitude and longitude dimensions") + } + if (!(any(names(dim(hatching_mask)) %in% .KnownLonNames()) && + any(names(dim(hatching_mask)) %in% .KnownLatNames()))) { + stop("Dimension names of 'hatching_mask' don't correspond to any + coordinates names supported by the esviz package.") + } + lon_dim <- names(dim(hatching_mask))[names(dim(hatching_mask)) %in% .KnownLonNames()] + lat_dim <- names(dim(hatching_mask))[names(dim(hatching_mask)) %in% .KnownLatNames()] + if (dim(hatching_mask)[[lat_dim]] != length(lat) | dim(hatching_mask)[[lon_dim]] != length(lon)) { + stop("The dimensions of the hatching 'hatching_mask' do not match the lengths of 'lat' and 'lon'.") + } + + # If 'hatching_mask' dimensions are reversed respect 'data', reorder them + if (!is.null(data)) { + if (!is.null(names(dim(data)))) { + if (!identical(names(dim(hatching_mask)), names(dim(data)))) { + hatching_mask <- aperm(hatching_mask, match(names(dim(data)), names(dim(hatching_mask)))) + } + } + } + + # Convert numeric values to logical values in hatching_mask + if (is.numeric(hatching_mask)) { + if (all(hatching_mask %in% c(0, 1))) { + hatching_mask <- hatching_mask == 1 + } else { + stop("The 'hatching_mask' array must have only TRUE/FALSE or 0/1.") + } + } else if (!is.logical(hatching_mask)) { + stop("The 'hatching_mask' array must have only TRUE/FALSE or 0/1.") + } + + # Check lon, lat + if (!is.numeric(lon) || !is.numeric(lat)) { + stop("Parameters 'lon' and 'lat' must be numeric vectors.") + } + + # Check data + if (!is.null(data)) { + if (!is.array(data)) { + stop("Parameter 'data' must be a numeric array.") + } + } + + # Check hatching_density + if (!is.null(hatching_density)) { + if (!is.numeric(hatching_density) || length(hatching_density) != 1) { + stop("Parameter 'hatching_density' must be a single numeric value.") + } + } + + # Check hatching_angle + if (!is.null(hatching_angle)) { + if (!is.numeric(hatching_angle) || length(hatching_angle) != 1) { + stop("Parameter 'hatching_angle' must be a single numeric value.") + } + } + + # Check hatching_color + if (!is.null(hatching_color)) { + if (!.IsColor(hatching_color)) { + stop("Parameter 'hatching_color' must be a valid colour identifier.") + } + } + + # Check hatching_lwd + if (!is.null(hatching_lwd)) { + if (!is.numeric(hatching_lwd) || length(hatching_lwd) != 1 || hatching_lwd <= 0) { + stop("Parameter 'hatching_lwd' must be a single positive numeric value.") + } + } + + # Check hatching_cross + if (!is.null(hatching_cross)) { + if (!is.logical(hatching_cross) || length(hatching_cross) != 1) { + stop("Parameter 'hatching_cross' must be a single logical value (TRUE or FALSE).") + } + } + + # Helper function to calculate cell edges (breaks between lat/lon points) + get_edges <- function(vec) { + mid <- diff(vec) / 2 + edges <- c(vec[1] - mid[1], vec[-length(vec)] + mid, vec[length(vec)] + mid[length(mid)]) + return(edges) + } + # Find lon and lat edges + x_edges <- get_edges(lon) + y_edges <- get_edges(lat) + # Loop through hatching_mask + for (i in seq_len(nrow(hatching_mask))) { + for (j in seq_len(ncol(hatching_mask))) { + if (hatching_mask[i, j]) { + # Calculate cell coordinates + x_min <- x_edges[i] + x_max <- x_edges[i + 1] + y_min <- y_edges[j] + y_max <- y_edges[j + 1] + # Draw grid cell + xs <- c(x_min, x_min, x_max, x_max) + ys <- c(y_min, y_max, y_max, y_min) + # Fill with diagonal lines + polygon(xs, ys, density = hatching_density, angle = hatching_angle, + border = NA, lwd = hatching_lwd, col = hatching_color) + if (hatching_cross) { + polygon(xs, ys, density = hatching_density, angle = -hatching_angle, + border = NA, lwd = hatching_lwd, col = hatching_color) + } + } + } + } +} + diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index ffdb5b2f4f9f2a320691780a07f6a32478261e7a..ef1b5b5d685e5e202b26493351377089179320ab 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -216,6 +216,27 @@ #' 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 \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 @@ -261,39 +282,42 @@ #' @importFrom s2dv InsertDim #'@export VizEquiMap <- function(var, 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), - 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, include_lower_boundary = TRUE, - include_upper_boundary = TRUE, ...) { + 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), + 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, 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, ...) { # 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") @@ -853,6 +877,14 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, 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 'var'.") + } + } # Check arrow parameters if (!is.numeric(arr_subsamp)) { @@ -1230,6 +1262,18 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } } + # + # Adding hatching + # ~~~~~~~~~~~~~~~~~ + # + if (!is.null(hatching_mask)) { + Hatching(hatching_mask = hatching_mask, lat = lat, lon = lon, data = var, + hatching_density = hatching_density, + hatching_angle = hatching_angle, + hatching_color = hatching_color, hatching_lwd = hatching_lwd, + hatching_cross = hatching_cross) + } + # # Adding a mask # ~~~~~~~~~~~~~~~ diff --git a/man/Hatching.Rd b/man/Hatching.Rd new file mode 100644 index 0000000000000000000000000000000000000000..edfad20f529b912b6984c17a6c7c24af02c571dd --- /dev/null +++ b/man/Hatching.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Hatching.R +\name{Hatching} +\alias{Hatching} +\title{Draws hatching or crosshatching over a mask on a map} +\usage{ +Hatching( + hatching_mask, + lat, + lon, + data = NULL, + hatching_density = 10, + hatching_angle = 45, + hatching_color = "#252525", + hatching_lwd = 0.5, + hatching_cross = FALSE +) +} +\arguments{ +\item{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.} + +\item{lat}{Numeric vector of latitude locations of the cell centers of the +grid.} + +\item{lon}{Numeric vector of longitude locations of the cell centers of the +grid.} + +\item{data}{Array of the data that the hatching will be drawn over. The array +should have named latidude and longitude dimensions. If the dimension order +is reversed relative to 'hatching_mask', the mask is automatically +transposed. Default is NULL.} + +\item{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.} + +\item{hatching_angle}{The slope of shading lines, given as an angle in degrees +(counter-clockwise). Default is 45.} + +\item{hatching_color}{Color of the hatching lines. Default is +\code{"#252525"}.} + +\item{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.} + +\item{hatching_cross}{A logical value indicating crosshatching. If TRUE, adds +a second set of lines in the opposite angle. Default is FALSE.} +} +\description{ +Adds hatching or crosshatching lines over grid cells of a map based on a +logical mask. The hatching is applied only to grid cells where the mask is +TRUE (or 1). A number of graphical options are available to customize the +appearance of the hatching, such as line density, angle, line width, and +color. Optionally, crosshatching can be drawn using a second set of lines in +the opposite direction. +The function assumes that the input mask is a 2D array with dimensions +corresponding to latitude (rows) and longitude (columns), and it is designed +to be used as a layer over existing map plots (e.g., within a call to +\code{VizEquiMap}) and does not initiate a plot by itself. +} +\examples{ + \dontrun{ +hatching_mask <- array(c(TRUE, FALSE, TRUE, FALSE), dim = c(lat = 2, lon = 2)) +lats <- 1:2 +lons <- 1:2 +image(lon_small, lat_small, matrix(1:4, nrow = 2)) +Hatching(hatching_mask = mask_small, lat = lat_small, lon = lon_small, + hatching_lwd = 2) + } +} diff --git a/man/VizEquiMap.Rd b/man/VizEquiMap.Rd index bad14aec2aa0a98b0fcfa1bd5d1890204d2b23cb..efb921b1e82744e11d5bab52de91aeb10c06f08a 100644 --- a/man/VizEquiMap.Rd +++ b/man/VizEquiMap.Rd @@ -43,7 +43,7 @@ VizEquiMap( dot_symbol = 4, dot_size = 1, mask = NULL, - mask_color = "white" + mask_color = "white", arr_subsamp = floor(length(lon)/30), arr_scale = 1, arr_ref_len = 15, @@ -89,6 +89,12 @@ VizEquiMap( res = 100, 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, ... ) } @@ -128,10 +134,10 @@ longitudinal and latitudinal coordinate dimensions are interchanged.} \item{sizetit}{Scale factor for the figure top title provided in parameter 'toptitle'. Deprecated. Use 'title_scale' instead.} -\item{caption}{A character string of the caption located at the left-bottom of +\item{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.} +manipulation functions like \code{paste()} or \code{paste0()}, using +\code{"\n"} to indicate line breaks.} \item{units}{Title at the top of the colour bar, most commonly the units of the variable provided in parameter 'var'.} @@ -312,9 +318,9 @@ and latitude axes.} TRUE. It is not possible to plot the colour bar if 'add = TRUE'. Use ColorBar() and the return values of PlotEquiMap() instead.} -\item{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.} +\item{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.} \item{draw_separators, triangle_ends_scale, bar_label_digits}{Set of parameters to control the visual aspect of the drawn colour bar @@ -364,12 +370,39 @@ the corresponding device.} \item{res}{Resolution of the device (file or window) to plot in. See ?Devices and the creator function of the corresponding device.} -\item{include_lower_boundary}{Logical value indicating whether to include +\item{include_lower_boundary}{Logical value indicating whether to include the minimum value of the field. Takes TRUE by default.} -\item{include_upper_boundary}{Logical value indicating whether to include +\item{include_upper_boundary}{Logical value indicating whether to include the maximum value of the field. Takes TRUE by default.} +\item{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.} + +\item{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.} + +\item{hatching_angle}{The slope of shading lines, given as an angle in degrees +(counter-clockwise). Default is 45.} + +\item{hatching_color}{Color of the hatching lines. Default is +\code{"#252525"}.} + +\item{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.} + +\item{hatching_cross}{A logical value indicating crosshatching. If TRUE, adds +a second set of lines in the opposite angle. Default is FALSE.} + \item{\dots}{Arguments to be passed to the method. Only accepts the following graphical parameters:\cr adj ann ask bg bty cex.sub cin col.axis col.lab col.main col.sub cra crt diff --git a/tests/testthat/test-ShapeToMask.R b/tests/testthat/test-ShapeToMask.R index 297bee520d9f639ed8c920a571ae64fd86407ae2..31a166723b9ec9d6b3ad9e12ad9c97cf7f6e3e11 100644 --- a/tests/testthat/test-ShapeToMask.R +++ b/tests/testthat/test-ShapeToMask.R @@ -113,4 +113,4 @@ test_that("2. Output", { sum(mask5), 56 ) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-VizEquiMap.R b/tests/testthat/test-VizEquiMap.R index b3e366c66b64e1dc82750dc4d26c0e3a78f29466..6604f5318e0b56980f530e79983a5da11d21860a 100644 --- a/tests/testthat/test-VizEquiMap.R +++ b/tests/testthat/test-VizEquiMap.R @@ -303,6 +303,12 @@ test_that("1. Input checks", { "Parameter 'numbfig' must be numeric." ) + # Check hatching_mask + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, hatching_mask = "test"), + "Parameter 'hatching_mask' must have two dimensions named as the longitude and latitude dimensions in 'var'." + ) + })