From 039e56c6efb87e72a8c50518cbdf5d1447e41f84 Mon Sep 17 00:00:00 2001 From: Ryan Sheridan Date: Fri, 27 Sep 2024 17:32:29 -0600 Subject: [PATCH] update resize_colors + bug fix --- R/compare-colors.R | 1 + R/resize-colors.R | 80 ++++++++++++++++++++++++++++++++++++------ R/scale-spruce.R | 2 +- R/spruce-colors.R | 41 +++++++++++++++------- man/collapse_colors.Rd | 26 +++++++++++++- man/get_property.Rd | 1 + man/resize_colors.Rd | 41 ++++++++++++++++++++-- man/spruce_colors.Rd | 3 +- 8 files changed, 167 insertions(+), 28 deletions(-) diff --git a/R/compare-colors.R b/R/compare-colors.R index 7417271..967f80f 100644 --- a/R/compare-colors.R +++ b/R/compare-colors.R @@ -115,6 +115,7 @@ subset_colors <- function(colors, ..., method = "CIE2000", filter = NULL) { #' - "b", from LAB colorspace #' - "hue", from HSL colorspace #' - "saturation", from HSL colorspace +#' - "lightness-2", from HSL colorspace #' - "red", from RGB colorspace #' - "green", from RGB colorspace #' - "blue", from RGB colorspace diff --git a/R/resize-colors.R b/R/resize-colors.R index 10fbaf1..3253b52 100644 --- a/R/resize-colors.R +++ b/R/resize-colors.R @@ -1,25 +1,71 @@ #' Resize color palette #' -#' Reduce or expand the number of colors in palette, colors are removed with +#' Remove or add colors to the palette, colors are removed with #' `collapse_colors()` and added with `interp_colors()`. #' #' @param colors Vector of colors #' @param n Number of colors to include in final color palette +#' @param difference Color difference threshold to use for +#' selecting distinct `colors`. +#' @param method Method to use for comparing colors, can be one of: +#' - "euclidian" +#' - "CIE1976" +#' - "CIE94" +#' - "CIE2000" +#' - "CMC" +#' @param filter Filter to apply to color palette when +#' calculating pairwise differences. +#' A vector can be passed to adjust based on multiple color filters. +#' Possible values include, +#' - "colorblind", use deutan, protan, and tritan color blindness simulation +#' filters +#' - "deutan" +#' - "protan" +#' - "tritan" #' @param order If `TRUE` colors are ordered with new colors interspersed, #' if `FALSE` new colors are added to the end. -#' @param ... Additional arguments to pass to `collapse_colors()`. +#' @param maxit Maximum number of iterations to use when optimizing the color +#' palette. +#' Higher values will result in more optimal adjustments and a reduction in +#' speed. +#' @param ... Additional arguments to pass to `collapse_colors()` or +#' `spruce_colors()`. #' @export -resize_colors <- function(colors, n, order = TRUE, ...) { +resize_colors <- function(colors, n, difference = 15, method = "CIE2000", + filter = NULL, order = TRUE, maxit = 500, ...) { n_clrs <- length(colors) if (n_clrs == n) return(colors) if (n > n_clrs) { - res <- interp_colors(colors, n) + res <- interp_colors(colors, n, order = TRUE) + + ex_idx <- match(colors, res) + + res <- spruce_colors( + res, + difference = difference, + property = "interp", + method = method, + filter = filter, + exclude_colors = ex_idx, + order = TRUE, + maxit = maxit, + ... + ) + + if (!order) res <- c(colors, res[!res %in% colors]) } else { - res <- collapse_colors(colors, n, ...) + res <- collapse_colors( + colors, n, + difference = difference, + method = method, + filter = filter, + maxit = maxit, + ... + ) } res @@ -114,6 +160,14 @@ interp_colors <- function(colors, n, keep_original = TRUE, order = TRUE, #' #' @param colors Vector of colors #' @param n Number of colors to include in final color palette +#' @param difference Color difference threshold to use for +#' selecting distinct `colors`. +#' @param method Method to use for comparing colors, can be one of: +#' - "euclidian" +#' - "CIE1976" +#' - "CIE94" +#' - "CIE2000" +#' - "CMC" #' @param filter Filter to apply to color palette when #' calculating pairwise differences. #' Colors will be compared before and after applying the filter(s). @@ -133,10 +187,15 @@ interp_colors <- function(colors, n, keep_original = TRUE, order = TRUE, #' solutions. #' If `NULL` the approximate approach will be used except when the number of #' possible solutions is relatively small. +#' @param maxit Maximum number of iterations to use when optimizing the color +#' palette. +#' Higher values will result in more optimal adjustments and a reduction in +#' speed. #' @param ... Additional parameters to control the simulated annealing #' algorithm implemented with `GenSA::GenSA()`. #' @export -collapse_colors <- function(colors, n, filter = NULL, exact = NULL, ...) { +collapse_colors <- function(colors, n, difference = 15, method = "CIE2000", + filter = NULL, exact = NULL, maxit = 500, ...) { .chk_spruce_args(colors = colors, n = n, exact = exact) @@ -145,7 +204,7 @@ collapse_colors <- function(colors, n, filter = NULL, exact = NULL, ...) { filter <- .chk_filt_args(filter, multi = TRUE) # Calculate pairwise differences - dst <- .compare_clrs(colors, filt = filter) + dst <- .compare_clrs(colors, filt = filter, method = method) # Use exhaustive approach for smaller number of possible combinations max_combns <- 1e5 @@ -194,9 +253,10 @@ collapse_colors <- function(colors, n, filter = NULL, exact = NULL, ...) { lower <- as.numeric(rep(1, n)) upper <- as.numeric(rep(length(colors), n)) - gensa_params <- list(...) - gensa_params$maxit <- gensa_params$maxit %||% 1000 - gensa_params$seed <- gensa_params$seed %||% 42 + gensa_params <- list(...) + gensa_params$maxit <- maxit + gensa_params$threshold.stop <- -difference + gensa_params$seed <- gensa_params$seed %||% 42 gensa_res <- GenSA::GenSA( par = as.numeric(init_vals), diff --git a/R/scale-spruce.R b/R/scale-spruce.R index 549ad82..5d9d1e1 100644 --- a/R/scale-spruce.R +++ b/R/scale-spruce.R @@ -370,7 +370,7 @@ ggplot_add.ScaleDiscreteSpruce <- function(object, plot, object_name) { # * only merge palettes if prev_scale is discrete # * first apply pal function from prev scale to generate color palette if (any(prev_aes) && is_spruce) { - prev_scale <- self$scales[[prev_aes]] + prev_scale <- self$scales[prev_aes][[1]] if (inherits(prev_scale, "ScaleDiscrete")) { prev_pal <- prev_scale$palette diff --git a/R/spruce-colors.R b/R/spruce-colors.R index bb1f109..4703667 100644 --- a/R/spruce-colors.R +++ b/R/spruce-colors.R @@ -1,7 +1,7 @@ #' Adjust colors based on similarity #' #' @param colors Character vector of colors to adjust -#' @param difference Color difference threshold (CIE200 score) to use for +#' @param difference Color difference threshold to use for #' adjusting `colors`. #' Colors will be adjusted so the minimum pairwise difference #' is greater than this threshold. @@ -15,6 +15,7 @@ #' - "b", from LAB colorspace #' - "hue", from HSL colorspace #' - "saturation", from HSL colorspace +#' - "lightness-2", from HSL colorspace #' - "red", from RGB colorspace #' - "green", from RGB colorspace #' - "blue", from RGB colorspace @@ -271,6 +272,12 @@ spruce_colors <- function(colors, difference = 10, init_vals <- clrs_x[clr_idx] + # Set saturation limits + sat_lims <- get_property(clrs, property = "saturation") + sat_lims <- range(sat_lims$saturation) + sat_lims <- c(min(sat_lims[1], 15), 100) + + # Run optimization optim <- GenSA::GenSA( par = init_vals, fn = .sa_obj_interp, @@ -283,7 +290,8 @@ spruce_colors <- function(colors, difference = 10, method = method, clr_filt = filts, clrs_x = clrs_x, - scale = scale + scale = scale, + sat_lims = sat_lims ) # Color ramp function @@ -291,7 +299,7 @@ spruce_colors <- function(colors, difference = 10, ramp <- .get_ramp_fn(clrs, clrs_x) # Get colors using adjusted x values - clrs_x[clr_idx] <- optim$par + clrs_x[clr_idx] <- sort(optim$par) if (scale) clrs_x <- (clrs_x - min(clrs_x)) / diff(range(clrs_x)) @@ -381,7 +389,7 @@ spruce_colors <- function(colors, difference = 10, #' color matrix containing the values to modify, e.g. 1 for lightness #' @noRd .sa_obj_interp <- function(values, clrs, clr_idx, method, clr_filt = "none", - clrs_x, scale = FALSE) { + clrs_x, scale = FALSE, sat_lims = c(0, 100)) { if (any(duplicated(values))) return(0) @@ -395,6 +403,14 @@ spruce_colors <- function(colors, difference = 10, clrs <- ramp(clrs_x) + # Check saturation + # * prevent colors from being returned that have saturation values outside the + # starting palette + sat <- get_property(clrs, "saturation") + sat <- range(sat$saturation) + + if (sat[1] < sat_lims[1] || sat[2] > sat_lims[2]) return(0) + # Calculate pairwise CIEDE2000 differences dist_lst <- .compare_clrs(clrs, method = method, filt = clr_filt) min_diff <- .get_min_dist(dist_lst, clr_idx, comparison = "idx_vs_all") @@ -506,14 +522,15 @@ spruce_colors <- function(colors, difference = 10, #' matrix, and default range. #' @noRd PROP_PARAMS <- list( - lightness = list("lab", 1, c(20, 80)), - a = list("lab", 2, c(-128, 127)), - b = list("lab", 3, c(-128, 127)), - hue = list("hsl", 1, c(0, 360)), - saturation = list("hsl", 2, c(0, 100)), - red = list("rgb", 1, c(0, 255)), - green = list("rgb", 2, c(0, 255)), - blue = list("rgb", 3, c(0, 255)) + lightness = list("lab", 1, c(20, 80)), + a = list("lab", 2, c(-128, 127)), + b = list("lab", 3, c(-128, 127)), + hue = list("hsl", 1, c(0, 360)), + saturation = list("hsl", 2, c(0, 100)), + `lightness-2` = list("hsl", 3, c(20, 80)), + red = list("rgb", 1, c(0, 255)), + green = list("rgb", 2, c(0, 255)), + blue = list("rgb", 3, c(0, 255)) ) .properties <- names(PROP_PARAMS) diff --git a/man/collapse_colors.Rd b/man/collapse_colors.Rd index d3ec651..cd34a51 100644 --- a/man/collapse_colors.Rd +++ b/man/collapse_colors.Rd @@ -4,13 +4,32 @@ \alias{collapse_colors} \title{Collapse color palette} \usage{ -collapse_colors(colors, n, filter = NULL, exact = NULL, ...) +collapse_colors( + colors, + n, + difference = 15, + method = "CIE2000", + filter = NULL, + exact = NULL, + maxit = 500, + ... +) } \arguments{ \item{colors}{Vector of colors} \item{n}{Number of colors to include in final color palette} +\item{difference}{Color difference threshold to use for +selecting distinct `colors`.} + +\item{method}{Method to use for comparing colors, can be one of: +- "euclidian" +- "CIE1976" +- "CIE94" +- "CIE2000" +- "CMC"} + \item{filter}{Filter to apply to color palette when calculating pairwise differences. Colors will be compared before and after applying the filter(s). @@ -32,6 +51,11 @@ solutions. If `NULL` the approximate approach will be used except when the number of possible solutions is relatively small.} +\item{maxit}{Maximum number of iterations to use when optimizing the color +palette. +Higher values will result in more optimal adjustments and a reduction in +speed.} + \item{...}{Additional parameters to control the simulated annealing algorithm implemented with `GenSA::GenSA()`.} } diff --git a/man/get_property.Rd b/man/get_property.Rd index 1f9448a..e65b866 100644 --- a/man/get_property.Rd +++ b/man/get_property.Rd @@ -15,6 +15,7 @@ get_property(colors, property = .properties) - "b", from LAB colorspace - "hue", from HSL colorspace - "saturation", from HSL colorspace +- "lightness-2", from HSL colorspace - "red", from RGB colorspace - "green", from RGB colorspace - "blue", from RGB colorspace} diff --git a/man/resize_colors.Rd b/man/resize_colors.Rd index 66bc8f8..85d7d4d 100644 --- a/man/resize_colors.Rd +++ b/man/resize_colors.Rd @@ -4,19 +4,54 @@ \alias{resize_colors} \title{Resize color palette} \usage{ -resize_colors(colors, n, order = TRUE, ...) +resize_colors( + colors, + n, + difference = 15, + method = "CIE2000", + filter = NULL, + order = TRUE, + maxit = 500, + ... +) } \arguments{ \item{colors}{Vector of colors} \item{n}{Number of colors to include in final color palette} +\item{difference}{Color difference threshold to use for +selecting distinct `colors`.} + +\item{method}{Method to use for comparing colors, can be one of: +- "euclidian" +- "CIE1976" +- "CIE94" +- "CIE2000" +- "CMC"} + +\item{filter}{Filter to apply to color palette when +calculating pairwise differences. +A vector can be passed to adjust based on multiple color filters. +Possible values include, +- "colorblind", use deutan, protan, and tritan color blindness simulation + filters +- "deutan" +- "protan" +- "tritan"} + \item{order}{If `TRUE` colors are ordered with new colors interspersed, if `FALSE` new colors are added to the end.} -\item{...}{Additional arguments to pass to `collapse_colors()`.} +\item{maxit}{Maximum number of iterations to use when optimizing the color +palette. +Higher values will result in more optimal adjustments and a reduction in +speed.} + +\item{...}{Additional arguments to pass to `collapse_colors()` or +`spruce_colors()`.} } \description{ -Reduce or expand the number of colors in palette, colors are removed with +Remove or add colors to the palette, colors are removed with `collapse_colors()` and added with `interp_colors()`. } diff --git a/man/spruce_colors.Rd b/man/spruce_colors.Rd index 9ff2d9b..2ff390c 100644 --- a/man/spruce_colors.Rd +++ b/man/spruce_colors.Rd @@ -21,7 +21,7 @@ spruce_colors( \arguments{ \item{colors}{Character vector of colors to adjust} -\item{difference}{Color difference threshold (CIE200 score) to use for +\item{difference}{Color difference threshold to use for adjusting `colors`. Colors will be adjusted so the minimum pairwise difference is greater than this threshold.} @@ -36,6 +36,7 @@ is greater than this threshold.} - "b", from LAB colorspace - "hue", from HSL colorspace - "saturation", from HSL colorspace +- "lightness-2", from HSL colorspace - "red", from RGB colorspace - "green", from RGB colorspace - "blue", from RGB colorspace}