diff --git a/R/ColorBarContinuous.R b/R/ColorBarContinuous.R index cf6c51cf7a30fdffce3b820a8b815c98d2d3baec..b7727ba05c7e197a1392f87c4eb25e40503f2bc3 100644 --- a/R/ColorBarContinuous.R +++ b/R/ColorBarContinuous.R @@ -248,8 +248,8 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, if (head(brks, 1) != bar_limits[1] || tail(brks, 1) != bar_limits[2]) { stop("Parameters 'brks' and 'bar_limits' are inconsistent.") } - } - + } + # Check col_inf if (!is.null(col_inf)) { if (!.IsColor(col_inf)) { @@ -291,8 +291,8 @@ ColorBarContinuous <- function(brks = NULL, cols = NULL, vertical = TRUE, } } if (plot && !is.null(var_limits)) { - if ((bar_limits[1] >= var_limits[1]) && !triangle_ends[1]) { - warning("There are variable values smaller or equal to the lower limit ", + if ((bar_limits[1] > var_limits[1]) && !triangle_ends[1]) { + warning("There are variable values smaller than the lower limit ", "of the colour bar and the lower triangle end has been ", "disabled. These will be painted in the colour for NA values.") } diff --git a/R/VizEquiMap.R b/R/VizEquiMap.R index 9a49cbc8419042bf16238689504cc3199361944b..54f97c2459e91c203e26525974b64efe892e923c 100644 --- a/R/VizEquiMap.R +++ b/R/VizEquiMap.R @@ -199,6 +199,10 @@ #' the corresponding device. #'@param res Resolution of the device (file or window) to plot in. See #' ?Devices and the creator function of the corresponding device. +#'@param include_lower_boundary Logical value indicating whether to include +#' 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 \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 @@ -272,7 +276,8 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, fileout = NULL, width = 8, height = 5, size_units = 'in', - res = 100, ...) { + res = 100, include_lower_boundary = TRUE, + include_upper_boundary = TRUE, ...) { # 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") @@ -513,6 +518,14 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, title_scale <- sizetit } + # Check include_lower_boundary and include_upper_boundary + if (!is.null(include_lower_boundary) && (!is.logical(include_lower_boundary) || length(include_lower_boundary) != 1)) { + stop("Parameter 'include_lower_boundary' must be a logical element.") + } + if (!is.null(include_upper_boundary) && (!is.logical(include_upper_boundary) || length(include_upper_boundary) != 1)) { + stop("Parameter 'include_upper_boundary' must be a logical element.") + } + tmp <- .create_var_limits(data = var, brks = brks, bar_limits = bar_limits, drawleg = drawleg) var_limits <- tmp$var_limits @@ -536,6 +549,16 @@ VizEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, col_sup <- colorbar$col_sup bar_limits <- c(head(brks, 1), tail(brks, 1)) + # Adjust 'var' values according to 'include_lower_boundary' and 'include_upper_boundary'. + # This adjustment ensures that, by default, values at the lower limit of the color bars ('brks[1]') are included. + # Refer to issue #15 in the esviz GitLab for more details. + if (include_lower_boundary) { + var[var == head(brks, 1)] <- head(brks, 1) + head(diff(brks), 1)/10 + } + if (!include_upper_boundary) { + var[var == tail(brks, 1)] <- tail(brks, 1) + tail(diff(brks), 1)/10 + } + # Check colNA if (is.null(colNA)) { if ('na_color' %in% names(attributes(cols))) { diff --git a/man/VizEquiMap.Rd b/man/VizEquiMap.Rd index b342fc397f58f6230fd55f82837bfc30e54a45cd..15a8fa5b203b36c0a36c1ffb5df64f9915b95d86 100644 --- a/man/VizEquiMap.Rd +++ b/man/VizEquiMap.Rd @@ -82,6 +82,8 @@ VizEquiMap( height = 5, size_units = "in", res = 100, + include_lower_boundary = TRUE, + include_upper_boundary = TRUE, ... ) } @@ -339,6 +341,12 @@ 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 +the minimum value of the field. Takes TRUE by default.} + +\item{include_upper_boundary}{Logical value indicating whether to include +the maximum value of the field. Takes TRUE by default.} + \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/_snaps/VizEquiMap/VizEquiMap_1a.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1a.png new file mode 100644 index 0000000000000000000000000000000000000000..e078157e995e3318c2e5c2da059e8616b48c4a26 Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1a.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1b.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1b.png new file mode 100644 index 0000000000000000000000000000000000000000..3f13ed528f1f16c2de9d3af96f658743bc644f0a Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1b.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1c.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1c.png new file mode 100644 index 0000000000000000000000000000000000000000..b9fd74d25c915e95289e6ddccc7b19af2f67b2d5 Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1c.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1d.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1d.png new file mode 100644 index 0000000000000000000000000000000000000000..797be6024406dc83003f49719f997c78e9ef6a3d Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_1d.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_bar_label_scale.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_bar_label_scale.png new file mode 100644 index 0000000000000000000000000000000000000000..bffd8966497f5027238ebbdbe95c8f08121ab0f8 Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_bar_label_scale.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_filled.continents.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_filled.continents.png new file mode 100644 index 0000000000000000000000000000000000000000..d94a190fe3586968f3447a85d88598d197267fd5 Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_filled.continents.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_margin_scale.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_margin_scale.png new file mode 100644 index 0000000000000000000000000000000000000000..1e881d21aeecbb6b8ae91fc21204cf386534ccbb Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_margin_scale.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_title_scale.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_title_scale.png new file mode 100644 index 0000000000000000000000000000000000000000..592a006e067fe75b7a9a414f92adb1159b1d3b53 Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_title_scale.png differ diff --git a/tests/testthat/_snaps/VizEquiMap/VizEquiMap_triangle_ends.png b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_triangle_ends.png new file mode 100644 index 0000000000000000000000000000000000000000..7b67a2d4cf2445babcca828a29f036d891a22c07 Binary files /dev/null and b/tests/testthat/_snaps/VizEquiMap/VizEquiMap_triangle_ends.png differ diff --git a/tests/testthat/test-VizEquiMap.R b/tests/testthat/test-VizEquiMap.R new file mode 100644 index 0000000000000000000000000000000000000000..6cedf4834ee45810a5f02f7482d69cffc30bfe03 --- /dev/null +++ b/tests/testthat/test-VizEquiMap.R @@ -0,0 +1,372 @@ + +#=============================================================== +# data +#=============================================================== + + +# data1 +set.seed(0) +data1 <- array(rep(0:10, each = 120),dim = c(lat = 30, lon = 44)) +lons1 <- -10:33 +lats1 <- 31:60 +cols_white_red1 <- s2dv::clim.palette("bluered")(41)[21:41] + + + +#=============================================================== +# tests +#=============================================================== + + +test_that("1. Input checks", { + + # Check lon, lat + expect_error( + VizEquiMap(lon = c()), + "Parameters 'lon' and 'lat' must be numeric vectors." + ) + expect_error( + VizEquiMap(lon = lons1, lat = c()), + "Parameters 'lon' and 'lat' must be numeric vectors." + ) + + # Check var + expect_error( + VizEquiMap(var = NULL, lon = lons1, lat = lats1), + "Parameter 'var' cannot be NULL." + ) + + # Check varu and varv + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, varu = "test1"), + "Only one of the components 'varu' or 'varv' has been provided. Both must be provided." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, varu = "test1", varv = "test2"), + "Parameter 'varu' must be a numerical array with two dimensions." + ) + + # Check contours + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, contours = "test"), + "Parameter 'contours' must be a numerical array with two dimensions." + ) + + # Check toptitle + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, toptitle = 1), + "Parameter 'toptitle' must be a character string." + ) + + # Check include_lower_boundary and include_upper_boundary + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, include_lower_boundary = 1), + "Parameter 'include_lower_boundary' must be a logical element." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, include_upper_boundary = 1), + "Parameter 'include_upper_boundary' must be a logical element." + ) + + # Check colNA + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, colNA = "test"), + "Parameter 'colNA' must be a valid colour identifier." + ) + + # Check square + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, square = "test"), + "Parameter 'square' must be logical." + ) + + # Check filled.continents + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, filled.continents = "test"), + "Parameter 'filled.continents' must be logical or a colour identifier." + ) + + # Check filled.oceans + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, filled.oceans = "test"), + "Parameter 'filled.oceans' must be logical or a colour identifier." + ) + + # Check country.borders + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, country.borders = "test"), + "Parameter 'country.borders' must be logical." + ) + + # Check coast_color + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, coast_color = "test"), + "Parameter 'coast_color' must be a valid colour identifier." + ) + + # Check coast_width + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, coast_width = "test"), + "Parameter 'coast_width' must be numeric." + ) + + # Check lake_color + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, lake_color = "test"), + "Parameter 'lake_color' must be a valid colour identifier." + ) + + # Check shapefile + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile = list()), + "The list names of the object in 'shapefile' .rds file should have at least 'x' and 'y'." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile = 1), + "Parameter 'shapefile' must be a .rds file or a list." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile = "test"), + "Parameter 'shapefile' is not a valid file." + ) + + # Check shapefile_col + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, shapefile_color = "test"), + "Parameter 'shapefile_color' must be a valid colour identifier." + ) + + # Check contour_lwd + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_lwd = "test"), + "Parameter 'contour_lwd' must be numeric." + ) + + # Check contour_color + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_color = "test"), + "Parameter 'contour_color' must be a valid colour identifier." + ) + + # Check contour_lty + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_lty = c()), + "Parameter 'contour_lty' must be either a number or a character string." + ) + + # Check contour_draw_label + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_draw_label = "test"), + "Parameter 'contour_draw_label' must be logical." + ) + + # Check contour_label_scale + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, contour_label_scale = "test"), + "Parameter 'contour_label_scale' must be numeric." + ) + + # Check dots + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, dots = "test"), + "Parameter 'dots' must be a logical array with two or three dimensions." + ) + + # Check arrow parameters + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_subsamp = "test"), + "Parameter 'arr_subsamp' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale = "test"), + "Parameter 'arr_scale' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_ref_len = "test"), + "Parameter 'arr_ref_len' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_units = 1), + "Parameter 'arr_units' must be character." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale_shaft = "test"), + "Parameter 'arr_scale_shaft' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale_shaft_angle = "test"), + "Parameter 'arr_scale_shaft_angle' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, arr_scale_shaft_angle = "test"), + "Parameter 'arr_scale_shaft_angle' must be numeric." + ) + + # Check axis parameters + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, axelab = "test"), + "Parameter 'axelab' must be logical." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, labW = "test"), + "Parameter 'labW' must be logical." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, lab_dist_x = "test"), + "Parameter 'lab_dist_x' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, lab_dist_y = "test"), + "Parameter 'lab_dist_y' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, intylat = "test"), + "Parameter 'intylat' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, intxlon = "test"), + "Parameter 'intxlon' must be numeric." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, xlonshft = "test"), + "Parameter 'xlonshft' must be a number." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, ylatshft = "test"), + "Parameter 'ylatshft' must be a number." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, xlabels = 1), + "Parameter 'xlabels' must be a vector of character string." + ) + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, ylabels = 1), + "Parameter 'ylabels' must be a vector of character string." + ) + + # Check legend parameters + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, drawleg = "test"), + "Parameter 'drawleg' must be logical." + ) + + # Check margin_scale + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, margin_scale = "test"), + "Parameter 'margin_scale' must be a numeric vector of length 4." + ) + + # Check title_scale + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, title_scale = "test"), + "Parameter 'title_scale' must be numeric." + ) + + # Check axes_tick_scale + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, axes_tick_scale = "test"), + "Parameter 'axes_tick_scale' must be numeric." + ) + + # Check axes_label_scale + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, axes_label_scale = "test"), + "Parameter 'axes_label_scale' must be numeric." + ) + + # Check numbfig + expect_error( + VizEquiMap(var = data1, lon = lons1, lat = lats1, numbfig = "test"), + "Parameter 'numbfig' must be numeric." + ) + +}) + + +#---------------------------------------------------------------- + + +save_fun <- function(...) { + path <- tempfile(fileext = ".png") + do.call(VizEquiMap, list(..., fileout = path)) + path +} + + +test_that("2. Output checks", { + + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F)), + name = 'VizEquiMap_1a.png' + ) + + # check include_lower_boundary and include_upper_boundary + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), + include_lower_boundary = FALSE), + name = 'VizEquiMap_1b.png' + ) + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), + include_upper_boundary = FALSE), + name = 'VizEquiMap_1c.png' + ) + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), + include_lower_boundary = FALSE, include_upper_boundary = FALSE), + name = 'VizEquiMap_1d.png' + ) + + # check triangle_ends + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(1, 9), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(T, T), + col_inf = "lightblue", col_sup = "lightblue"), + name = 'VizEquiMap_triangle_ends.png' + ) + + # check filled.continents + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = T, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F)), + name = 'VizEquiMap_filled.continents.png' + ) + + # check title_scale + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), + title_scale = 0.5), + name = 'VizEquiMap_title_scale.png' + ) + + # check bar_label_scale + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), + bar_label_scale = 0.5), + name = 'VizEquiMap_bar_label_scale.png' + ) + + # check margin_scale + expect_snapshot_file( + save_fun(var = data1, lon = lons1, lat = lats1, filled.continents = F, + bar_limits = c(0, 10), toptitle = "plot 1", + cols = cols_white_red1, colNA = "grey", triangle_ends = c(F, F), + margin_scale = rep(10, 4)), + name = 'VizEquiMap_margin_scale.png' + ) + +})