From 4ba73e6ae81fa4a280255e0b0b31a18854914c9f Mon Sep 17 00:00:00 2001 From: rCarto Date: Thu, 28 Nov 2024 16:43:13 +0100 Subject: [PATCH] feat: add alpha (transparency) for all types in mf_map() and mf_raster() fix #78 --- R/mf_base.R | 59 +++++++++++++++++++++++++++++++------ R/mf_choro.R | 2 +- R/mf_doc_utils.R | 9 ++---- R/mf_get_pal.R | 21 +++++-------- R/mf_grad.R | 6 ++++ R/mf_map.R | 22 +++++++------- R/mf_map_utils.R | 31 +++++++++++++++++-- R/mf_prop.R | 6 ++++ R/mf_prop_choro.R | 2 +- R/mf_prop_typo.R | 2 +- R/mf_raster.R | 9 ++++-- R/mf_raster_utils.R | 19 ++++++++---- R/mf_symb.R | 2 +- R/mf_symb_choro.R | 2 +- R/mf_typo.R | 2 +- inst/tinytest/test_map.R | 11 +++++++ inst/tinytest/test_raster.R | 20 +++++++++++++ man/mf_base.Rd | 3 ++ man/mf_choro.Rd | 4 +-- man/mf_get_pal.Rd | 22 +++++--------- man/mf_grad.Rd | 3 ++ man/mf_map.Rd | 28 +++++++++--------- man/mf_prop.Rd | 3 ++ man/mf_prop_choro.Rd | 4 +-- man/mf_prop_typo.Rd | 4 +-- man/mf_raster.Rd | 4 +-- man/mf_symb.Rd | 8 ++--- man/mf_symb_choro.Rd | 8 ++--- man/mf_typo.Rd | 4 +-- 29 files changed, 219 insertions(+), 101 deletions(-) diff --git a/R/mf_base.R b/R/mf_base.R index f6a2b44c..bbed189e 100644 --- a/R/mf_base.R +++ b/R/mf_base.R @@ -5,7 +5,9 @@ #' @eval my_params(c( #' 'col', #' 'border', -#' 'lwd', 'pch', +#' 'lwd', +#' 'pch', +#' 'alpha', #' 'add')) #' @param cex point size #' @param bg background color @@ -23,6 +25,7 @@ mf_base <- function(x, col = "grey80", border = "grey20", + alpha = NULL, bg = "white", cex = 1, pch = 20, @@ -40,16 +43,54 @@ mf_base <- function(x, } xtype <- get_geom_type(x) - if (xtype != "POLYGON" && missing(col)) { - col <- "grey20" + + if (xtype == "LINE") { + if (missing(col)) { + col <- "grey20" + } + if (!is.null(alpha)) { + col <- get_hex_pal(col, alpha) + } + plot( + st_geometry(x), + col = col, lwd = lwd, lty = lty, + add = TRUE, ... + ) + } + + if (xtype == "POLYGON") { + if (!is.null(alpha)) { + col <- get_hex_pal(col, alpha) + } + plot( + st_geometry(x), + col = col, border = border, lwd = lwd, lty = lty, + add = TRUE, ... + ) } - plot(st_geometry(x), - col = col, border = border, - lwd = lwd, add = add, pch = pch, - bg = bg, lty = lty, cex = cex, - ... - ) + if (xtype == "POINT") { + if (missing(col)) { + col <- "grey20" + } + if (!is.null(alpha)) { + col <- get_hex_pal(col, alpha) + } + if (pch %in% 21:25) { + if (missing(border)) { + border <- "grey80" + } + mycolspt <- border + } else { + mycolspt <- col + } + mycolsptbg <- col + plot( + st_geometry(x), + col = mycolspt, bg = mycolsptbg, cex = cex, pch = pch, + lwd = lwd, add = TRUE, ... + ) + } return(invisible(x)) } diff --git a/R/mf_choro.R b/R/mf_choro.R index 10ab298f..6e520ec8 100644 --- a/R/mf_choro.R +++ b/R/mf_choro.R @@ -57,7 +57,7 @@ #' ) mf_choro <- function(x, var, pal = "Mint", - alpha = 1, + alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, diff --git a/R/mf_doc_utils.R b/R/mf_doc_utils.R index 596b4ca1..e4f51817 100644 --- a/R/mf_doc_utils.R +++ b/R/mf_doc_utils.R @@ -54,13 +54,10 @@ my_params <- function(x) { "whether the ordering of the colors should be reversed (TRUE)", " or not (FALSE)" ), - alpha = paste0( - "alpha if \\code{pal} is a \\link{hcl.colors} palette name, ", - "the alpha-transparency level in the range [0,1]" - ), + alpha = "alpha opacity, in the range [0,1]", col_na = "col_na color for missing values", - cex_na = "cex_na cex (point size) for NA values", - pch_na = "pch_na pch (point type) for NA values", + cex_na = "cex_na point size for NA values", + pch_na = "pch_na point type for NA values", val_max = "val_max maximum value used for proportional symbols", breaks = paste0( "breaks either a numeric vector with the actual breaks, ", diff --git a/R/mf_get_pal.R b/R/mf_get_pal.R index 0561fd9a..7139c73a 100644 --- a/R/mf_get_pal.R +++ b/R/mf_get_pal.R @@ -4,22 +4,17 @@ #' Diverging color palettes can be dissymmetric (different number of colors in #' each of the two gradients). #' @name mf_get_pal -#' @param n the number of colors (>= 1) to be in the palette. -#' @param palette a valid palette name (one of hcl.pals()). The name is matched -#' to -#' the list of available palettes, ignoring upper vs. lower case, spaces, -#' dashes, -#' etc. in the matching. +#' @param n the number of colors (>= 1) to be in the palette +#' @param palette a valid palette name. See \link{hcl.pals} to get available +#' palette names. The name is matched +#' to the list of available palettes, ignoring upper vs. lower case, spaces, +#' dashes, etc. in the matching. #' @param alpha an alpha-transparency level in the range [0,1] (0 means -#' transparent and 1 means opaque), see argument alpha in hsv and hcl, -#' respectively. +#' transparent and 1 means opaque) #' @param rev logical indicating whether the ordering of the colors should be -#' reversed. +#' reversed #' @param neutral a color, if two gradients are used, the 'neutral' color can be -#' added between them. -#' @details See \link{hcl.pals} to get available palette names. -#' If two gradients are used, the 'neutral' color can be added between them. -#' +#' added between them #' @return A vector of colors. #' @importFrom grDevices hcl.colors #' @export diff --git a/R/mf_grad.R b/R/mf_grad.R index d6d4e161..5dba3129 100644 --- a/R/mf_grad.R +++ b/R/mf_grad.R @@ -9,6 +9,7 @@ #' 'pch', #' 'add' , #' 'col', +#' 'alpha', #' 'leg_pos', #' 'leg_title', #' 'leg_title_cex', @@ -44,6 +45,7 @@ mf_grad <- function(x, breaks = "quantile", nbreaks = 3, col = "tomato4", + alpha = NULL, border = getOption("mapsf.fg"), pch = 21, cex, @@ -67,6 +69,10 @@ mf_grad <- function(x, on.exit(par(op)) xout <- x + if (!is.null(alpha)) { + col <- get_hex_pal(col, alpha) + } + # data prep x <- x[!is.na(x = x[[var]]), ] x <- x[order(x[[var]], decreasing = TRUE), ] diff --git a/R/mf_map.R b/R/mf_map.R index d20b64e8..02063c7e 100644 --- a/R/mf_map.R +++ b/R/mf_map.R @@ -29,16 +29,16 @@ #' ## Relevant arguments and default values for each map types: #' **base**: displays sf objects geometries. #' \preformatted{ -#' mf_map(x, col = "grey80", pch = 20, cex = 1, border = "grey20", lwd = 0.7, -#' expandBB, add = FALSE, ...) +#' mf_map(x, col = "grey80", pch = 20, cex = 1, border = "grey20", +#' lwd = 0.7, alpha = NULL, expandBB, add = FALSE, ...) #' } #' #' **prop**: displays symbols with areas proportional to a quantitative #' variable (stocks). `inches` is used to set symbols sizes. #' \preformatted{ #' mf_map(x, var, type = "prop", inches = 0.3, val_max, symbol = "circle", -#' col = "tomato4", lwd_max = 20, border = getOption("mapsf.fg"), -#' lwd = 0.7, expandBB, add = TRUE, +#' col = "tomato4", alpha = NULL, lwd_max = 20, +#' border = getOption("mapsf.fg"), lwd = 0.7, expandBB, add = TRUE, #' leg_pos = mf_get_leg_pos(x), leg_title = var, #' leg_title_cex = 0.8, leg_val_cex = 0.6, leg_val_rnd = 0, #' leg_frame = FALSE, leg_frame_border = getOption("mapsf.fg"), @@ -54,7 +54,7 @@ #' can use palette names from `hcl.pals()`. #' \preformatted{ #' mf_map(x, var, type = "choro", breaks = "quantile", nbreaks, pal = "Mint", -#' alpha = 1, rev = FALSE, pch = 21, cex = 1, +#' alpha = NULL, rev = FALSE, pch = 21, cex = 1, #' border = getOption("mapsf.fg"), lwd = 0.7, col_na = "white", #' cex_na = 1, pch_na = 4, expandBB, add = FALSE, #' leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, @@ -68,7 +68,7 @@ #' **typo**: displays a typology map of a qualitative variable. #' `val_order` is used to set modalities order in the legend. #' \preformatted{ -#' mf_map(x, var, type = "typo", pal = "Dynamic", alpha = 1, rev = FALSE, +#' mf_map(x, var, type = "typo", pal = "Dynamic", alpha = NULL, rev = FALSE, #' val_order,border = getOption("mapsf.fg"), pch = 21, cex = 1, #' lwd = 0.7, cex_na = 1, pch_na = 4, col_na = "white", #' leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, @@ -82,7 +82,7 @@ #' **symb**: displays the different modalities of a qualitative variable as #' symbols. #' \preformatted{ -#' mf_map(x, var, type = "symb", pal = "Dynamic", alpha = 1, rev = FALSE, +#' mf_map(x, var, type = "symb", pal = "Dynamic", alpha = NULL, rev = FALSE, #' border = getOption("mapsf.fg"), pch, cex = 1, lwd = 0.7, #' col_na = "grey", pch_na = 4, cex_na = 1, val_order, #' leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, @@ -96,7 +96,7 @@ #' `breaks` and `nbreaks`. Symbol sizes are set with `cex`. #' \preformatted{ #' mf_map(x, var, type = "grad", breaks = "quantile", nbreaks = 3, col = "tomato4", -#' border = getOption("mapsf.fg"), pch = 21, cex, lwd, +#' alpha = NULL, border = getOption("mapsf.fg"), pch = 21, cex, lwd, #' leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, #' leg_val_cex = 0.6, leg_val_rnd = 2, leg_frame = FALSE, #' leg_adj = c(0, 0), leg_size = 1, leg_border = border, @@ -110,7 +110,7 @@ #' quantitative variable. #' \preformatted{ #' mf_map(x, var, type = "prop_choro", inches = 0.3, val_max, symbol = "circle", -#' pal = "Mint", alpha = 1, rev = FALSE, breaks = "quantile", nbreaks, +#' pal = "Mint", alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, #' border = getOption("mapsf.fg"), lwd = 0.7, col_na = "white", #' leg_pos = mf_get_leg_pos(x, 1), leg_title = var, #' leg_title_cex = c(0.8, 0.8), leg_val_cex = c(0.6, 0.6), @@ -127,7 +127,7 @@ #' variable. #' \preformatted{ #' mf_map(x, var, type = "prop_typo", inches = 0.3, val_max, symbol = "circle", -#' pal = "Dynamic", alpha = 1, rev = FALSE, val_order, +#' pal = "Dynamic", alpha = NULL, rev = FALSE, val_order, #' border = getOption("mapsf.fg"), lwd = 0.7, lwd_max = 15, #' col_na = "white", #' leg_pos = mf_get_leg_pos(x, 1), leg_title = var, @@ -144,7 +144,7 @@ #' variable as symbols colored to reflect the classification of a second #' quantitative variable. #' \preformatted{ -#' mf_map(x, var, type = "symb_choro", pal = "Mint", alpha = 1, rev = FALSE, +#' mf_map(x, var, type = "symb_choro", pal = "Mint", alpha = NULL, rev = FALSE, #' breaks = "quantile", nbreaks, border = getOption("mapsf.fg"), #' pch, cex = 1, lwd = 0.7, pch_na = 4, cex_na = 1, col_na = "white", #' val_order, diff --git a/R/mf_map_utils.R b/R/mf_map_utils.R index 23b49684..6fca553a 100644 --- a/R/mf_map_utils.R +++ b/R/mf_map_utils.R @@ -5,19 +5,46 @@ #' @param alpha alpha #' @noRd #' @importFrom grDevices hcl.pals hcl.colors -get_the_pal <- function(pal, nbreaks, alpha = 1, rev = TRUE) { +get_the_pal <- function(pal, nbreaks, alpha, rev = TRUE) { if (length(pal) == 1) { if (pal %in% hcl.pals()) { - cols <- hcl.colors(n = nbreaks, palette = pal, alpha = alpha, rev = rev) + cols <- hcl.colors(n = nbreaks, palette = pal, rev = rev) } else { cols <- rep(pal, nbreaks) } } else { cols <- pal[1:nbreaks] } + if (!is.null(alpha)) { + cols <- get_hex_pal(cols, alpha) + } + return(cols) } +get_hex_pal <- function(pal, alpha) { + pal <- grDevices::col2rgb(pal, alpha = FALSE) + ffun <- function(x) { + grDevices::rgb(pal[1, x], + pal[2, x], + pal[3, x], + maxColorValue = 255 + ) + } + paste0(sapply(seq_len(ncol(pal)), ffun), get_alpha(alpha)) +} + +get_alpha <- function(alpha) { + if (alpha < 0) { + alpha <- 0 + } + if (alpha > 1) { + alpha <- 1 + } + sprintf("%02X", as.integer(255.999 * alpha)) +} + + get_col_vec <- function(x, breaks, pal, jen = FALSE) { if (jen) { itv <- apply(array(apply(outer(x, breaks, ">"), 1, sum)), 1, max, 1) diff --git a/R/mf_prop.R b/R/mf_prop.R index 5e858a3a..7b8afa2a 100644 --- a/R/mf_prop.R +++ b/R/mf_prop.R @@ -4,6 +4,7 @@ #' 'x', #' 'var', #' 'col', +#' 'alpha', #' 'border', #' 'lwd', #' 'add' , @@ -48,6 +49,7 @@ mf_prop <- function(x, lwd_max = 20, symbol = "circle", col = "tomato4", + alpha = NULL, border = getOption("mapsf.fg"), lwd = .7, leg_pos = mf_get_leg_pos(x), @@ -67,6 +69,10 @@ mf_prop <- function(x, op <- par(mar = getOption("mapsf.mar"), no.readonly = TRUE) on.exit(par(op)) + if (!is.null(alpha)) { + col <- get_hex_pal(col, alpha) + } + xtype <- get_geom_type(x) # linestring special case if (xtype == "LINE") { diff --git a/R/mf_prop_choro.R b/R/mf_prop_choro.R index 03f60498..09b34b97 100644 --- a/R/mf_prop_choro.R +++ b/R/mf_prop_choro.R @@ -68,7 +68,7 @@ mf_prop_choro <- function(x, val_max, symbol = "circle", pal = "Mint", - alpha = 1, + alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, diff --git a/R/mf_prop_typo.R b/R/mf_prop_typo.R index be80d8d1..eab94c85 100644 --- a/R/mf_prop_typo.R +++ b/R/mf_prop_typo.R @@ -54,7 +54,7 @@ mf_prop_typo <- function(x, var, val_max, symbol = "circle", pal = "Dynamic", - alpha = 1, + alpha = NULL, rev = FALSE, val_order, border = getOption("mapsf.fg"), diff --git a/R/mf_raster.R b/R/mf_raster.R index 3f0d383f..7041c132 100644 --- a/R/mf_raster.R +++ b/R/mf_raster.R @@ -84,7 +84,7 @@ mf_raster <- function(x, val_order, pal, expandBB = rep(0, 4), - alpha = 1, + alpha = NULL, rev = FALSE, leg_pos = "right", leg_title = names(x), @@ -102,6 +102,9 @@ mf_raster <- function(x, leg_size = 1, add = FALSE, ...) { + op <- par(xpd = TRUE, no.readonly = TRUE) + on.exit(par(op)) + # test for terra if (!requireNamespace("terra", quietly = TRUE)) { stop(paste0( @@ -126,6 +129,7 @@ mf_raster <- function(x, ops$axes <- FALSE ops$box <- FALSE ops$mar <- NA + ops$alpha <- alpha # Multiband Raster if (terra::nlyr(x) >= 2) { @@ -152,8 +156,7 @@ mf_raster <- function(x, if (ops$type == "interval") { mf_raster_interval( - ops, ops_leg, pal, breaks, nbreaks, alpha, rev, add, - expandBB + ops, ops_leg, pal, breaks, nbreaks, alpha, rev, add, expandBB ) } diff --git a/R/mf_raster_utils.R b/R/mf_raster_utils.R index 0371898e..390b440a 100644 --- a/R/mf_raster_utils.R +++ b/R/mf_raster_utils.R @@ -1,18 +1,21 @@ -get_the_raster_pal <- function(pal, nbreaks, alpha = 1, rev = TRUE) { +get_the_raster_pal <- function(pal, nbreaks, alpha, rev = TRUE) { if (length(pal) == 1) { if (pal %in% hcl.pals()) { - cols <- hcl.colors(n = nbreaks, palette = pal, alpha = alpha, rev = rev) + cols <- hcl.colors(n = nbreaks, palette = pal, rev = rev) } else { stop("This is not a palette name", call. = FALSE) } } else { cols <- colorRampPalette(pal, alpha = TRUE)(nbreaks) } + if (!is.null(alpha)) { + cols <- get_hex_pal(cols, alpha) + } return(cols) } -get_continuous_pal <- function(breaks, pal) { +get_continuous_pal <- function(breaks, pal, alpha) { # get a palette repartitionthat match classes size etendu <- max(breaks) - min(breaks) lb <- length(breaks) @@ -23,9 +26,12 @@ get_continuous_pal <- function(breaks, pal) { dd$colto <- pal[2:lb] l <- list() for (i in 1:(lb - 1)) { - l[[i]] <- colorRampPalette(c(dd$colfrom[i], dd$colto[i]))(dd$ncol[i]) + l[[i]] <- colorRampPalette(c(dd$colfrom[i], dd$colto[i]), alpha = TRUE)(dd$ncol[i]) } p <- do.call(c, l) + if (!is.null(alpha)) { + p <- get_hex_pal(p, alpha) + } p } @@ -57,6 +63,7 @@ mf_raster_interval <- function(ops, ops_leg, pal, breaks, nbreaks, alpha, if (add == FALSE) { mf_init(ops$x, expandBB = expandBB) } + ops$alpha <- NULL # plot do.call(terra::plot, ops) # legend @@ -96,7 +103,7 @@ mf_raster_continuous <- function(ops, ops_leg, breaks, pal, expandBB, add, if (length(pal) != (lb)) { stop(paste0("'pal' should be a vector of ", lb, " colors"), call. = FALSE) } - pal <- get_continuous_pal(breaks, pal) + pal <- get_continuous_pal(breaks, pal, alpha) p_pal <- pal # this for vmin superior to lmin or/and vmax inferior to lmax # other cases are missing @@ -147,6 +154,7 @@ mf_raster_continuous <- function(ops, ops_leg, breaks, pal, expandBB, add, mf_init(ops$x, expandBB = expandBB) } + ops$alpha <- NULL do.call(terra::plot, ops) leg( @@ -203,6 +211,7 @@ mf_raster_classes <- function(ops, ops_leg, pal, val_order, expandBB, if (add == FALSE) { mf_init(ops$x, expandBB = expandBB) } + ops$alpha <- NULL do.call(terra::plot, ops) leg( diff --git a/R/mf_symb.R b/R/mf_symb.R index 2d1a0f2d..b301fa29 100644 --- a/R/mf_symb.R +++ b/R/mf_symb.R @@ -47,7 +47,7 @@ #' ) mf_symb <- function(x, var, pal = "Dynamic", - alpha = 1, + alpha = NULL, rev = FALSE, border = getOption("mapsf.fg"), pch, diff --git a/R/mf_symb_choro.R b/R/mf_symb_choro.R index 37d7070d..a132da11 100644 --- a/R/mf_symb_choro.R +++ b/R/mf_symb_choro.R @@ -65,7 +65,7 @@ #' ) mf_symb_choro <- function(x, var, pal = "Mint", - alpha = 1, + alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, diff --git a/R/mf_typo.R b/R/mf_typo.R index dc2a1623..b52e17bb 100644 --- a/R/mf_typo.R +++ b/R/mf_typo.R @@ -48,7 +48,7 @@ mf_typo <- function(x, var, pal = "Dynamic", - alpha = 1, + alpha = NULL, rev = FALSE, val_order, border = getOption("mapsf.fg"), diff --git a/inst/tinytest/test_map.R b/inst/tinytest/test_map.R index 44881e16..40057d57 100644 --- a/inst/tinytest/test_map.R +++ b/inst/tinytest/test_map.R @@ -15,3 +15,14 @@ expect_error(mf_map("not an sf object")) expect_error(mf_map(st_geometry(mtq), "POP", "prop")) expect_message(mf_map(mtq, "POP", "prop", breaks = "q6")) expect_message(mf_map(mtq, "POP", "prop", breaks = "q6", nbreaks = 8)) + + +# test for alpha +expect_silent(mf_map(mtq, var = "POP", type = "prop", alpha = .2)) +expect_silent(mf_map(mtq, var = "MED", type = "choro", alpha = .2)) +expect_silent(mf_map(mtq, var = "STATUS", type = "typo", alpha = .2)) +expect_silent(mf_map(mtq, var = "STATUS", type = "symb", alpha = .2)) +expect_silent(mf_map(mtq, var = "POP", type = "grad", alpha = .2)) +expect_silent(mf_map(mtq, var = c("POP", "MED"), type = "prop_choro", alpha = .2)) +expect_silent(mf_map(mtq, var = c("POP", "STATUS"), type = "prop_typo", alpha = .2)) +expect_silent(mf_map(mtq, var = c("STATUS", "MED"), type = "symb_choro", alpha = .2)) diff --git a/inst/tinytest/test_raster.R b/inst/tinytest/test_raster.R index 42b38c20..721a3e04 100644 --- a/inst/tinytest/test_raster.R +++ b/inst/tinytest/test_raster.R @@ -42,3 +42,23 @@ expect_silent(mf_raster(d, "classes")) expect_silent(mf_raster(d, "classes", pal = "Burg", val_order = rev(c("low", "high", "super high")))) expect_silent(mf_raster(a, "classes", pal = "Burg")) + + +# alpha +expect_silent(mf_raster(d, "classes", alpha = .5, pal = 1:3)) +expect_silent(mf_raster(a, alpha = .5, pal = 1:2)) +expect_silent(mf_raster(a, "interval", alpha = .4, nbreaks = 4, pal = 1:4)) + +expect_silent(mf_raster(d, "classes", alpha = .5, pal = "Viridis")) +expect_silent(mf_raster(a, alpha = .5, pal = "Viridis")) +expect_silent(mf_raster(a, "interval", alpha = .4, nbreaks = 4, + pal = "Viridis")) + +expect_silent(mf_raster(d, "classes", pal = hcl.colors(3, "Viridis", + alpha = .5))) +expect_silent(mf_raster(a, pal = hcl.colors(12, "Viridis", alpha = .5))) +expect_silent(mf_raster(a, "interval", nbreaks = 12, + pal = hcl.colors(12, "Viridis", alpha = .5))) + + + diff --git a/man/mf_base.Rd b/man/mf_base.Rd index 2c523c9c..7ff3ceb2 100644 --- a/man/mf_base.Rd +++ b/man/mf_base.Rd @@ -8,6 +8,7 @@ mf_base( x, col = "grey80", border = "grey20", + alpha = NULL, bg = "white", cex = 1, pch = 20, @@ -24,6 +25,8 @@ mf_base( \item{border}{border color} +\item{alpha}{opacity, in the range [0,1]} + \item{bg}{background color} \item{cex}{point size} diff --git a/man/mf_choro.Rd b/man/mf_choro.Rd index 5087882e..66ddcbf0 100644 --- a/man/mf_choro.Rd +++ b/man/mf_choro.Rd @@ -8,7 +8,7 @@ mf_choro( x, var, pal = "Mint", - alpha = 1, + alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, @@ -44,7 +44,7 @@ mf_choro( \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} diff --git a/man/mf_get_pal.Rd b/man/mf_get_pal.Rd index ede6e343..9d401144 100644 --- a/man/mf_get_pal.Rd +++ b/man/mf_get_pal.Rd @@ -7,23 +7,21 @@ mf_get_pal(n, palette, alpha = NULL, rev = c(FALSE, FALSE), neutral) } \arguments{ -\item{n}{the number of colors (>= 1) to be in the palette.} +\item{n}{the number of colors (>= 1) to be in the palette} -\item{palette}{a valid palette name (one of hcl.pals()). The name is matched -to -the list of available palettes, ignoring upper vs. lower case, spaces, -dashes, -etc. in the matching.} +\item{palette}{a valid palette name. See \link{hcl.pals} to get available +palette names. The name is matched +to the list of available palettes, ignoring upper vs. lower case, spaces, +dashes, etc. in the matching.} \item{alpha}{an alpha-transparency level in the range [0,1] (0 means -transparent and 1 means opaque), see argument alpha in hsv and hcl, -respectively.} +transparent and 1 means opaque)} \item{rev}{logical indicating whether the ordering of the colors should be -reversed.} +reversed} \item{neutral}{a color, if two gradients are used, the 'neutral' color can be -added between them.} +added between them} } \value{ A vector of colors. @@ -34,10 +32,6 @@ qualitative color palettes. Diverging color palettes can be dissymmetric (different number of colors in each of the two gradients). } -\details{ -See \link{hcl.pals} to get available palette names. -If two gradients are used, the 'neutral' color can be added between them. -} \examples{ cols <- mf_get_pal(n = 10, pal = "Reds 2") plot(1:10, rep(1, 10), bg = cols, pch = 22, cex = 4) diff --git a/man/mf_grad.Rd b/man/mf_grad.Rd index 85adaa82..05378d99 100644 --- a/man/mf_grad.Rd +++ b/man/mf_grad.Rd @@ -10,6 +10,7 @@ mf_grad( breaks = "quantile", nbreaks = 3, col = "tomato4", + alpha = NULL, border = getOption("mapsf.fg"), pch = 21, cex, @@ -41,6 +42,8 @@ mf_grad( \item{col}{color} +\item{alpha}{opacity, in the range [0,1]} + \item{border}{border color} \item{pch}{pch (point type) for symbols} diff --git a/man/mf_map.Rd b/man/mf_map.Rd index a6deec6c..6402adf9 100644 --- a/man/mf_map.Rd +++ b/man/mf_map.Rd @@ -38,7 +38,7 @@ a quantitative data classification \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} @@ -64,9 +64,9 @@ a quantitative data classification \item{col_na}{color for missing values} -\item{cex_na}{cex (point size) for NA values} +\item{cex_na}{point size for NA values} -\item{pch_na}{pch (point type) for NA values} +\item{pch_na}{point type for NA values} \item{expandBB}{fractional values to expand the bounding box with, in each direction (bottom, left, top, right)} @@ -131,16 +131,16 @@ described in the "Details" section. \strong{base}: displays sf objects geometries. \preformatted{ -mf_map(x, col = "grey80", pch = 20, cex = 1, border = "grey20", lwd = 0.7, - expandBB, add = FALSE, ...) +mf_map(x, col = "grey80", pch = 20, cex = 1, border = "grey20", + lwd = 0.7, alpha = NULL, expandBB, add = FALSE, ...) } \strong{prop}: displays symbols with areas proportional to a quantitative variable (stocks). \code{inches} is used to set symbols sizes. \preformatted{ mf_map(x, var, type = "prop", inches = 0.3, val_max, symbol = "circle", - col = "tomato4", lwd_max = 20, border = getOption("mapsf.fg"), - lwd = 0.7, expandBB, add = TRUE, + col = "tomato4", alpha = NULL, lwd_max = 20, + border = getOption("mapsf.fg"), lwd = 0.7, expandBB, add = TRUE, leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, leg_val_cex = 0.6, leg_val_rnd = 0, leg_frame = FALSE, leg_frame_border = getOption("mapsf.fg"), @@ -156,7 +156,7 @@ Colors palettes, defined with \code{pal}, can be created with \code{mf_get_pal() can use palette names from \code{hcl.pals()}. \preformatted{ mf_map(x, var, type = "choro", breaks = "quantile", nbreaks, pal = "Mint", - alpha = 1, rev = FALSE, pch = 21, cex = 1, + alpha = NULL, rev = FALSE, pch = 21, cex = 1, border = getOption("mapsf.fg"), lwd = 0.7, col_na = "white", cex_na = 1, pch_na = 4, expandBB, add = FALSE, leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, @@ -170,7 +170,7 @@ mf_map(x, var, type = "choro", breaks = "quantile", nbreaks, pal = "Mint", \strong{typo}: displays a typology map of a qualitative variable. \code{val_order} is used to set modalities order in the legend. \preformatted{ -mf_map(x, var, type = "typo", pal = "Dynamic", alpha = 1, rev = FALSE, +mf_map(x, var, type = "typo", pal = "Dynamic", alpha = NULL, rev = FALSE, val_order,border = getOption("mapsf.fg"), pch = 21, cex = 1, lwd = 0.7, cex_na = 1, pch_na = 4, col_na = "white", leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, @@ -184,7 +184,7 @@ mf_map(x, var, type = "typo", pal = "Dynamic", alpha = 1, rev = FALSE, \strong{symb}: displays the different modalities of a qualitative variable as symbols. \preformatted{ -mf_map(x, var, type = "symb", pal = "Dynamic", alpha = 1, rev = FALSE, +mf_map(x, var, type = "symb", pal = "Dynamic", alpha = NULL, rev = FALSE, border = getOption("mapsf.fg"), pch, cex = 1, lwd = 0.7, col_na = "grey", pch_na = 4, cex_na = 1, val_order, leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, @@ -198,7 +198,7 @@ mf_map(x, var, type = "symb", pal = "Dynamic", alpha = 1, rev = FALSE, \code{breaks} and \code{nbreaks}. Symbol sizes are set with \code{cex}. \preformatted{ mf_map(x, var, type = "grad", breaks = "quantile", nbreaks = 3, col = "tomato4", - border = getOption("mapsf.fg"), pch = 21, cex, lwd, + alpha = NULL, border = getOption("mapsf.fg"), pch = 21, cex, lwd, leg_pos = mf_get_leg_pos(x), leg_title = var, leg_title_cex = 0.8, leg_val_cex = 0.6, leg_val_rnd = 2, leg_frame = FALSE, leg_adj = c(0, 0), leg_size = 1, leg_border = border, @@ -212,7 +212,7 @@ first variable and colored to reflect the classification of a second quantitative variable. \preformatted{ mf_map(x, var, type = "prop_choro", inches = 0.3, val_max, symbol = "circle", - pal = "Mint", alpha = 1, rev = FALSE, breaks = "quantile", nbreaks, + pal = "Mint", alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, border = getOption("mapsf.fg"), lwd = 0.7, col_na = "white", leg_pos = mf_get_leg_pos(x, 1), leg_title = var, leg_title_cex = c(0.8, 0.8), leg_val_cex = c(0.6, 0.6), @@ -229,7 +229,7 @@ first variable and colored to reflect the modalities of a second qualitative variable. \preformatted{ mf_map(x, var, type = "prop_typo", inches = 0.3, val_max, symbol = "circle", - pal = "Dynamic", alpha = 1, rev = FALSE, val_order, + pal = "Dynamic", alpha = NULL, rev = FALSE, val_order, border = getOption("mapsf.fg"), lwd = 0.7, lwd_max = 15, col_na = "white", leg_pos = mf_get_leg_pos(x, 1), leg_title = var, @@ -246,7 +246,7 @@ mf_map(x, var, type = "prop_typo", inches = 0.3, val_max, symbol = "circle", variable as symbols colored to reflect the classification of a second quantitative variable. \preformatted{ -mf_map(x, var, type = "symb_choro", pal = "Mint", alpha = 1, rev = FALSE, +mf_map(x, var, type = "symb_choro", pal = "Mint", alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, border = getOption("mapsf.fg"), pch, cex = 1, lwd = 0.7, pch_na = 4, cex_na = 1, col_na = "white", val_order, diff --git a/man/mf_prop.Rd b/man/mf_prop.Rd index 55dffd07..258daa73 100644 --- a/man/mf_prop.Rd +++ b/man/mf_prop.Rd @@ -12,6 +12,7 @@ mf_prop( lwd_max = 20, symbol = "circle", col = "tomato4", + alpha = NULL, border = getOption("mapsf.fg"), lwd = 0.7, leg_pos = mf_get_leg_pos(x), @@ -44,6 +45,8 @@ mf_prop( \item{col}{color} +\item{alpha}{opacity, in the range [0,1]} + \item{border}{border color} \item{lwd}{border width} diff --git a/man/mf_prop_choro.Rd b/man/mf_prop_choro.Rd index b5d954c9..216992e8 100644 --- a/man/mf_prop_choro.Rd +++ b/man/mf_prop_choro.Rd @@ -11,7 +11,7 @@ mf_prop_choro( val_max, symbol = "circle", pal = "Mint", - alpha = 1, + alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, @@ -49,7 +49,7 @@ mf_prop_choro( \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} diff --git a/man/mf_prop_typo.Rd b/man/mf_prop_typo.Rd index 0a50298f..9fb4f493 100644 --- a/man/mf_prop_typo.Rd +++ b/man/mf_prop_typo.Rd @@ -11,7 +11,7 @@ mf_prop_typo( val_max, symbol = "circle", pal = "Dynamic", - alpha = 1, + alpha = NULL, rev = FALSE, val_order, border = getOption("mapsf.fg"), @@ -49,7 +49,7 @@ mf_prop_typo( \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} diff --git a/man/mf_raster.Rd b/man/mf_raster.Rd index c78a096d..66f38afb 100644 --- a/man/mf_raster.Rd +++ b/man/mf_raster.Rd @@ -12,7 +12,7 @@ mf_raster( val_order, pal, expandBB = rep(0, 4), - alpha = 1, + alpha = NULL, rev = FALSE, leg_pos = "right", leg_title = names(x), @@ -53,7 +53,7 @@ see \link{mf_get_breaks} for classification methods)} \item{expandBB}{fractional values to expand the bounding box with, in each direction (bottom, left, top, right)} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} diff --git a/man/mf_symb.Rd b/man/mf_symb.Rd index d13f0883..d11dffa4 100644 --- a/man/mf_symb.Rd +++ b/man/mf_symb.Rd @@ -8,7 +8,7 @@ mf_symb( x, var, pal = "Dynamic", - alpha = 1, + alpha = NULL, rev = FALSE, border = getOption("mapsf.fg"), pch, @@ -40,7 +40,7 @@ mf_symb( \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} @@ -54,9 +54,9 @@ mf_symb( \item{col_na}{color for missing values} -\item{pch_na}{pch (point type) for NA values} +\item{pch_na}{point type for NA values} -\item{cex_na}{cex (point size) for NA values} +\item{cex_na}{point size for NA values} \item{val_order}{values order, a character vector that matches var modalities} diff --git a/man/mf_symb_choro.Rd b/man/mf_symb_choro.Rd index 01beebec..8edc128f 100644 --- a/man/mf_symb_choro.Rd +++ b/man/mf_symb_choro.Rd @@ -8,7 +8,7 @@ mf_symb_choro( x, var, pal = "Mint", - alpha = 1, + alpha = NULL, rev = FALSE, breaks = "quantile", nbreaks, @@ -45,7 +45,7 @@ mf_symb_choro( \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)} @@ -61,9 +61,9 @@ mf_symb_choro( \item{lwd}{border width} -\item{pch_na}{pch (point type) for NA values} +\item{pch_na}{point type for NA values} -\item{cex_na}{cex (point size) for NA values} +\item{cex_na}{point size for NA values} \item{col_na}{color for missing values} diff --git a/man/mf_typo.Rd b/man/mf_typo.Rd index 5908ed12..b96b5284 100644 --- a/man/mf_typo.Rd +++ b/man/mf_typo.Rd @@ -8,7 +8,7 @@ mf_typo( x, var, pal = "Dynamic", - alpha = 1, + alpha = NULL, rev = FALSE, val_order, border = getOption("mapsf.fg"), @@ -41,7 +41,7 @@ mf_typo( \item{pal}{a set of colors or a palette name (from \link{hcl.colors})} -\item{alpha}{if \code{pal} is a \link{hcl.colors} palette name, the alpha-transparency level in the range [0,1]} +\item{alpha}{opacity, in the range [0,1]} \item{rev}{if \code{pal} is a \link{hcl.colors} palette name, whether the ordering of the colors should be reversed (TRUE) or not (FALSE)}