diff --git a/R/color_palette_EGA.R b/R/color_palette_EGA.R index 59fd0348..18751be9 100644 --- a/R/color_palette_EGA.R +++ b/R/color_palette_EGA.R @@ -1,6 +1,6 @@ #' @title \code{\link[EGAnet]{EGA}} Color Palettes #' -#' @description Color palettes for plotting \code{\link[GGally]{ggnet2}} +#' @description Color palettes for plotting \code{\link[GGally]{ggnet2}} #' \code{\link[EGAnet]{EGA}} network plots #' #' @param name Character. @@ -11,14 +11,14 @@ #' \itemize{ #' #' \item \code{"polychrome"} --- Default 40 color palette -#' +#' #' \item \code{"grayscale"} --- "grayscale", "greyscale", or "colorblind" will produce #' plots suitable for publication purposes #' #' \item \code{"blue.ridge1"} --- Palette inspired by the Blue Ridge Mountains #' #' \item \code{"blue.ridge2"} --- Second palette inspired by the Blue Ridge Mountains -#' +#' #' \item \code{"rainbow"} --- Rainbow colors. Default for \code{\link[qgraph]{qgraph}} #' #' \item \code{"rio"} --- Palette inspired by Rio de Janiero, Brazil @@ -33,7 +33,7 @@ #' A vector representing the community (dimension) membership #' of each node in the network. \code{NA} values mean that the node #' was disconnected from the network -#' +#' #' @param sorted Boolean. #' Should colors be sorted by \code{wc}? #' Defaults to \code{FALSE} @@ -51,13 +51,13 @@ #' #' # Custom #' color_palette_EGA(name = c("#7FD1B9", "#24547e"), wc = ega.wmt$wc) -#' +#' #' @seealso \code{\link[EGAnet]{plot.EGAnet}} for plot usage in \code{\link{EGAnet}} #' #' @export -#' +#' # Color palettes for EGA ---- -# Updated 24.10.2023 +# Updated 01.07.2024 color_palette_EGA <- function( name = c( "polychrome", "blue.ridge1", "blue.ridge2", @@ -68,47 +68,47 @@ color_palette_EGA <- function( # Set default for name if(missing(name)){name <- "polychrome"} - + # Get lowercase name lower_name <- tolower(name) - + # Get length of name length_name <- length(name) - + # Grayscale palette if(length_name == 1 && lower_name %in% c("greyscale", "grayscale", "colorblind")){ - name <- "grayscale" + lower_name <- name <- "grayscale" } # Set default for memberships if(missing(wc)){wc <- seq_along(name)} - + # Ensure that memberships are numeric wc <- as.numeric(factor(wc)) # Get length of memberships length_wc <- length(wc) - + # Unique memberships unique_wc <- unique(wc) - + # Get number of communities communities <- length(unique_wc) - anyNA(unique_wc) - + # Send length error length_error(name, c(1, communities, length_wc)) - + # Sort memberships if(isTRUE(sorted)){ wc <- sort(wc, na.last = TRUE) } - + # Determine length of names if(length_name == 1){ - + # Get sequence of memberships sequence_wc <- seq_len(communities) - + # Check if name is in color brewer if(name %in% row.names(RColorBrewer::brewer.pal.info)){ return(silent_call(RColorBrewer::brewer.pal(communities, name)[wc])) @@ -116,9 +116,9 @@ color_palette_EGA <- function( lower_name %in% c( "polychrome", "blue.ridge1", "blue.ridge2", "rainbow", "rio", "itacare", "grayscale" - ) + ) ){ - + # Perform switch on palettes return( switch( @@ -132,21 +132,21 @@ color_palette_EGA <- function( "grayscale" = grayscale(communities) )[wc] ) - + }else{ - + # Return single value for all return(rep(name, length_wc)) - + } - + } - + # Otherwise, ensure hashtags and return name <- cvapply(name, function(x){ swiftelse(substr(x, 1, 1) == "#", x, paste0("#", x)) }) - + # Check for whether colors are same length as memberships return( swiftelse( @@ -162,10 +162,10 @@ color_palette_EGA <- function( # Updated 26.07.2023 polychrome <- function(communities) { - + # Check for total colors if(communities <= 40){ - + # Get {EGAnet} polychrome polychrome <- c( "#F03D2D", "#90DDF0", "#C8D96F", "#ef8a17", "#f5c900", @@ -177,9 +177,9 @@ polychrome <- function(communities) "#a9fbd7", "#d81159", "#8f2d56", "#006ba6", "#39304a", "#ff470a", "#60b6f1", "#fcdebe", "#cff27e", "#b87d4b" ) - + }else{ - + # Get distinct colors from color brewer qual_col_pals <- RColorBrewer::brewer.pal.info[ RColorBrewer::brewer.pal.info$category == "qual", @@ -194,12 +194,12 @@ polychrome <- function(communities) ) ) ) - + } - + # Return polychrome return(polychrome) - + } #' @noRd @@ -208,7 +208,7 @@ polychrome <- function(communities) # Updated 26.07.2023 blue_ridge1 <- function() { - + # Return colors return( c( @@ -216,7 +216,7 @@ blue_ridge1 <- function() "#fdb184", "#fde8a9", "#fdcd9b" ) ) - + } #' @noRd @@ -225,7 +225,7 @@ blue_ridge1 <- function() # Updated 26.07.2023 blue_ridge2 <- function() { - + # Return colors return( blue.ridge2 <- c( @@ -234,7 +234,7 @@ blue_ridge2 <- function() "#e2a187", "#e3ccb5", "#c48480", "#fcac6c" ) ) - + } #' @noRd @@ -242,12 +242,12 @@ blue_ridge2 <- function() # Updated 26.07.2023 rainbow <- function(communities) { - + # Return colors return( grDevices::rainbow(communities) ) - + } #' @noRd @@ -256,7 +256,7 @@ rainbow <- function(communities) # Updated 26.07.2023 rio <- function() { - + # Return colors return( c( @@ -265,7 +265,7 @@ rio <- function() "#ea897c", "#9c8062", "#524954", "#54544c" ) ) - + } #' @noRd @@ -274,7 +274,7 @@ rio <- function() # Updated 26.07.2023 itacare <- function() { - + # Return colors return( c( @@ -283,7 +283,7 @@ itacare <- function() "#8ec0c5", "#a58a60", "#ad9342", "#a96c2e" ) ) - + } #' @noRd @@ -292,7 +292,7 @@ itacare <- function() # Updated 26.07.2023 grayscale <- function(communities) { - + # Grayscale colors colors <- c( "#F0F0F0", "#E9E9E9", "#E1E1E1", "#C2C2C2", @@ -300,17 +300,17 @@ grayscale <- function(communities) "#767676", "#6F6F6F", "#606060", "#565656", "#505050", "#484848", "#454545", "#333333" ) - + # Get distance distance <- round(16 / communities) - + # Check for zero distance if(distance == 0){ distance <- 1 } - + # Return colors return(colors[seq.int(1, 16, distance)]) - + } diff --git a/man/color_palette_EGA.Rd b/man/color_palette_EGA.Rd index 289cecd7..a1cee02d 100644 --- a/man/color_palette_EGA.Rd +++ b/man/color_palette_EGA.Rd @@ -51,7 +51,7 @@ Defaults to \code{FALSE}} Vector of colors for community memberships } \description{ -Color palettes for plotting \code{\link[GGally]{ggnet2}} +Color palettes for plotting \code{\link[GGally]{ggnet2}} \code{\link[EGAnet]{EGA}} network plots } \examples{