Skip to content

Commit

Permalink
Colors: always use complete set
Browse files Browse the repository at this point in the history
It is small enough so it is not slow, and much more
useful than the basic set.
  • Loading branch information
gaborcsardi committed Sep 24, 2023
1 parent 8950ff0 commit f8a57ea
Show file tree
Hide file tree
Showing 5 changed files with 20 additions and 39 deletions.
21 changes: 7 additions & 14 deletions R/color.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,36 +2,27 @@
#'
#' @param color A scalar color that is usable as an input to `col2rgb()`
#' (assumed to be in the sRGB color space).
#' @param color_set Should the returned color names come from a "simple" smaller
#' set or a longer, more "complete" set?
#' @return A character string that is the closest named colors to the input
#' color. The output will have an attribute of alternate color names (named
#' "alt").
#' @export
#' @importFrom grDevices col2rgb convertColor

pretty_color <- function(color, color_set=c("simple", "complete")) {
pretty_color <- function(color) {
stopifnot(length(color) == 1)
if (is.na(color)) {
structure(NA_character_, alt=NA_character_)
} else {
color_set <- match.arg(color_set)
if (is.factor(color)) color <- as.character(color)
stopifnot(is.character(color))
color_rgb <- col2rgb(color)
color_lab <- convertColor(t(color_rgb), from="sRGB", to="Lab", scale.in=256)
color_reference_set <-
if (color_set == "simple") {
color_reference[color_reference$basic | color_reference$roygbiv, ]
} else {
color_reference
}
dist <- color_diff_cie76(
color_lab,
as.matrix(color_reference_set[, c("L", "a", "b")])
as.matrix(color_reference[, c("L", "a", "b")])
)
ret <- color_reference_set$name[dist == min(dist)][1]
attr(ret, "alt") <- color_reference_set$name_alt[dist == min(dist)][[1]]
ret <- color_reference$name[dist == min(dist)][1]
attr(ret, "alt") <- color_reference$name_alt[dist == min(dist)][[1]]
ret
}
}
Expand All @@ -50,7 +41,9 @@ pretty_colour <- pretty_color
#' \item{roygbiv,basic,html,R,pantone,x11,ntc}{Source dataset containing the color}
#' }
#' @source {https://github.com/colorjs/color-namer} and R `colors()`
"color_reference"
#' @keywords internal
#' @name color_reference
NULL

color_diff_cie76 <- function(color, refs) {
d <- t(refs) - c(color)
Expand Down
19 changes: 7 additions & 12 deletions man/color_reference.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

13 changes: 5 additions & 8 deletions man/pretty_color.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/prettyunits.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 0 additions & 4 deletions tests/testthat/test-color.r
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,6 @@ test_that("pretty_color works", {
)
expect_equal(
pretty_color("#123456"),
structure("black", alt=c("black", "gray0", "grey0", "Black"))
)
expect_equal(
pretty_color("#123456", color_set="complete"),
structure("Prussian Blue", alt=c("Prussian Blue"))
)
expect_equal(
Expand Down

0 comments on commit f8a57ea

Please sign in to comment.