From dc6f448424c678c0337776d0b5845ce9a7e70dc2 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 17 Mar 2025 10:59:17 +0100 Subject: [PATCH 01/17] Add vtorralba's hatching function --- R/Hatching.R | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) create mode 100644 R/Hatching.R diff --git a/R/Hatching.R b/R/Hatching.R new file mode 100644 index 0000000..8f8bca9 --- /dev/null +++ b/R/Hatching.R @@ -0,0 +1,77 @@ +hatching<-function(lats, lons, mask, dens = 10, ang = 45, col_line = '#252525', + lwd_size = 0.5, crosshatching =FALSE) { + + # Function to add a mask over the maps + # July 2016. Veronica Torralba + + # Arguments: + # ~~~~~~~~ + # lats: Array of latitudes. + # lons: Array of longitudes. + # mask: matrix with dimensions (longitud x latitud) + # dens: the density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. + # A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling). + # ang: the slope of shading lines, given as an angle in degrees (counter-clockwise). + # col_line: colour of the lines + # lwd_size: The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices + # do not implement line widths less than one. + # crosshatching: T/F if crosshatching instead of diagonal lines. + + if (length(dim(mask))!= 2){ + stop('The mask matrix should have longitude x latitude dimensions') + } + + if (dim(mask)[1]!=length(lons)| dim(mask)[2]!=length(lats)){ + stop('The mask matrix should have longitude x latitude dimensions') + } + + # Function from www.menugget.blogspot.com + # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + matrix.poly <- function(x, y, z = mat, n = NULL) { + if (missing(z)) + stop("Must define matrix 'z'") + if (missing(n)) + stop("Must define at least 1 grid location 'n'") + if (missing(x)) + x <- seq(0,1,,dim(z)[1]) + if (missing(y)) + y <- seq(0,1,,dim(z)[2]) + poly <- vector(mode = "list", length(n)) + for (i in seq(n)) { + ROW <- ((n[i] - 1) %% dim(z)[1]) + 1 + COL <- ((n[i] - 1) %/% dim(z)[1]) + 1 + + dist.left <- (x[ROW] - x[ROW - 1]) / 2 + dist.right <- (x[ROW + 1] - x[ROW]) / 2 + if (ROW == 1) + dist.left <- dist.right + if (ROW == dim(z)[1]) + dist.right <- dist.left + + dist.down <- (y[COL] - y[COL - 1]) / 2 + dist.up <- (y[COL + 1] - y[COL]) / 2 + if (COL == 1) + dist.down <- dist.up + if (COL == dim(z)[2]) + dist.up <- dist.down + + xs <- + c(x[ROW] - dist.left, x[ROW] - dist.left, x[ROW] + dist.right, x[ROW] + + dist.right) + ys <- + c(y[COL] - dist.down, y[COL] + dist.up, y[COL] + dist.up, y[COL] - dist.down) + poly[[i]] <- data.frame(x = xs, y = ys) + } + return(poly) + } + + M <- list(x = lons, y = lats, z = mask) + incl <- which(M$z ==TRUE) + polys <- matrix.poly(M$x, M$y, z = M$z, n = incl) + for (i in seq(polys)) { + polygon( polys[[i]], density = dens, angle = ang, border = NA, lwd = lwd_size,col=col_line) + if (crosshatching) { + polygon(polys[[i]], density = dens, angle = -ang, border = NA, lwd = lwd_size, col=col_line) + } + } +} -- GitLab From e2b8092091c16c164c0d2b515c5e0e4bed586281 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 17 Mar 2025 15:33:56 +0100 Subject: [PATCH 02/17] Format changes to R/Hatching.R --- R/Hatching.R | 49 +++++++++++++++++++++++++------------------------ 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index 8f8bca9..21562c9 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -1,27 +1,28 @@ -hatching<-function(lats, lons, mask, dens = 10, ang = 45, col_line = '#252525', - lwd_size = 0.5, crosshatching =FALSE) { +# Function to add a mask over the maps +# July 2016. Veronica Torralba + +# Arguments: +# ~~~~~~~~ +# lat: Array of latitudes. +# lon: Array of longitudes. +# mask: matrix with dimensions (longitud x latitud). +# dens: the density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. +# A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling). +# ang: the slope of shading lines, given as an angle in degrees (counter-clockwise). +# col_line: colour of the lines. +# lwd_size: The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices +# do not implement line widths less than one. +# crosshatching: T/F if crosshatching instead of diagonal lines. + +Hatching <- function(lat, lon, mask, dens = 10, ang = 45, col_line = '#252525', + lwd_size = 0.5, crosshatching =FALSE) { - # Function to add a mask over the maps - # July 2016. Veronica Torralba - - # Arguments: - # ~~~~~~~~ - # lats: Array of latitudes. - # lons: Array of longitudes. - # mask: matrix with dimensions (longitud x latitud) - # dens: the density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. - # A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling). - # ang: the slope of shading lines, given as an angle in degrees (counter-clockwise). - # col_line: colour of the lines - # lwd_size: The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices - # do not implement line widths less than one. - # crosshatching: T/F if crosshatching instead of diagonal lines. - - if (length(dim(mask))!= 2){ + if (length(dim(mask)) != 2){ stop('The mask matrix should have longitude x latitude dimensions') } - - if (dim(mask)[1]!=length(lons)| dim(mask)[2]!=length(lats)){ + if (dim(mask)[1] == length(lat) & dim(mask)[2] == length(lon)) { + mask <- t(mask) + } else if (dim(mask)[1] != length(lon) | dim(mask)[2] != length(lat)){ stop('The mask matrix should have longitude x latitude dimensions') } @@ -33,9 +34,9 @@ hatching<-function(lats, lons, mask, dens = 10, ang = 45, col_line = '#252525', if (missing(n)) stop("Must define at least 1 grid location 'n'") if (missing(x)) - x <- seq(0,1,,dim(z)[1]) + x <- seq(0, 1, length.out = dim(z)[1]) if (missing(y)) - y <- seq(0,1,,dim(z)[2]) + y <- seq(0, 1, length.out = dim(z)[2]) poly <- vector(mode = "list", length(n)) for (i in seq(n)) { ROW <- ((n[i] - 1) %% dim(z)[1]) + 1 @@ -65,7 +66,7 @@ hatching<-function(lats, lons, mask, dens = 10, ang = 45, col_line = '#252525', return(poly) } - M <- list(x = lons, y = lats, z = mask) + M <- list(x = lon, y = lat, z = mask) incl <- which(M$z ==TRUE) polys <- matrix.poly(M$x, M$y, z = M$z, n = incl) for (i in seq(polys)) { -- GitLab From 4a69301731711b8db6b4f81e65571f7e0f58f4ea Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 17 Mar 2025 15:34:41 +0100 Subject: [PATCH 03/17] Add Hatching() to R/VizEquiMap.R --- R/VizEquiMap.R | 97 ++++++++++++++++++++++++++++++++------------------ 1 file changed, 63 insertions(+), 34 deletions(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 2633ceb..7a35ac9 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -207,6 +207,19 @@ #' 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 matrix with dimensions (longitud x latitud). +#'@param hatching_density the density of shading lines, in lines per inch. +#' The default value of NULL means that no shading lines are drawn. A zero +#' value of density means no shading nor filling whereas negative values and NA +#' suppress shading (and so allow color filling). +#'@param hatching_angle the slope of shading lines, given as an angle in degrees +#' (counter-clockwise). +#'@param hatching_color colour of the lines. +#'@param hatching_lwd The line width, a positive number, defaulting to 1. The +#' interpretation is device-specific, and some devices do not implement line +#' widths less than one. +#'@param hatching_cross logical value to indicate crosshatching instead of +#' diagonal lines. #'@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 @@ -250,39 +263,42 @@ #' @importFrom s2dv InsertDim #'@export VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, - toptitle = NULL, sizetit = 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, 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, - 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, 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, 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, + 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") @@ -1167,6 +1183,17 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } } + # + # Adding hatching + # ~~~~~~~~~~~~~~~~ + # + if (!is.null(hatching_mask)) { + Hatching(lat = lat, lon = lon, mask = hatching_mask, + dens = hatching_density, ang = hatching_angle, + col_line = hatching_color, lwd_size = hatching_lwd, + crosshatching = hatching_cross) + } + # # Adding a mask # ~~~~~~~~~~~~~~~ @@ -1210,7 +1237,9 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # Plotting continents # ~~~~~~~~~~~~~~~~~~~~~ # - wrap_vec <- c(lonb$x[1], lonb$x[1] + 360) + 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 -- GitLab From eebfd1695c97b07b2892529755a1ca7e509688ec Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Wed, 26 Mar 2025 14:03:40 +0100 Subject: [PATCH 04/17] Refactored Hatching() to use lat x lon input --- R/Hatching.R | 86 ++++++++++++++++++++-------------------------------- 1 file changed, 33 insertions(+), 53 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index 21562c9..47b1ff4 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -5,7 +5,7 @@ # ~~~~~~~~ # lat: Array of latitudes. # lon: Array of longitudes. -# mask: matrix with dimensions (longitud x latitud). +# mask: matrix with dimensions (latitud x longitude). # dens: the density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. # A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling). # ang: the slope of shading lines, given as an angle in degrees (counter-clockwise). @@ -15,64 +15,44 @@ # crosshatching: T/F if crosshatching instead of diagonal lines. Hatching <- function(lat, lon, mask, dens = 10, ang = 45, col_line = '#252525', - lwd_size = 0.5, crosshatching =FALSE) { + lwd_size = 0.5, crosshatching = FALSE) { if (length(dim(mask)) != 2){ - stop('The mask matrix should have longitude x latitude dimensions') - } - if (dim(mask)[1] == length(lat) & dim(mask)[2] == length(lon)) { - mask <- t(mask) - } else if (dim(mask)[1] != length(lon) | dim(mask)[2] != length(lat)){ - stop('The mask matrix should have longitude x latitude dimensions') + stop('The mask matrix should have latitude x longitude dimensions') } + # if (dim(mask)[1] == length(lon) & dim(mask)[2] == length(lat)) { + # mask <- t(mask) + # } else if (dim(mask)[1] != length(lat) | dim(mask)[2] != length(lon)){ + # stop('The mask matrix should have latitude x longitude dimensions') + # } - # Function from www.menugget.blogspot.com - # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - matrix.poly <- function(x, y, z = mat, n = NULL) { - if (missing(z)) - stop("Must define matrix 'z'") - if (missing(n)) - stop("Must define at least 1 grid location 'n'") - if (missing(x)) - x <- seq(0, 1, length.out = dim(z)[1]) - if (missing(y)) - y <- seq(0, 1, length.out = dim(z)[2]) - poly <- vector(mode = "list", length(n)) - for (i in seq(n)) { - ROW <- ((n[i] - 1) %% dim(z)[1]) + 1 - COL <- ((n[i] - 1) %/% dim(z)[1]) + 1 - - dist.left <- (x[ROW] - x[ROW - 1]) / 2 - dist.right <- (x[ROW + 1] - x[ROW]) / 2 - if (ROW == 1) - dist.left <- dist.right - if (ROW == dim(z)[1]) - dist.right <- dist.left - - dist.down <- (y[COL] - y[COL - 1]) / 2 - dist.up <- (y[COL + 1] - y[COL]) / 2 - if (COL == 1) - dist.down <- dist.up - if (COL == dim(z)[2]) - dist.up <- dist.down - - xs <- - c(x[ROW] - dist.left, x[ROW] - dist.left, x[ROW] + dist.right, x[ROW] + - dist.right) - ys <- - c(y[COL] - dist.down, y[COL] + dist.up, y[COL] + dist.up, y[COL] - dist.down) - poly[[i]] <- data.frame(x = xs, y = ys) - } - return(poly) + # 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) } - M <- list(x = lon, y = lat, z = mask) - incl <- which(M$z ==TRUE) - polys <- matrix.poly(M$x, M$y, z = M$z, n = incl) - for (i in seq(polys)) { - polygon( polys[[i]], density = dens, angle = ang, border = NA, lwd = lwd_size,col=col_line) - if (crosshatching) { - polygon(polys[[i]], density = dens, angle = -ang, border = NA, lwd = lwd_size, col=col_line) + x_edges <- get_edges(lon) + y_edges <- get_edges(lat) + + for (i in seq_len(nrow(mask))) { + for (j in seq_len(ncol(mask))) { + if (mask[i, j]) { + x_min <- x_edges[i] + x_max <- x_edges[i + 1] + y_min <- y_edges[j] + y_max <- y_edges[j + 1] + + xs <- c(x_min, x_min, x_max, x_max) + ys <- c(y_min, y_max, y_max, y_min) + + polygon(xs, ys, density = dens, angle = ang, border = NA, lwd = lwd_size, col = col_line) + if (crosshatching) { + polygon(xs, ys, density = dens, angle = -ang, border = NA, lwd = lwd_size, col = col_line) + } + } } } } + -- GitLab From e15a22c3fb55544c91d8542df2d3e1a67a7faf09 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Thu, 27 Mar 2025 14:54:13 +0100 Subject: [PATCH 05/17] Update netcdf file name --- tests/testthat/test-ShapeToMask.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-ShapeToMask.R b/tests/testthat/test-ShapeToMask.R index 550f2ee..31a1667 100644 --- a/tests/testthat/test-ShapeToMask.R +++ b/tests/testthat/test-ShapeToMask.R @@ -12,7 +12,7 @@ NUTS_name1 <- list(FI = c('Lappi', 'Kainuu'), SI = c('Pomurska', 'Podravska')) # data2 shp_file2 <- "/esarchive/shapefiles/gadm_country_mask/gadm_country_ISO3166.shp" ref_grid2 <- paste0('/esarchive/exp/ecmwf/s2s-monthly_ensfor/weekly_mean/', - 'tas_f6h/tas_20191212.nc') + 'tas_f24h/tas_20191212.nc') GADM_id2 <- c("ESP", "ITA") GADM_name2 <- c("Spain", "Italy") @@ -113,4 +113,4 @@ test_that("2. Output", { sum(mask5), 56 ) -}) \ No newline at end of file +}) -- GitLab From ae6ebdfb7b56f78e7e57668d20aaa10afd6e554b Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Thu, 27 Mar 2025 15:04:48 +0100 Subject: [PATCH 06/17] Replace 'hatching_mask' with 'hatching' in VizEquiMap.R --- R/VizEquiMap.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index c5e6128..1d78671 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -216,7 +216,7 @@ #' 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 matrix with dimensions (longitud x latitud). +#'@param hatching matrix with dimensions (longitud x latitud). #'@param hatching_density the density of shading lines, in lines per inch. #' The default value of NULL means that no shading lines are drawn. A zero #' value of density means no shading nor filling whereas negative values and NA @@ -306,7 +306,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, 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, + include_upper_boundary = TRUE, hatching = NULL, hatching_density = 10, hatching_angle = 45, hatching_color = "#252525", hatching_lwd = 0.5, hatching_cross = FALSE, ...) { @@ -1250,8 +1250,8 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # Adding hatching # ~~~~~~~~~~~~~~~~ # - if (!is.null(hatching_mask)) { - Hatching(lat = lat, lon = lon, mask = hatching_mask, + if (!is.null(hatching)) { + Hatching(lat = lat, lon = lon, mask = hatching, dens = hatching_density, ang = hatching_angle, col_line = hatching_color, lwd_size = hatching_lwd, crosshatching = hatching_cross) -- GitLab From 1356c1a3f2b9aad9ac02c19c9ad35e1bf578851c Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Tue, 1 Apr 2025 17:45:36 +0200 Subject: [PATCH 07/17] Add informative comments to Hatching.R --- R/Hatching.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index 47b1ff4..e3ef885 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -3,18 +3,18 @@ # Arguments: # ~~~~~~~~ +# mask: Matrix with dimensions (latitud x longitude). # lat: Array of latitudes. # lon: Array of longitudes. -# mask: matrix with dimensions (latitud x longitude). -# dens: the density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. +# dens: The density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. # A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling). -# ang: the slope of shading lines, given as an angle in degrees (counter-clockwise). -# col_line: colour of the lines. +# ang: The slope of shading lines, given as an angle in degrees (counter-clockwise). +# col_line: Colour of the lines. # lwd_size: The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices # do not implement line widths less than one. # crosshatching: T/F if crosshatching instead of diagonal lines. -Hatching <- function(lat, lon, mask, dens = 10, ang = 45, col_line = '#252525', +Hatching <- function(mask, lat, lon, dens = 10, ang = 45, col_line = '#252525', lwd_size = 0.5, crosshatching = FALSE) { if (length(dim(mask)) != 2){ @@ -32,21 +32,22 @@ Hatching <- function(lat, lon, mask, dens = 10, ang = 45, col_line = '#252525', 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 mask for (i in seq_len(nrow(mask))) { for (j in seq_len(ncol(mask))) { if (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 = dens, angle = ang, border = NA, lwd = lwd_size, col = col_line) if (crosshatching) { polygon(xs, ys, density = dens, angle = -ang, border = NA, lwd = lwd_size, col = col_line) -- GitLab From 821e877a45bc23dd2cbc4bcf807f3ad6f6f1a74f Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Wed, 2 Apr 2025 14:31:18 +0200 Subject: [PATCH 08/17] Add 'data' parameter to Hatching(), improve checks and add documentation --- R/Hatching.R | 78 ++++++++++++++++++++++++++++++++++---------------- R/VizEquiMap.R | 2 +- 2 files changed, 54 insertions(+), 26 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index e3ef885..c01b301 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -1,32 +1,60 @@ -# Function to add a mask over the maps -# July 2016. Veronica Torralba +#' 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. 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 has dimensions corresponding to +#' latitude by longitude (i.e., rows are latitudes, columns are longitudes). +#' This function 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 mask Matrix with named dimensions (latitud x longitude). +#'@param lat Array of latitudes. +#'@param lon Array of longitudes. +#'@param dens The density of shading lines, in lines per inch. The default value +#' of NULL means that no shading lines are drawn. A zero value of density means +#' no shading nor filling whereas negative values and NA suppress shading (and +#' so allow color filling). +#'@param ang The slope of shading lines, given as an angle in degrees (counter-clockwise). +#'@param col_line Colour of the lines. +#'@param lwd_size The line width, a positive number, defaulting to 1. The +#' interpretation is device-specific, and some devices do not implement line +#' widths less than one. +#'@param crosshatching A logical value indicating crosshatching instead of +#' diagonal lines. -# Arguments: -# ~~~~~~~~ -# mask: Matrix with dimensions (latitud x longitude). -# lat: Array of latitudes. -# lon: Array of longitudes. -# dens: The density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn. -# A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling). -# ang: The slope of shading lines, given as an angle in degrees (counter-clockwise). -# col_line: Colour of the lines. -# lwd_size: The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices -# do not implement line widths less than one. -# crosshatching: T/F if crosshatching instead of diagonal lines. - -Hatching <- function(mask, lat, lon, dens = 10, ang = 45, col_line = '#252525', - lwd_size = 0.5, crosshatching = FALSE) { +Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, + col_line = '#252525', lwd_size = 0.5, + crosshatching = FALSE) { - if (length(dim(mask)) != 2){ - stop('The mask matrix should have latitude x longitude dimensions') + if (length(dim(mask)) != 2) { + stop('The mask matrix should have latitude and longitude dimensions') + } + lon_dim <- intersect(names(dim(mask)), .KnownLonNames()) + lat_dim <- intersect(names(dim(mask)), .KnownLatNames()) + if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { + stop('The mask matrix should have two named latitude and longitude dimensions') + } + # If lat/lon are reversed, transpose the mask + if (!is.null(data)) { + if (!is.null(names(dim(data))) && !is.null(names(dim(mask)))) { + if (names(dim(mask))[1] == names(dim(data))[2] && + names(dim(mask))[2] == names(dim(data))[1]) { + mask <- t(mask) + } + } } - # if (dim(mask)[1] == length(lon) & dim(mask)[2] == length(lat)) { - # mask <- t(mask) - # } else if (dim(mask)[1] != length(lat) | dim(mask)[2] != length(lon)){ - # stop('The mask matrix should have latitude x longitude dimensions') - # } + ## if (dim(mask)[1] == length(lon) & dim(mask)[2] == length(lat)) { + ## mask <- t(mask) + ## } else if (dim(mask)[1] != length(lat) | dim(mask)[2] != length(lon)){ + ## stop('The mask matrix should have latitude x longitude dimensions') + ## } - # Calculate cell edges (breaks between lat/lon points) + # 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)]) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 1d78671..d31d55a 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -1251,7 +1251,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # ~~~~~~~~~~~~~~~~ # if (!is.null(hatching)) { - Hatching(lat = lat, lon = lon, mask = hatching, + Hatching(mask = hatching, lat = lat, lon = lon, data = var, dens = hatching_density, ang = hatching_angle, col_line = hatching_color, lwd_size = hatching_lwd, crosshatching = hatching_cross) -- GitLab From a3404b03eca353b1e3ad35cc90e5dd033e9c6490 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Wed, 2 Apr 2025 16:45:43 +0200 Subject: [PATCH 09/17] Add 'data' description and improve checks in Hatching.R --- R/Hatching.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index c01b301..3aee481 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -15,6 +15,10 @@ #'@param mask Matrix with named dimensions (latitud x longitude). #'@param lat Array of latitudes. #'@param lon Array of longitudes. +#'@param data Array of the data that the hatching will be drawn over. The array +#' should have named latidude and longitude dimensions. If the dimensions are +#' not in the same order as in mask, the mask array is transposed. Default is +#' NULL. #'@param dens The density of shading lines, in lines per inch. The default value #' of NULL means that no shading lines are drawn. A zero value of density means #' no shading nor filling whereas negative values and NA suppress shading (and @@ -32,16 +36,16 @@ Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, crosshatching = FALSE) { if (length(dim(mask)) != 2) { - stop('The mask matrix should have latitude and longitude dimensions') + stop('The mask matrix should have two named latitude and longitude dimensions') } lon_dim <- intersect(names(dim(mask)), .KnownLonNames()) lat_dim <- intersect(names(dim(mask)), .KnownLatNames()) if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { stop('The mask matrix should have two named latitude and longitude dimensions') } - # If lat/lon are reversed, transpose the mask + # If lat/lon are reversed respect 'data', transpose the mask if (!is.null(data)) { - if (!is.null(names(dim(data))) && !is.null(names(dim(mask)))) { + if (!is.null(names(dim(data)))) { if (names(dim(mask))[1] == names(dim(data))[2] && names(dim(mask))[2] == names(dim(data))[1]) { mask <- t(mask) -- GitLab From fffd02dcd6d01853367925a086f991ed728e9a8f Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Wed, 2 Apr 2025 18:28:28 +0200 Subject: [PATCH 10/17] Add more detailed checks --- R/Hatching.R | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index 3aee481..f294fa5 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -36,13 +36,23 @@ Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, crosshatching = FALSE) { if (length(dim(mask)) != 2) { - stop('The mask matrix should have two named latitude and longitude dimensions') + stop("The mask matrix should have two named latitude and longitude dimensions") } - lon_dim <- intersect(names(dim(mask)), .KnownLonNames()) - lat_dim <- intersect(names(dim(mask)), .KnownLatNames()) - if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { + if (!is.null(names(dim(var)))) { + if (any(names(dim(var)) %in% .KnownLonNames()) && + any(names(dim(var)) %in% .KnownLatNames())) { + lon_dim <- names(dim(var))[names(dim(var)) %in% .KnownLonNames()] + lat_dim <- names(dim(var))[names(dim(var)) %in% .KnownLatNames()] + if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { + stop("The dimensions of the mask do not match the lengths of 'lat' and 'lon'.") + } + } else { + stop("Dimension names of 'var' doesn't correspond to any coordinates names supported by s2dv package.") + } + } else { stop('The mask matrix should have two named latitude and longitude dimensions') } + # If lat/lon are reversed respect 'data', transpose the mask if (!is.null(data)) { if (!is.null(names(dim(data)))) { -- GitLab From 4586c31eb91f32471a00ba04e18b6cd48d1a1708 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Fri, 4 Apr 2025 17:06:02 +0200 Subject: [PATCH 11/17] Refactor checks and improve documentation --- R/Hatching.R | 70 ++++++++++++++++++++++------------------------------ 1 file changed, 30 insertions(+), 40 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index f294fa5..f8c5b92 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -6,54 +6,49 @@ #' 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 has dimensions corresponding to -#' latitude by longitude (i.e., rows are latitudes, columns are longitudes). -#' This function 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. +#' 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 mask Matrix with named dimensions (latitud x longitude). +#'@param mask Array with two named dimensions (latitud x longitude). #'@param lat Array of latitudes. #'@param lon Array of longitudes. #'@param data Array of the data that the hatching will be drawn over. The array -#' should have named latidude and longitude dimensions. If the dimensions are -#' not in the same order as in mask, the mask array is transposed. Default is -#' NULL. +#' should have named latidude and longitude dimensions. If the dimension order +#' is reversed relative to 'mask', the mask is automatically transposed. +#' Default is NULL. #'@param dens The density of shading lines, in lines per inch. The default value #' of NULL means that no shading lines are drawn. A zero value of density means #' no shading nor filling whereas negative values and NA suppress shading (and -#' so allow color filling). -#'@param ang The slope of shading lines, given as an angle in degrees (counter-clockwise). -#'@param col_line Colour of the lines. -#'@param lwd_size The line width, a positive number, defaulting to 1. The -#' interpretation is device-specific, and some devices do not implement line -#' widths less than one. -#'@param crosshatching A logical value indicating crosshatching instead of -#' diagonal lines. +#' so allow color filling). Default is 10. +#'@param ang The slope of shading lines, given as an angle in degrees +#' (counter-clockwise). Default is 45. +#'@param col_line olor of the hatching lines. Default is \code{"#252525"}. +#'@param lwd_size 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 crosshatching A logical value indicating crosshatching. If TRUE, adds a +#' second set of lines in the opposite angle. Default is FALSE: Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, col_line = '#252525', lwd_size = 0.5, crosshatching = FALSE) { - if (length(dim(mask)) != 2) { - stop("The mask matrix should have two named latitude and longitude dimensions") + if (length(dim(mask)) != 2 || is.null(names(dim(var)))) { + stop("The mask array should have two named latitude and longitude dimensions") + } + if (!(any(names(dim(var)) %in% .KnownLonNames()) && + any(names(dim(var)) %in% .KnownLatNames()))) { + stop("Dimension names of 'var' doesn't correspond to any coordinates names supported by s2dv package.") + } + lon_dim <- names(dim(var))[names(dim(var)) %in% .KnownLonNames()] + lat_dim <- names(dim(var))[names(dim(var)) %in% .KnownLatNames()] + if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { + stop("The dimensions of the mask do not match the lengths of 'lat' and 'lon'.") } - if (!is.null(names(dim(var)))) { - if (any(names(dim(var)) %in% .KnownLonNames()) && - any(names(dim(var)) %in% .KnownLatNames())) { - lon_dim <- names(dim(var))[names(dim(var)) %in% .KnownLonNames()] - lat_dim <- names(dim(var))[names(dim(var)) %in% .KnownLatNames()] - if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { - stop("The dimensions of the mask do not match the lengths of 'lat' and 'lon'.") - } - } else { - stop("Dimension names of 'var' doesn't correspond to any coordinates names supported by s2dv package.") - } - } else { - stop('The mask matrix should have two named latitude and longitude dimensions') - } - - # If lat/lon are reversed respect 'data', transpose the mask + + # If 'mask' dimensions are reversed respect 'data', transpose the mask if (!is.null(data)) { if (!is.null(names(dim(data)))) { if (names(dim(mask))[1] == names(dim(data))[2] && @@ -62,11 +57,6 @@ Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, } } } - ## if (dim(mask)[1] == length(lon) & dim(mask)[2] == length(lat)) { - ## mask <- t(mask) - ## } else if (dim(mask)[1] != length(lat) | dim(mask)[2] != length(lon)){ - ## stop('The mask matrix should have latitude x longitude dimensions') - ## } # Helper function to calculate cell edges (breaks between lat/lon points) get_edges <- function(vec) { -- GitLab From 2c498b09885056756ad760393017e6f6f316d22d Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Fri, 4 Apr 2025 17:16:28 +0200 Subject: [PATCH 12/17] Update VizEquiMap.R documentation --- R/VizEquiMap.R | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index d31d55a..d82d664 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -216,19 +216,21 @@ #' 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 matrix with dimensions (longitud x latitud). -#'@param hatching_density the density of shading lines, in lines per inch. -#' The default value of NULL means that no shading lines are drawn. A zero -#' value of density means no shading nor filling whereas negative values and NA -#' suppress shading (and so allow color filling). -#'@param hatching_angle the slope of shading lines, given as an angle in degrees -#' (counter-clockwise). -#'@param hatching_color colour of the lines. -#'@param hatching_lwd The line width, a positive number, defaulting to 1. The -#' interpretation is device-specific, and some devices do not implement line -#' widths less than one. -#'@param hatching_cross logical value to indicate crosshatching instead of -#' diagonal lines. +#'@param hatching Logical array with two named dimensions (latitud x longitude). +#' Hatching is applied to grid cells where 'hatching' is TRUE. +#'@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 -- GitLab From 4ec9c2d10069c135c7bc7637d952f3f78507cf8f Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 7 Apr 2025 16:08:36 +0200 Subject: [PATCH 13/17] Add parameter checks and some refactoring --- R/Hatching.R | 130 ++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 103 insertions(+), 27 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index f8c5b92..3915963 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -2,7 +2,7 @@ #' #' 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. A number of graphical options are available to customize the appearance +#' 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. @@ -11,53 +11,129 @@ #' 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 mask Array with two named dimensions (latitud x longitude). -#'@param lat Array of latitudes. -#'@param lon Array of longitudes. +#'@param mask Logical or binary (0/1) array with two named dimensions: +#' c(latitude, longitude).Hatching is applied to grid cells where '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 'mask' and 'data', and automatically transpose '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 'mask', the mask is automatically transposed. #' Default is NULL. -#'@param dens The density of shading lines, in lines per inch. The default value -#' of NULL means that no shading lines are drawn. A zero value of density means -#' no shading nor filling whereas negative values and NA suppress shading (and -#' so allow color filling). Default is 10. -#'@param ang The slope of shading lines, given as an angle in degrees +#'@param 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 angle The slope of shading lines, given as an angle in degrees #' (counter-clockwise). Default is 45. -#'@param col_line olor of the hatching lines. Default is \code{"#252525"}. +#'@param col_line Color of the hatching lines. Default is \code{"#252525"}. #'@param lwd_size 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 crosshatching A logical value indicating crosshatching. If TRUE, adds a -#' second set of lines in the opposite angle. Default is FALSE: +#' second set of lines in the opposite angle. Default is FALSE. +#'@examples +#' \dontrun{ +#'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(mask = mask_small, lat = lat_small, lon = lon_small, lwd_size = 2) +#' } +#'@importFrom s2dv InsertDim +#'@export -Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, +Hatching <- function(mask, lat, lon, data = NULL, density = 10, angle = 45, col_line = '#252525', lwd_size = 0.5, crosshatching = FALSE) { - if (length(dim(mask)) != 2 || is.null(names(dim(var)))) { - stop("The mask array should have two named latitude and longitude dimensions") + if (length(dim(mask)) != 2 || is.null(names(dim(mask)))) { + stop("The hatching 'mask' array should have two named latitude and longitude dimensions") } - if (!(any(names(dim(var)) %in% .KnownLonNames()) && - any(names(dim(var)) %in% .KnownLatNames()))) { - stop("Dimension names of 'var' doesn't correspond to any coordinates names supported by s2dv package.") + if (!(any(names(dim(mask)) %in% .KnownLonNames()) && + any(names(dim(mask)) %in% .KnownLatNames()))) { + stop("Dimension names of the hatching 'mask' doesn't correspond to any + coordinates names supported by s2dv package.") } - lon_dim <- names(dim(var))[names(dim(var)) %in% .KnownLonNames()] - lat_dim <- names(dim(var))[names(dim(var)) %in% .KnownLatNames()] + lon_dim <- names(dim(mask))[names(dim(mask)) %in% .KnownLonNames()] + lat_dim <- names(dim(mask))[names(dim(mask)) %in% .KnownLatNames()] if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { - stop("The dimensions of the mask do not match the lengths of 'lat' and 'lon'.") + stop("The dimensions of the hatching 'mask' do not match the lengths of 'lat' and 'lon'.") } - - # If 'mask' dimensions are reversed respect 'data', transpose the mask + + # If 'mask' dimensions are reversed respect 'data', reorder them if (!is.null(data)) { if (!is.null(names(dim(data)))) { - if (names(dim(mask))[1] == names(dim(data))[2] && - names(dim(mask))[2] == names(dim(data))[1]) { - mask <- t(mask) + if (!identical(names(dim(mask)), names(dim(data)))) { + mask <- aperm(mask, match(names(dim(data)), names(dim(mask)))) } } } + # Convert numeric values to logical values in mask + if (is.numeric(mask)) { + if (all(mask %in% c(0, 1))) { + mask <- mask == 1 + } else { + stop("The hatching 'mask' array must have only TRUE/FALSE or 0/1.") + } + } else if (!is.logical(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 density + if (!is.null(density)) { + if (!is.numeric(density) || length(density) != 1) { + stop("Parameter 'density' must be a single numeric value.") + } + } + + # Check angle + if (!is.null(angle)) { + if (!is.numeric(angle) || length(angle) != 1) { + stop("Parameter 'angle' must be a single numeric value.") + } + } + + # Check col_line + if (!is.null(col_line)) { + if (!.IsColor(col_line)) { + stop("Parameter 'col_line' must be a valid colour identifier.") + } + } + + # Check lwd_size + if (!is.null(lwd_size)) { + if (!is.numeric(lwd_size) || length(lwd_size) != 1 || lwd_size <= 0) { + stop("Parameter 'lwd_size' must be a single positive numeric value.") + } + } + + # Check crosshatching + if (!is.null(crosshatching)) { + if (!is.logical(crosshatching) || length(crosshatching) != 1) { + stop("Parameter 'crosshatching' 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 @@ -80,9 +156,9 @@ Hatching <- function(mask, lat, lon, data = NULL, dens = 10, ang = 45, 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 = dens, angle = ang, border = NA, lwd = lwd_size, col = col_line) + polygon(xs, ys, density = density, angle = angle, border = NA, lwd = lwd_size, col = col_line) if (crosshatching) { - polygon(xs, ys, density = dens, angle = -ang, border = NA, lwd = lwd_size, col = col_line) + polygon(xs, ys, density = density, angle = -angle, border = NA, lwd = lwd_size, col = col_line) } } } -- GitLab From 4e23ce70d8b61a5a7caebf041dcfd6bcdc3f213f Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 7 Apr 2025 16:09:17 +0200 Subject: [PATCH 14/17] Add Hatching check in VizEquiMap.R --- R/VizEquiMap.R | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index d82d664..c42d0a4 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -216,8 +216,13 @@ #' 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 Logical array with two named dimensions (latitud x longitude). -#' Hatching is applied to grid cells where 'hatching' is TRUE. +#'@param hatching Logical or binary (0/1) array with two named dimensions: +#' c(latitude, longitude).Hatching is applied to grid cells where '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 'mask' and 'data', and automatically transpose '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 @@ -871,6 +876,14 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, stop("Parameter 'mask_color' must be a valid colour identifier.") } } + + # Check hatching + if (!is.null(hatching)) { + hatching <- drop(hatching) + if (!is.array(hatching) || any(!names(dim(hatching)) %in% c(lon_dim, lat_dim))) { + stop("Parameter 'hatching' must have two dimensions named as the longitude and latitude dimensions in 'var'.") + } + } # Check arrow parameters if (!is.numeric(arr_subsamp)) { @@ -1254,7 +1267,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # if (!is.null(hatching)) { Hatching(mask = hatching, lat = lat, lon = lon, data = var, - dens = hatching_density, ang = hatching_angle, + density = hatching_density, angle = hatching_angle, col_line = hatching_color, lwd_size = hatching_lwd, crosshatching = hatching_cross) } -- GitLab From d2ff277b80c64c751b166233da563d9e5cf7ae98 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Mon, 14 Apr 2025 15:55:19 +0200 Subject: [PATCH 15/17] Add 'hatching_' prefix to Hatching.R parameters and fix s2dv dependency --- R/Hatching.R | 155 +++++++++++++++++++++++++------------------------ R/VizEquiMap.R | 40 +++++++------ 2 files changed, 101 insertions(+), 94 deletions(-) diff --git a/R/Hatching.R b/R/Hatching.R index 3915963..0a0b82e 100644 --- a/R/Hatching.R +++ b/R/Hatching.R @@ -2,89 +2,92 @@ #' #' 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. +#' 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 mask Logical or binary (0/1) array with two named dimensions: -#' c(latitude, longitude).Hatching is applied to grid cells where '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 'mask' and 'data', and automatically transpose 'mask' if the latitude and -#' longitude dimensions appear to be reversed. +#'@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 'mask', the mask is automatically transposed. -#' Default is NULL. -#'@param 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 angle The slope of shading lines, given as an angle in degrees +#' 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 col_line Color of the hatching lines. Default is \code{"#252525"}. -#'@param lwd_size The line width, a positive number. The interpretation is +#'@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 crosshatching A logical value indicating crosshatching. If TRUE, adds a -#' second set of lines in the opposite angle. Default is FALSE. +#'@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{ -#'mask <- array(c(TRUE, FALSE, TRUE, FALSE), dim = c(lat = 2, lon = 2)) +#'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(mask = mask_small, lat = lat_small, lon = lon_small, lwd_size = 2) +#'Hatching(hatching_mask = mask_small, lat = lat_small, lon = lon_small, +#' hatching_lwd = 2) #' } -#'@importFrom s2dv InsertDim #'@export -Hatching <- function(mask, lat, lon, data = NULL, density = 10, angle = 45, - col_line = '#252525', lwd_size = 0.5, - crosshatching = FALSE) { +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(mask)) != 2 || is.null(names(dim(mask)))) { - stop("The hatching 'mask' array should have two named latitude and longitude dimensions") + 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(mask)) %in% .KnownLonNames()) && - any(names(dim(mask)) %in% .KnownLatNames()))) { - stop("Dimension names of the hatching 'mask' doesn't correspond to any - coordinates names supported by s2dv package.") + 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(mask))[names(dim(mask)) %in% .KnownLonNames()] - lat_dim <- names(dim(mask))[names(dim(mask)) %in% .KnownLatNames()] - if (dim(mask)[[lat_dim]] != length(lat) | dim(mask)[[lon_dim]] != length(lon)) { - stop("The dimensions of the hatching 'mask' do not match the lengths of 'lat' and 'lon'.") + 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 'mask' dimensions are reversed respect 'data', reorder them + # If 'hatching_mask' dimensions are reversed respect 'data', reorder them if (!is.null(data)) { if (!is.null(names(dim(data)))) { - if (!identical(names(dim(mask)), names(dim(data)))) { - mask <- aperm(mask, match(names(dim(data)), names(dim(mask)))) + 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 mask - if (is.numeric(mask)) { - if (all(mask %in% c(0, 1))) { - mask <- mask == 1 + # 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.") + stop("The 'hatching_mask' array must have only TRUE/FALSE or 0/1.") } - } else if (!is.logical(mask)) { - 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 @@ -99,38 +102,38 @@ Hatching <- function(mask, lat, lon, data = NULL, density = 10, angle = 45, } } - # Check density - if (!is.null(density)) { - if (!is.numeric(density) || length(density) != 1) { - stop("Parameter 'density' must be a single numeric value.") + # 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 angle - if (!is.null(angle)) { - if (!is.numeric(angle) || length(angle) != 1) { - stop("Parameter 'angle' 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 col_line - if (!is.null(col_line)) { - if (!.IsColor(col_line)) { - stop("Parameter 'col_line' must be a valid colour identifier.") + # Check hatching_color + if (!is.null(hatching_color)) { + if (!.IsColor(hatching_color)) { + stop("Parameter 'hatching_color' must be a valid colour identifier.") } } - # Check lwd_size - if (!is.null(lwd_size)) { - if (!is.numeric(lwd_size) || length(lwd_size) != 1 || lwd_size <= 0) { - stop("Parameter 'lwd_size' must be a single positive numeric value.") + # 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 crosshatching - if (!is.null(crosshatching)) { - if (!is.logical(crosshatching) || length(crosshatching) != 1) { - stop("Parameter 'crosshatching' must be a single logical value (TRUE or FALSE).") + # 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).") } } @@ -143,10 +146,10 @@ Hatching <- function(mask, lat, lon, data = NULL, density = 10, angle = 45, # Find lon and lat edges x_edges <- get_edges(lon) y_edges <- get_edges(lat) - # Loop through mask - for (i in seq_len(nrow(mask))) { - for (j in seq_len(ncol(mask))) { - if (mask[i, j]) { + # 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] @@ -156,9 +159,11 @@ Hatching <- function(mask, lat, lon, data = NULL, density = 10, angle = 45, 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 = density, angle = angle, border = NA, lwd = lwd_size, col = col_line) - if (crosshatching) { - polygon(xs, ys, density = density, angle = -angle, border = NA, lwd = lwd_size, col = col_line) + 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 c42d0a4..ef1b5b5 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -216,13 +216,14 @@ #' 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 Logical or binary (0/1) array with two named dimensions: -#' c(latitude, longitude).Hatching is applied to grid cells where '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 'mask' and 'data', and automatically transpose 'mask' if the latitude and -#' longitude dimensions appear to be reversed. +#'@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 @@ -313,7 +314,7 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, 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 = NULL, + include_upper_boundary = TRUE, hatching_mask = NULL, hatching_density = 10, hatching_angle = 45, hatching_color = "#252525", hatching_lwd = 0.5, hatching_cross = FALSE, ...) { @@ -877,11 +878,11 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, } } - # Check hatching - if (!is.null(hatching)) { - hatching <- drop(hatching) - if (!is.array(hatching) || any(!names(dim(hatching)) %in% c(lon_dim, lat_dim))) { - stop("Parameter 'hatching' must have two dimensions named as the longitude and latitude dimensions in 'var'.") + # 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'.") } } @@ -1263,13 +1264,14 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # # Adding hatching - # ~~~~~~~~~~~~~~~~ + # ~~~~~~~~~~~~~~~~~ # - if (!is.null(hatching)) { - Hatching(mask = hatching, lat = lat, lon = lon, data = var, - density = hatching_density, angle = hatching_angle, - col_line = hatching_color, lwd_size = hatching_lwd, - crosshatching = hatching_cross) + 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) } # -- GitLab From bee064425d1f1349e4b9a318305268661bc7b9e0 Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Tue, 15 Apr 2025 12:57:11 +0200 Subject: [PATCH 16/17] Run devtools::document() --- man/Hatching.Rd | 79 +++++++++++++++++++++++++++++++++++++++++++++++ man/VizEquiMap.Rd | 51 ++++++++++++++++++++++++------ 2 files changed, 121 insertions(+), 9 deletions(-) create mode 100644 man/Hatching.Rd diff --git a/man/Hatching.Rd b/man/Hatching.Rd new file mode 100644 index 0000000..edfad20 --- /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 bad14ae..efb921b 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 -- GitLab From 62a0ac7e248c710c25c8f30e1b612bcb9735756f Mon Sep 17 00:00:00 2001 From: ARIADNA BATALLA FERRES Date: Tue, 22 Apr 2025 12:12:04 +0200 Subject: [PATCH 17/17] Add hatching_mask check in test-VizEquiMap.R --- tests/testthat/test-VizEquiMap.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/testthat/test-VizEquiMap.R b/tests/testthat/test-VizEquiMap.R index b3e366c..6604f53 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'." + ) + }) -- GitLab