├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ ├── test-coverage.yaml │ └── R-CMD-check.yaml ├── .covrignore ├── revdep ├── failures.md ├── problems.md ├── cran.md └── README.md ├── LICENSE ├── R ├── sysdata.rda ├── prismatic-package.R ├── aaa.R ├── negate.R ├── alpha.R ├── mix.R ├── rotate.R ├── modify.R ├── contrast_ratio.R ├── saturate.R ├── color.R ├── greyscale.R ├── color-blindness.R ├── extract.R └── lightness.R ├── tests ├── testthat.R └── testthat │ ├── helpers.R │ ├── test-negate.R │ ├── test-modify.R │ ├── test-alpha.R │ ├── test-rotate.R │ ├── test-greyscale.R │ ├── test-mix.R │ ├── test-contrast_ratio.R │ ├── test-color.R │ ├── test-extract.R │ ├── test-saturate.R │ ├── test-color-blindness.R │ └── test-lightness.R ├── man ├── figures │ ├── logo.png │ ├── sceenshot.png │ ├── README-plotcols-1.png │ ├── README-plotcols-10.png │ ├── README-plotcols-11.png │ ├── README-plotcols-2.png │ ├── README-plotcols-3.png │ ├── README-plotcols-4.png │ ├── README-plotcols-5.png │ ├── README-plotcols-6.png │ ├── README-plotcols-7.png │ ├── README-plotcols-8.png │ ├── README-plotcols-9.png │ └── README-terraincols-1.png ├── is_color.Rd ├── prismatic-package.Rd ├── best_contrast.Rd ├── clr_alpha.Rd ├── check_color_blindness.Rd ├── clr_mix.Rd ├── clr_negate.Rd ├── color.Rd ├── clr_rotate.Rd ├── extract_hcl.Rd ├── extract_rgba.Rd ├── clr_extract.Rd ├── clr_saturate.Rd ├── clr_desaturate.Rd ├── modify_hcl.Rd ├── extract_hsl.Rd ├── contrast_ratio.Rd ├── colorblindness.Rd ├── clr_darken.Rd ├── clr_lighten.Rd └── clr_grayscale.Rd ├── data-raw └── DATASET.R ├── .gitignore ├── codecov.yml ├── cran-comments.md ├── .Rbuildignore ├── prismatic.Rproj ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── _pkgdown.yml ├── CODE_OF_CONDUCT.md ├── NEWS.md ├── README.Rmd └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.covrignore: -------------------------------------------------------------------------------- 1 | R/deprec-*.R 2 | R/compat-*.R 3 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2019 2 | COPYRIGHT HOLDER: Emil Hvitfeldt 3 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/R/sysdata.rda -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(prismatic) 3 | 4 | test_check("prismatic") 5 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/sceenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/sceenshot.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-1.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-10.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-11.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-11.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-2.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-3.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-4.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-5.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-6.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-7.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-8.png -------------------------------------------------------------------------------- /man/figures/README-plotcols-9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-plotcols-9.png -------------------------------------------------------------------------------- /man/figures/README-terraincols-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/EmilHvitfeldt/prismatic/HEAD/man/figures/README-terraincols-1.png -------------------------------------------------------------------------------- /data-raw/DATASET.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `DATASET` dataset goes here 2 | 3 | library(colorspace) 4 | 5 | usethis::use_data(max_chroma_table, overwrite = TRUE, internal = TRUE) 6 | -------------------------------------------------------------------------------- /tests/testthat/helpers.R: -------------------------------------------------------------------------------- 1 | expect_equal_color <- function(object, expected, tol = 0) { 2 | res <- all(abs(col2rgb(object) - col2rgb(expected)) <= tol) 3 | expect_true(res) 4 | } 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | docs/ 6 | .DS_Store 7 | revdep/checks.noindex 8 | revdep/library.noindex 9 | revdep/data.sqlite 10 | revdep/cloud.noindex/* 11 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 5 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 note 4 | 5 | ## revdepcheck results 6 | 7 | We checked 5 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 8 | 9 | * We saw 0 new problems 10 | * We failed to check 0 packages 11 | 12 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^prismatic\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.github$ 4 | ^README\.Rmd$ 5 | ^LICENSE\.md$ 6 | ^\.travis\.yml$ 7 | ^codecov\.yml$ 8 | ^\.covrignore$ 9 | ^cran-comments\.md$ 10 | ^_pkgdown\.yml$ 11 | ^docs$ 12 | ^pkgdown$ 13 | ^data-raw$ 14 | ^CRAN-RELEASE$ 15 | ^CODE_OF_CONDUCT\.md$ 16 | ^appveyor\.yml$ 17 | ^CRAN-SUBMISSION$ 18 | ^revdep$ 19 | -------------------------------------------------------------------------------- /R/prismatic-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | ## usethis namespace: start 5 | #' @importFrom farver convert_colour 6 | #' @importFrom farver decode_colour 7 | #' @importFrom farver encode_colour 8 | #' @importFrom graphics plot 9 | #' @importFrom graphics rect 10 | #' @importFrom graphics text 11 | #' @importFrom grDevices col2rgb 12 | #' @importFrom grDevices rgb 13 | ## usethis namespace: end 14 | NULL 15 | -------------------------------------------------------------------------------- /man/is_color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/color.R 3 | \name{is_color} 4 | \alias{is_color} 5 | \title{Test if object is a \code{colors} object} 6 | \usage{ 7 | is_color(x) 8 | } 9 | \arguments{ 10 | \item{x}{An object.} 11 | } 12 | \value{ 13 | \code{TRUE} if the object inherits from the \code{colors} class, else \code{FALSE}. 14 | } 15 | \description{ 16 | Test if object is a \code{colors} object 17 | } 18 | -------------------------------------------------------------------------------- /prismatic.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /R/aaa.R: -------------------------------------------------------------------------------- 1 | rgb2col <- function(x, alpha = FALSE) { 2 | if (alpha) { 3 | rgb(x[1, ], x[2, ], x[3, ], alpha = x[4, ], maxColorValue = 255) 4 | } else { 5 | rgb(x[1, ], x[2, ], x[3, ], maxColorValue = 255) 6 | } 7 | } 8 | 9 | rgb_norm <- function(x) { 10 | x[x > 255] <- 255 11 | x[x < 0] <- 0 12 | x 13 | } 14 | 15 | pro_transform <- function(data, value, ratio) { 16 | value * ratio + data * (1 - ratio) 17 | } 18 | 19 | has_names <- function(x) { 20 | !is.null(names(x)) || any(nzchar(names(x))) 21 | } 22 | -------------------------------------------------------------------------------- /tests/testthat/test-negate.R: -------------------------------------------------------------------------------- 1 | test_that("clr_negate() works", { 2 | expect_equal( 3 | clr_negate(c("black", "white", "red", "blue", "orange")), 4 | color(c("#FFFFFFFF", "#000000FF", "#00FFFFFF", "#FFFF00FF", "#005AFFFF"))) 5 | }) 6 | 7 | test_that("clr_negate() preserves length", { 8 | expect_length(clr_negate(rainbow(0)), 0) 9 | expect_length(clr_negate(rainbow(1)), 1) 10 | expect_length(clr_negate(rainbow(10)), 10) 11 | }) 12 | 13 | test_that("clr_negate()'s output has colors class", { 14 | expect_s3_class(clr_negate(rainbow(10)), "colors") 15 | }) 16 | 17 | test_that("clr_negate() complains when `col` is wrong", { 18 | expect_error(clr_negate("not a color")) 19 | expect_error(clr_negate(list(pal = "#000000"))) 20 | }) 21 | -------------------------------------------------------------------------------- /R/negate.R: -------------------------------------------------------------------------------- 1 | #' Negate colors in RGB space 2 | #' 3 | #' @inheritParams color 4 | #' 5 | #' @details The negation of color is happening in the red-green-blue colorspace 6 | #' RGB. This means if we take the specification for orange which is 7 | #' rgb(255, 165, 0), then we negate by taking the opposite number on the scale 8 | #' from 0 to 255, leaving us with rgb(0, 90, 255), which is a shade of blue. 9 | #' 10 | #' @return A `colors` object of the same length as `col`. 11 | #' @export 12 | #' 13 | #' @examples 14 | #' clr_negate("orange") 15 | #' 16 | #' terr <- color(terrain.colors(10)) 17 | #' 18 | #' terr 19 | #' clr_negate(terr) 20 | #' 21 | #' plot(terr) 22 | #' plot(clr_negate(terr)) 23 | clr_negate <- function(col) { 24 | col <- color(col) 25 | color(encode_colour(abs(decode_colour(col) - 255))) 26 | } 27 | -------------------------------------------------------------------------------- /tests/testthat/test-modify.R: -------------------------------------------------------------------------------- 1 | test_that("works", { 2 | expect_equal(modify_hcl("red", h = 160), color("#029071FF")) 3 | expect_equal(modify_hcl("red", h = h + 50), color("#9D7B07FF")) 4 | expect_equal( 5 | modify_hcl("red", h = h + 1:3), 6 | color(c("#FA1E02FF", "#F62B00FF", "#F23400FF")) 7 | ) 8 | expect_equal( 9 | modify_hcl("red", c = c - 1:3), 10 | color(c("#FE0B0BFF", "#FE0B0BFF", "#FE0B0BFF")) 11 | ) 12 | expect_equal( 13 | modify_hcl("red", l = l + 1:2), 14 | color(c("#FF1C1CFF", "#FF2A2AFF")) 15 | ) 16 | expect_equal( 17 | modify_hcl(rainbow(4), l = 25), 18 | color(c("#7E0000FF", "#1E4401FF", "#064343FF", "#5000A4FF")) 19 | ) 20 | expect_equal( 21 | modify_hcl(rainbow(3), h + h / 2, l = 70), 22 | color(c("#FF8A79FF", "#08BEBEFF", "#F79306FF")) 23 | ) 24 | }) 25 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: prismatic 2 | Title: Color Manipulation Tools 3 | Version: 1.1.2.9000 4 | Authors@R: 5 | person("Emil", "Hvitfeldt", , "emilhhvitfeldt@gmail.com", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0002-0679-1945")) 7 | Description: Manipulate and visualize colors in a intuitive, low-dependency and 8 | functional way. 9 | License: MIT + file LICENSE 10 | URL: https://emilhvitfeldt.github.io/prismatic/, https://github.com/EmilHvitfeldt/prismatic 11 | BugReports: https://github.com/EmilHvitfeldt/prismatic/issues 12 | Depends: 13 | R (>= 3.2) 14 | Imports: 15 | graphics, 16 | farver (>= 2.0.1), 17 | grDevices 18 | Suggests: 19 | covr, 20 | cli, 21 | testthat (>= 3.0.0) 22 | Encoding: UTF-8 23 | Roxygen: list(markdown = TRUE) 24 | RoxygenNote: 7.3.2 25 | Config/testthat/edition: 3 26 | -------------------------------------------------------------------------------- /R/alpha.R: -------------------------------------------------------------------------------- 1 | #' Set alpha in color 2 | #' 3 | #' @inheritParams color 4 | #' @param alpha Numeric between 0 and 1. 0 will result in full transparency and 5 | #' 1 in no transparency. 6 | #' 7 | #' @return A `colors` object of the same length as `col`. 8 | #' @export 9 | #' 10 | #' @examples 11 | #' plot(clr_alpha(rainbow(10), 0.5)) 12 | #' 13 | #' plot(clr_alpha(rainbow(10), 0.2)) 14 | #' 15 | #' plot(clr_alpha(rainbow(10), seq(0, 1, length.out = 10))) 16 | clr_alpha <- function(col, alpha = 0.5) { 17 | if (!(length(alpha) == 1 || (length(alpha) == length(col)))) { 18 | stop("`alpha` must be of length 1 or the same length as `col`.") 19 | } 20 | 21 | if (!all(alpha >= 0 & alpha <= 1)) { 22 | stop("`alpha` must be between 0 and 1.") 23 | } 24 | 25 | col <- color(col) 26 | rgba <- decode_colour(col) 27 | color(encode_colour(rgba, alpha = alpha)) 28 | } 29 | -------------------------------------------------------------------------------- /man/prismatic-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/prismatic-package.R 3 | \docType{package} 4 | \name{prismatic-package} 5 | \alias{prismatic} 6 | \alias{prismatic-package} 7 | \title{prismatic: Color Manipulation Tools} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | Manipulate and visualize colors in a intuitive, low-dependency and functional way. 12 | } 13 | \seealso{ 14 | Useful links: 15 | \itemize{ 16 | \item \url{https://emilhvitfeldt.github.io/prismatic/} 17 | \item \url{https://github.com/EmilHvitfeldt/prismatic} 18 | \item Report bugs at \url{https://github.com/EmilHvitfeldt/prismatic/issues} 19 | } 20 | 21 | } 22 | \author{ 23 | \strong{Maintainer}: Emil Hvitfeldt \email{emilhhvitfeldt@gmail.com} (\href{https://orcid.org/0000-0002-0679-1945}{ORCID}) 24 | 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/best_contrast.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrast_ratio.R 3 | \name{best_contrast} 4 | \alias{best_contrast} 5 | \title{Find highest contrast color} 6 | \usage{ 7 | best_contrast(x, y = c("#010101", "#FFFFFF")) 8 | } 9 | \arguments{ 10 | \item{x}{A vector of colors as described in \code{col} of \code{\link[=color]{color()}}. Must not 11 | contain any \code{NA}.} 12 | 13 | \item{y}{A vector of colors as described in \code{col} of \code{\link[=color]{color()}}. Must not 14 | contain any \code{NA}.} 15 | } 16 | \value{ 17 | A vector of the same length as \code{x} with, for each element of \code{x}, the 18 | element of \code{y} that has the highest contrast to \code{x}. 19 | } 20 | \description{ 21 | \code{best_contrast()} finds the color in \code{y} with the highest contrast to the 22 | color \code{x}. 23 | } 24 | \examples{ 25 | best_contrast("red") 26 | best_contrast("grey20") 27 | best_contrast("white") 28 | 29 | best_contrast(rainbow(10), rainbow(3)) 30 | } 31 | -------------------------------------------------------------------------------- /man/clr_alpha.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/alpha.R 3 | \name{clr_alpha} 4 | \alias{clr_alpha} 5 | \title{Set alpha in color} 6 | \usage{ 7 | clr_alpha(col, alpha = 0.5) 8 | } 9 | \arguments{ 10 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 11 | kinds of R color specifications, i.e., either a color name (as listed by 12 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 13 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 14 | 15 | \item{alpha}{Numeric between 0 and 1. 0 will result in full transparency and 16 | 1 in no transparency.} 17 | } 18 | \value{ 19 | A \code{colors} object of the same length as \code{col}. 20 | } 21 | \description{ 22 | Set alpha in color 23 | } 24 | \examples{ 25 | plot(clr_alpha(rainbow(10), 0.5)) 26 | 27 | plot(clr_alpha(rainbow(10), 0.2)) 28 | 29 | plot(clr_alpha(rainbow(10), seq(0, 1, length.out = 10))) 30 | } 31 | -------------------------------------------------------------------------------- /man/check_color_blindness.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/color-blindness.R 3 | \name{check_color_blindness} 4 | \alias{check_color_blindness} 5 | \title{Visualize color vision deficiency} 6 | \usage{ 7 | check_color_blindness(col) 8 | } 9 | \arguments{ 10 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 11 | kinds of R color specifications, i.e., either a color name (as listed by 12 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 13 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 14 | } 15 | \value{ 16 | Invisibly \code{col}. 17 | } 18 | \description{ 19 | \code{check_color_blindness()} will showcase the effect of the three kinds of 20 | color vision deficiency, Deuteranopia, Protanopia, and Tritanopia, at the 21 | same time side by side in a plot. 22 | } 23 | \examples{ 24 | check_color_blindness(rainbow(10)) 25 | 26 | check_color_blindness(terrain.colors(10)) 27 | } 28 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2019 Emil Hvitfeldt 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("[",colors) 4 | S3method(plot,colors) 5 | S3method(print,colors) 6 | export(best_contrast) 7 | export(check_color_blindness) 8 | export(clr_alpha) 9 | export(clr_darken) 10 | export(clr_desaturate) 11 | export(clr_deutan) 12 | export(clr_extract) 13 | export(clr_extract_alpha) 14 | export(clr_extract_blue) 15 | export(clr_extract_chroma) 16 | export(clr_extract_green) 17 | export(clr_extract_hue) 18 | export(clr_extract_lightness) 19 | export(clr_extract_luminance) 20 | export(clr_extract_red) 21 | export(clr_extract_saturation) 22 | export(clr_grayscale) 23 | export(clr_greyscale) 24 | export(clr_lighten) 25 | export(clr_mix) 26 | export(clr_negate) 27 | export(clr_protan) 28 | export(clr_rotate) 29 | export(clr_saturate) 30 | export(clr_tritan) 31 | export(color) 32 | export(colour) 33 | export(contrast_ratio) 34 | export(extract_rgba) 35 | export(is_color) 36 | export(modify_hcl) 37 | importFrom(farver,convert_colour) 38 | importFrom(farver,decode_colour) 39 | importFrom(farver,encode_colour) 40 | importFrom(grDevices,col2rgb) 41 | importFrom(grDevices,rgb) 42 | importFrom(graphics,plot) 43 | importFrom(graphics,rect) 44 | importFrom(graphics,text) 45 | -------------------------------------------------------------------------------- /man/clr_mix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mix.R 3 | \name{clr_mix} 4 | \alias{clr_mix} 5 | \title{Mix color into color(s)} 6 | \usage{ 7 | clr_mix(col, mix_in, ratio = 0.5) 8 | } 9 | \arguments{ 10 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 11 | kinds of R color specifications, i.e., either a color name (as listed by 12 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 13 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 14 | 15 | \item{mix_in}{Same as \code{col}.} 16 | 17 | \item{ratio}{Numeric between 0 and 1. 0 will result in \code{col}. 1 results in 18 | all the colors turning to \code{mix_in}. Must be of length 1 or the same length 19 | as \code{col}.} 20 | } 21 | \value{ 22 | A \code{colors} object of the same length as \code{col}. 23 | } 24 | \description{ 25 | Mix color into color(s) 26 | } 27 | \examples{ 28 | plot(clr_mix(rainbow(10), "blue")) 29 | 30 | plot(clr_mix(rainbow(10), "red")) 31 | 32 | plot(clr_mix(rainbow(10), "#5500EE")) 33 | 34 | plot(clr_mix(rainbow(10), "black", seq(1, 0, length.out = 10))) 35 | } 36 | -------------------------------------------------------------------------------- /man/clr_negate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/negate.R 3 | \name{clr_negate} 4 | \alias{clr_negate} 5 | \title{Negate colors in RGB space} 6 | \usage{ 7 | clr_negate(col) 8 | } 9 | \arguments{ 10 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 11 | kinds of R color specifications, i.e., either a color name (as listed by 12 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 13 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 14 | } 15 | \value{ 16 | A \code{colors} object of the same length as \code{col}. 17 | } 18 | \description{ 19 | Negate colors in RGB space 20 | } 21 | \details{ 22 | The negation of color is happening in the red-green-blue colorspace 23 | RGB. This means if we take the specification for orange which is 24 | rgb(255, 165, 0), then we negate by taking the opposite number on the scale 25 | from 0 to 255, leaving us with rgb(0, 90, 255), which is a shade of blue. 26 | } 27 | \examples{ 28 | clr_negate("orange") 29 | 30 | terr <- color(terrain.colors(10)) 31 | 32 | terr 33 | clr_negate(terr) 34 | 35 | plot(terr) 36 | plot(clr_negate(terr)) 37 | } 38 | -------------------------------------------------------------------------------- /R/mix.R: -------------------------------------------------------------------------------- 1 | #' Mix color into color(s) 2 | #' 3 | #' 4 | #' @inheritParams color 5 | #' @param mix_in Same as `col`. 6 | #' @param ratio Numeric between 0 and 1. 0 will result in `col`. 1 results in 7 | #' all the colors turning to `mix_in`. Must be of length 1 or the same length 8 | #' as `col`. 9 | #' 10 | #' @return A `colors` object of the same length as `col`. 11 | #' @export 12 | #' 13 | #' @examples 14 | #' plot(clr_mix(rainbow(10), "blue")) 15 | #' 16 | #' plot(clr_mix(rainbow(10), "red")) 17 | #' 18 | #' plot(clr_mix(rainbow(10), "#5500EE")) 19 | #' 20 | #' plot(clr_mix(rainbow(10), "black", seq(1, 0, length.out = 10))) 21 | clr_mix <- function(col, mix_in, ratio = 0.5) { 22 | if (length(mix_in) != 1) { 23 | stop("`mix_in` must be of length 1.") 24 | } 25 | 26 | if (!(length(ratio) == 1 || (length(ratio) == length(col)))) { 27 | stop("`ratio` must be of length 1 or the same length as `col`.") 28 | } 29 | 30 | if (!all(ratio >= 0 & ratio <= 1)) { 31 | stop("`ratio` must be between 0 and 1.") 32 | } 33 | 34 | col <- color(col) 35 | mix_in <- color(mix_in) 36 | 37 | ratio_mat <- matrix(ratio, nrow = 3, ncol = length(col), byrow = TRUE) 38 | rgb <- pro_transform(t(decode_colour(col)), rowSums(col2rgb(mix_in)), ratio_mat) 39 | 40 | color(encode_colour(t(rgb))) 41 | } 42 | 43 | -------------------------------------------------------------------------------- /man/color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/color.R 3 | \name{color} 4 | \alias{color} 5 | \alias{colour} 6 | \title{Turn vector of colors to \code{color} vector} 7 | \usage{ 8 | color(col) 9 | 10 | colour(col) 11 | } 12 | \arguments{ 13 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 14 | kinds of R color specifications, i.e., either a color name (as listed by 15 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 16 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 17 | } 18 | \value{ 19 | A \code{colors} object of the same length as \code{col}. Returns hex 8 digits 20 | form "#rrggbbaa". See \emph{Details}. 21 | } 22 | \description{ 23 | Turn vector of colors to \code{color} vector 24 | } 25 | \details{ 26 | Alpha values will be automatically added to hexcodes. If no alpha 27 | value is present in \code{col}, it will default to no alpha (FF). 28 | } 29 | \examples{ 30 | terrain_10 <- color(terrain.colors(10)) 31 | 32 | terrain_10[1:4] 33 | 34 | plot(terrain_10) 35 | 36 | plot(terrain_10, labels = TRUE) 37 | 38 | grey_10 <- color(gray.colors(10, start = 0, end = 1)) 39 | 40 | grey_10 41 | 42 | plot(grey_10, labels = TRUE) 43 | } 44 | -------------------------------------------------------------------------------- /R/rotate.R: -------------------------------------------------------------------------------- 1 | #' Rotate the colors around the hue wheel 2 | #' 3 | #' @details The colors will be transformed to HCL color space 4 | #' (Hue-Chroma-Luminance) where the hue of the color will be rotated. 5 | #' 6 | #' @source \url{https://en.wikipedia.org/wiki/HCL_color_space} 7 | #' 8 | #' @inheritParams color 9 | #' @param degrees A number between 0 and 360, denoting the amount of degrees the 10 | #' colors should be rotated. Defaults to 0. 11 | #' 12 | #' @return A `colors` object of the same length as `col`. 13 | #' @export 14 | #' 15 | #' @examples 16 | #' plot(clr_rotate(terrain.colors(10))) 17 | #' 18 | #' plot(clr_rotate(terrain.colors(10), degrees = 90)) 19 | #' 20 | #' plot(clr_rotate(terrain.colors(10), degrees = 180)) 21 | #' 22 | #' plot(clr_rotate(rep("magenta", 11), degrees = seq(0, 360, length.out = 11))) 23 | clr_rotate <- function(col, degrees = 0) { 24 | if (!(length(degrees) == 1 || (length(degrees) == length(col)))) { 25 | stop("`degrees` must be of length 1 or the same length as `col`.") 26 | } 27 | 28 | if (!all(degrees >= 0 & degrees <= 360)) { 29 | stop("`degrees` must be numeric between 0 and 360.") 30 | } 31 | 32 | col <- color(col) 33 | 34 | hcl <- decode_colour(col, to = "hcl") 35 | hcl[, 1] <- (hcl[, 1] + degrees) %% 360 36 | 37 | rgb <- convert_colour(hcl, "hcl", "rgb") 38 | color(encode_colour(rgb_norm(rgb))) 39 | } 40 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | template: 2 | bootstrap: 5 3 | 4 | destination: docs 5 | 6 | reference: 7 | - title: "Main color functions" 8 | contents: 9 | - color 10 | - is_color 11 | - title: "Saturation" 12 | contents: 13 | - clr_saturate 14 | - clr_desaturate 15 | - title: "Lightness" 16 | contents: 17 | - clr_lighten 18 | - clr_darken 19 | - title: "Greyscale" 20 | contents: 21 | - clr_greyscale 22 | - clr_grayscale 23 | - title: "Negation" 24 | contents: 25 | - clr_negate 26 | - title: "Mixing" 27 | contents: 28 | - clr_mix 29 | - title: "Rotate in RGB" 30 | contents: 31 | - clr_rotate 32 | - title: "Tranparency" 33 | contents: 34 | - clr_alpha 35 | - title: "Modify HCL" 36 | contents: 37 | - modify_hcl 38 | - title: "Color blindness approximations" 39 | contents: 40 | - clr_protan 41 | - clr_tritan 42 | - clr_deutan 43 | - check_color_blindness 44 | - title: "Color Contrast" 45 | contents: 46 | - best_contrast 47 | - contrast_ratio 48 | - title: "Extract Components" 49 | contents: 50 | - clr_extract_red 51 | - clr_extract_green 52 | - clr_extract_blue 53 | - clr_extract_hue 54 | - clr_extract_saturation 55 | - clr_extract_lightness 56 | - clr_extract_chroma 57 | - clr_extract_luminance 58 | - clr_extract 59 | -------------------------------------------------------------------------------- /man/clr_rotate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rotate.R 3 | \name{clr_rotate} 4 | \alias{clr_rotate} 5 | \title{Rotate the colors around the hue wheel} 6 | \source{ 7 | \url{https://en.wikipedia.org/wiki/HCL_color_space} 8 | } 9 | \usage{ 10 | clr_rotate(col, degrees = 0) 11 | } 12 | \arguments{ 13 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 14 | kinds of R color specifications, i.e., either a color name (as listed by 15 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 16 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 17 | 18 | \item{degrees}{A number between 0 and 360, denoting the amount of degrees the 19 | colors should be rotated. Defaults to 0.} 20 | } 21 | \value{ 22 | A \code{colors} object of the same length as \code{col}. 23 | } 24 | \description{ 25 | Rotate the colors around the hue wheel 26 | } 27 | \details{ 28 | The colors will be transformed to HCL color space 29 | (Hue-Chroma-Luminance) where the hue of the color will be rotated. 30 | } 31 | \examples{ 32 | plot(clr_rotate(terrain.colors(10))) 33 | 34 | plot(clr_rotate(terrain.colors(10), degrees = 90)) 35 | 36 | plot(clr_rotate(terrain.colors(10), degrees = 180)) 37 | 38 | plot(clr_rotate(rep("magenta", 11), degrees = seq(0, 360, length.out = 11))) 39 | } 40 | -------------------------------------------------------------------------------- /tests/testthat/test-alpha.R: -------------------------------------------------------------------------------- 1 | test_that(paste0("clr_alpha() preserves length"), { 2 | expect_length(clr_alpha(rainbow(0)), 0) 3 | expect_length(clr_alpha(rainbow(1)), 1) 4 | expect_length(clr_alpha(rainbow(10)), 10) 5 | }) 6 | 7 | test_that("clr_alpha()'s output has colors class", { 8 | expect_s3_class(clr_alpha(rainbow(10)), "colors") 9 | }) 10 | 11 | test_that("clr_alpha() complains when `col` is wrong", { 12 | expect_error(clr_alpha("not a color")) 13 | expect_error(clr_alpha(list(pal = "#000000"))) 14 | }) 15 | 16 | test_that("clr_alpha() if the length of `alpha` isn't 1", { 17 | expect_visible(clr_alpha(rainbow(10), rep(1, 1))) 18 | expect_visible(clr_alpha(rainbow(10), seq(0, 1, length.out = 10))) 19 | expect_error( 20 | clr_alpha(rainbow(10), seq(0, 1, length.out = 2)), 21 | "`alpha` must be of length 1 or the same length as `col`." 22 | ) 23 | expect_error( 24 | clr_alpha(rainbow(10), seq(0, 1, length.out = 3)), 25 | "`alpha` must be of length 1 or the same length as `col`." 26 | ) 27 | }) 28 | 29 | test_that("clr_alpha() setting `alpha` outside range gives error", { 30 | expect_error( 31 | clr_alpha(rainbow(10), alpha = -1), "`alpha` must be between 0 and 1." 32 | ) 33 | expect_error( 34 | clr_alpha(rainbow(10), alpha = 2), "`alpha` must be between 0 and 1." 35 | ) 36 | }) 37 | 38 | test_that("setting `alpha = 1` leaves input completely unchanged", { 39 | expect_equal(clr_alpha(rainbow(10), alpha = 1), color(rainbow(10))) 40 | }) 41 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (https://www.contributor-covenant.org), version 1.0.0, available at 25 | https://contributor-covenant.org/version/1/0/0/. 26 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::., any::mixOmics, r-lib/downlit 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /man/extract_hcl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.R 3 | \name{clr_extract_chroma} 4 | \alias{clr_extract_chroma} 5 | \title{Extract HCL components} 6 | \usage{ 7 | clr_extract_chroma(col) 8 | } 9 | \arguments{ 10 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 11 | kinds of R color specifications, i.e., either a color name (as listed by 12 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 13 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 14 | } 15 | \value{ 16 | Numeric vector of values. 17 | } 18 | \description{ 19 | Extract the hue, chroma, or luminance color components from a vector of 20 | colors. 21 | } 22 | \details{ 23 | The range of the value are: 24 | \itemize{ 25 | \item Hue is ranging from 0 to 360. 26 | \item Luminance is ranging from 0 to 100. 27 | \item Chroma, while dependent on hue and luminance, will roughly be within 0 and 28 | 180. 29 | } 30 | 31 | Use \code{\link[=clr_extract]{clr_extract()}} if you are planning to extraction multiple components. 32 | } 33 | \examples{ 34 | clr_extract_hue(rainbow(100), "HCL") 35 | clr_extract_chroma(rainbow(100)) 36 | clr_extract_luminance(rainbow(100)) 37 | } 38 | \seealso{ 39 | Other Extraction: 40 | \code{\link{clr_extract}()}, 41 | \code{\link{clr_extract_hue}()}, 42 | \code{\link{extract_rgba}()} 43 | } 44 | \concept{Extraction} 45 | -------------------------------------------------------------------------------- /tests/testthat/test-rotate.R: -------------------------------------------------------------------------------- 1 | test_that("clr_rotate() preserves length", { 2 | expect_length(clr_rotate(rainbow(0)), 0) 3 | expect_length(clr_rotate(rainbow(1)), 1) 4 | expect_length(clr_rotate(rainbow(10)), 10) 5 | }) 6 | 7 | test_that("clr_rotate()'s output has colors class", { 8 | expect_s3_class(clr_rotate(rainbow(10)), "colors") 9 | }) 10 | 11 | test_that("clr_rotate() complains when `col` is wrong", { 12 | expect_error(clr_rotate("not a color")) 13 | expect_error(clr_rotate(list(pal = "#000000"))) 14 | }) 15 | 16 | test_that("clr_rotate() if the length of `degrees` isn't 1", { 17 | expect_visible(clr_rotate(rainbow(10), rep(1, 1))) 18 | expect_visible(clr_rotate(rainbow(10), seq(0, 1, length.out = 10))) 19 | expect_error( 20 | clr_rotate(rainbow(10), seq(0, 1, length.out = 2)), 21 | "`degrees` must be of length 1 or the same length as `col`." 22 | ) 23 | expect_error( 24 | clr_rotate(rainbow(10), seq(0, 1, length.out = 3)), 25 | "`degrees` must be of length 1 or the same length as `col`." 26 | ) 27 | }) 28 | 29 | test_that("clr_rotate() setting `degrees` outside range gives error", { 30 | expect_error( 31 | clr_rotate(rainbow(10), degrees = -1), 32 | "`degrees` must be numeric between 0 and 360." 33 | ) 34 | expect_error( 35 | clr_rotate(rainbow(10), degrees = 720), 36 | "`degrees` must be numeric between 0 and 360." 37 | ) 38 | }) 39 | 40 | test_that("clr_rotate() setting `degrees = 0` leaves input unchanged", { 41 | expect_equal_color(clr_rotate(rainbow(10), 0), color(rainbow(10)), 0) 42 | }) 43 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v3 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: | 31 | covr::codecov( 32 | quiet = FALSE, 33 | clean = FALSE, 34 | install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") 35 | ) 36 | shell: Rscript {0} 37 | 38 | - name: Show testthat output 39 | if: always() 40 | run: | 41 | ## -------------------------------------------------------------------- 42 | find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true 43 | shell: bash 44 | 45 | - name: Upload test results 46 | if: failure() 47 | uses: actions/upload-artifact@v3 48 | with: 49 | name: coverage-test-failures 50 | path: ${{ runner.temp }}/package 51 | -------------------------------------------------------------------------------- /man/extract_rgba.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.R 3 | \name{extract_rgba} 4 | \alias{extract_rgba} 5 | \alias{clr_extract_red} 6 | \alias{clr_extract_green} 7 | \alias{clr_extract_blue} 8 | \alias{clr_extract_alpha} 9 | \title{Extract RGB components} 10 | \usage{ 11 | clr_extract_red(col) 12 | 13 | clr_extract_green(col) 14 | 15 | clr_extract_blue(col) 16 | 17 | clr_extract_alpha(col) 18 | } 19 | \arguments{ 20 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 21 | kinds of R color specifications, i.e., either a color name (as listed by 22 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 23 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 24 | } 25 | \value{ 26 | A numeric vector giving the extracted values. 27 | } 28 | \description{ 29 | Extract the red, green, or blue color components from a vector of colors. 30 | } 31 | \details{ 32 | The values of the output will range between 0 and 255. 33 | 34 | Use \code{\link[=clr_extract]{clr_extract()}} if you are planning to extract multiple components. 35 | } 36 | \examples{ 37 | clr_extract_red(rainbow(100)) 38 | clr_extract_green(rainbow(100)) 39 | clr_extract_blue(rainbow(100)) 40 | clr_extract_alpha(rainbow(100)) 41 | } 42 | \seealso{ 43 | Other Extraction: 44 | \code{\link{clr_extract}()}, 45 | \code{\link{clr_extract_chroma}()}, 46 | \code{\link{clr_extract_hue}()} 47 | } 48 | \concept{Extraction} 49 | -------------------------------------------------------------------------------- /tests/testthat/test-greyscale.R: -------------------------------------------------------------------------------- 1 | test_that("clr_grayscale() preserves length", { 2 | expect_length(clr_grayscale(rainbow(0)), 0) 3 | expect_length(clr_grayscale(rainbow(1)), 1) 4 | expect_length(clr_grayscale(rainbow(10)), 10) 5 | }) 6 | 7 | test_that("clr_greyscale() preserves length", { 8 | expect_length(clr_greyscale(rainbow(0)), 0) 9 | expect_length(clr_greyscale(rainbow(1)), 1) 10 | expect_length(clr_greyscale(rainbow(10)), 10) 11 | }) 12 | 13 | test_that("clr_grayscale()'s output has colors class", { 14 | expect_s3_class(clr_grayscale(rainbow(10)), "colors") 15 | }) 16 | 17 | test_that("clr_greyscale()'s output has colors class", { 18 | expect_s3_class(clr_greyscale(rainbow(10)), "colors") 19 | }) 20 | 21 | test_that("clr_grayscale() complains when `col` is wrong", { 22 | expect_error(clr_grayscale("not a color")) 23 | expect_error(clr_grayscale(list(pal = "#000000"))) 24 | }) 25 | 26 | test_that("clr_greyscale() complains when `col` is wrong", { 27 | expect_error(clr_greyscale("not a color")) 28 | expect_error(clr_greyscale(list(pal = "#000000"))) 29 | }) 30 | 31 | test_that("result is grayscale", { 32 | methods <- c( 33 | "luma", "averaging", "min_decomp", 34 | "max_decomp", "red_channel", 35 | "green_channel", "blue_channel" 36 | ) 37 | 38 | for (method in methods) { 39 | res <- col2rgb(clr_grayscale(rainbow(10), method)) 40 | 41 | expect_equal(res[1, ], res[2, ]) 42 | expect_equal(res[1, ], res[3, ]) 43 | } 44 | }) 45 | 46 | test_that("errors when method is wrongly specified", { 47 | expect_error(clr_grayscale(rainbow(10), "111")) 48 | }) 49 | 50 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:------------------------------------------------------------------------------------------| 5 | |version |R version 4.3.3 (2024-02-29) | 6 | |os |macOS Sonoma 14.4.1 | 7 | |system |aarch64, darwin20 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |America/Los_Angeles | 13 | |date |2024-04-10 | 14 | |rstudio |2023.12.0+359 Ocean Storm (desktop) | 15 | |pandoc |3.1.1 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown) | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:---------|:-----|:----------|:--| 21 | |prismatic |1.1.1 |1.1.1.9000 |* | 22 | |farver |2.1.1 |2.1.1 | | 23 | 24 | # Revdeps 25 | 26 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # prismatic (development version) 2 | 3 | # prismatic 1.1.2 4 | 5 | * `color()` now maintains the names of the input vector, allowing `plot()` to use the color names rather than the hex values when `label = TRUE`. You can also provide `label` with a custom set of color labels. Unnamed colors are labelled with their hex values (@gadenbuie, #27). 6 | 7 | * Printing color objects is now powered by `{cli}`, which has superseded `{crayon}` (jack-davison, #28). 8 | 9 | # prismatic 1.1.1 10 | 11 | * Fixed documentation to be HTML5 friendly. 12 | 13 | # prismatic 1.1.0 14 | 15 | * Add extraction functions. 16 | * `best_contrast()` has been added, and can be used to find the best contrasted colors. 17 | 18 | # prismatic 1.0.0 19 | 20 | * All functions now accepts zero length input. 21 | * Added `contrast_ratio()` function to calculate contrast ratios between colors. (#18) 22 | * Added `modify_hcl()` function to modify individual HCL axes. (#20) 23 | 24 | ## Breaking changes 25 | 26 | * `clr_rotate()` now uses HCL instead of HSL as its color space for rotation. (#19) 27 | * `clr_lightness()` and `clr_darken()` now uses HCL instead of HSL as its default color space. (#19) 28 | 29 | # prismatic 0.2.0 30 | 31 | * Added `clr_alpha()` function to specify transparency. (#9) 32 | * Added `labels` argument to `plot.colors()` to show hexcode in plot. (#8) 33 | * `clr_rotate()`'s argument `degrees` now default to 0. 34 | * `clr_mix()`'s argument `ratio` now correctly takes varied lengths as the argument. 35 | * added `check_color_blindness()` to allow quick visual color deficiency examination. (#11) 36 | 37 | # prismatic 0.1.0 38 | 39 | * Release on CRAN 40 | -------------------------------------------------------------------------------- /man/clr_extract.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.R 3 | \name{clr_extract} 4 | \alias{clr_extract} 5 | \title{Extract multiple components} 6 | \usage{ 7 | clr_extract( 8 | col, 9 | components = c("red", "green", "blue", "hue_hsl", "saturation", "lightness", "hue_hcl", 10 | "chroma", "luminance") 11 | ) 12 | } 13 | \arguments{ 14 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 15 | kinds of R color specifications, i.e., either a color name (as listed by 16 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 17 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 18 | 19 | \item{components}{A character vector of components that should be extracted. 20 | See \emph{Details} for allowed components.} 21 | } 22 | \value{ 23 | A \link{data.frame} of components. 24 | } 25 | \description{ 26 | Extract multiple color components at the same time. 27 | } 28 | \details{ 29 | The allowed values for \code{components} are: 30 | \itemize{ 31 | \item red 32 | \item green 33 | \item blue 34 | \item hue_hsl 35 | \item saturation 36 | \item lightness 37 | \item hue_hcl 38 | \item chroma 39 | \item luminance 40 | } 41 | 42 | \code{clr_extract()} is to be preferred over other extraction functions if you 43 | need to extract multiple components at the same time, since it doesn't 44 | repeat transformations. 45 | } 46 | \examples{ 47 | clr_extract(rainbow(10)) 48 | 49 | clr_extract(rainbow(10), c("hue_hsl", "saturation")) 50 | } 51 | \seealso{ 52 | Other Extraction: 53 | \code{\link{clr_extract_chroma}()}, 54 | \code{\link{clr_extract_hue}()}, 55 | \code{\link{extract_rgba}()} 56 | } 57 | \concept{Extraction} 58 | -------------------------------------------------------------------------------- /man/clr_saturate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/saturate.R 3 | \name{clr_saturate} 4 | \alias{clr_saturate} 5 | \title{Make a color more saturated} 6 | \source{ 7 | \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 8 | } 9 | \usage{ 10 | clr_saturate(col, shift = 0.5) 11 | } 12 | \arguments{ 13 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 14 | kinds of R color specifications, i.e., either a color name (as listed by 15 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 16 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 17 | 18 | \item{shift}{A numeric between 0 and 1. 0 will do zero saturation, 1 will do 19 | complete saturation. Defaults to 0.5.} 20 | } 21 | \value{ 22 | A \code{color} object of the same length as \code{col}. 23 | } 24 | \description{ 25 | Make a color more saturated 26 | } 27 | \details{ 28 | The colors will be transformed to HSL color space (hue, saturation, 29 | lightness) where the saturation of the color will be modified. The 30 | saturation of a color takes a value between 0 and 1, with 0 being black and 31 | 1 being white. \code{shift} takes a value between 0 and 1, where 0 means that the 32 | saturation stays unchanged and 1 means completely saturated. As an example, 33 | if the saturation of the color is 0.6 and \code{shift} is 0.5, then the 34 | saturation will be set to the halfway point between 0.6 and 1 which is 0.8. 35 | } 36 | \examples{ 37 | 38 | plot(clr_saturate(terrain.colors(10), shift = 0.5)) 39 | 40 | plot(clr_saturate(terrain.colors(10), shift = 1)) 41 | 42 | plot(clr_saturate(rep("firebrick", 11), shift = seq(0, 1, 0.1))) 43 | } 44 | \seealso{ 45 | \code{\link[=clr_desaturate]{clr_desaturate()}} 46 | } 47 | -------------------------------------------------------------------------------- /man/clr_desaturate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/saturate.R 3 | \name{clr_desaturate} 4 | \alias{clr_desaturate} 5 | \title{Make a color more desaturated} 6 | \source{ 7 | \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 8 | } 9 | \usage{ 10 | clr_desaturate(col, shift = 0.5) 11 | } 12 | \arguments{ 13 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 14 | kinds of R color specifications, i.e., either a color name (as listed by 15 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 16 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 17 | 18 | \item{shift}{A numeric between 0 and 1. 0 will do zero desaturation, 1 will 19 | do complete desaturation. Defaults to 0.5.} 20 | } 21 | \value{ 22 | A \code{colors} object of the same length as \code{col}. 23 | } 24 | \description{ 25 | Make a color more desaturated 26 | } 27 | \details{ 28 | The colors will be transformed to HSL color space (hue, saturation, 29 | lightness) where the saturation of the color will be modified. The 30 | saturation of a color takes a value between 0 and 1, with 0 being black and 31 | 1 being white. \code{shift} takes a value between 0 and 1, where 0 means that the 32 | saturation stays unchanged and 1 means completely desaturated. As an example, 33 | if the saturation of the color is 0.6 and \code{shift} is 0.5, then the 34 | saturation will be set to the halfway point between 0.6 and 0 which is 0.3. 35 | } 36 | \examples{ 37 | 38 | plot(clr_desaturate(terrain.colors(10), shift = 0.5)) 39 | 40 | plot(clr_desaturate(terrain.colors(10), shift = 0.9)) 41 | 42 | plot(clr_desaturate(rep("firebrick", 11), shift = seq(0, 1, 0.1))) 43 | } 44 | \seealso{ 45 | \code{\link[=clr_saturate]{clr_saturate()}} 46 | } 47 | -------------------------------------------------------------------------------- /R/modify.R: -------------------------------------------------------------------------------- 1 | #' Modify individual HCL axes 2 | #' 3 | #' This function lets you modify individual axes of a color in HCL color space. 4 | #' 5 | #' The expression used in `h`, `c`, and `l` is evaluated in the `hcl` space and 6 | #' you have access to `h`, `c`, and `l` as vectors along with vectors in the 7 | #' calling environment. 8 | #' 9 | #' `h` ranges from 0 to 360, `l` ranges from 0 to 100, and `c` while dependent 10 | #' on `h` and `l` will roughly be within 0 and 180, but often on a narrower 11 | #' range. Colors after modification will be adjusted to fit within the color 12 | #' space. 13 | #' 14 | #' @inheritParams color 15 | #' @param h Expression to modify the hue of `col`. 16 | #' @param c Expression to modify the chroma of `col`. 17 | #' @param l Expression to modify the luminance of `col`. 18 | #' 19 | #' @source \url{https://en.wikipedia.org/wiki/HCL_color_space} 20 | #' 21 | #' @return A `colors` object. 22 | #' @export 23 | #' 24 | #' @examples 25 | #' plot(modify_hcl("red", h = 160)) 26 | #' plot(modify_hcl("red", h = h + 50)) 27 | #' 28 | #' plot(modify_hcl("red", h = h + 1:100)) 29 | #' plot(modify_hcl("red", c = c - 1:200)) 30 | #' plot(modify_hcl("red", l = l + 1:50)) 31 | #' 32 | #' plot(modify_hcl(rainbow(10), l = 25)) 33 | #' 34 | #' plot(modify_hcl(rainbow(10), h + h / 2, l = 70)) 35 | modify_hcl <- function(col, h, c, l) { 36 | hcl <- as.data.frame(decode_colour(col, to = "hcl")) 37 | 38 | if (!missing(h)) { 39 | h <- eval(substitute(h), envir = hcl) 40 | h <- h %% 360 41 | } else { 42 | h <- hcl$h 43 | } 44 | if (!missing(l)) { 45 | l <- eval(substitute(l), envir = hcl) 46 | l <- pmin(100, pmax(0, l)) 47 | } else { 48 | l <- hcl$l 49 | } 50 | if (!missing(c)) { 51 | c <- eval(substitute(c), envir = hcl) 52 | } else { 53 | c <- hcl$c 54 | } 55 | 56 | c <- pmin(max_chroma(h, l, floor = TRUE), pmax(0, c)) 57 | 58 | color(encode_colour(cbind(h, c, l), from = "hcl")) 59 | } 60 | -------------------------------------------------------------------------------- /man/modify_hcl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/modify.R 3 | \name{modify_hcl} 4 | \alias{modify_hcl} 5 | \title{Modify individual HCL axes} 6 | \source{ 7 | \url{https://en.wikipedia.org/wiki/HCL_color_space} 8 | } 9 | \usage{ 10 | modify_hcl(col, h, c, l) 11 | } 12 | \arguments{ 13 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 14 | kinds of R color specifications, i.e., either a color name (as listed by 15 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 16 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 17 | 18 | \item{h}{Expression to modify the hue of \code{col}.} 19 | 20 | \item{c}{Expression to modify the chroma of \code{col}.} 21 | 22 | \item{l}{Expression to modify the luminance of \code{col}.} 23 | } 24 | \value{ 25 | A \code{colors} object. 26 | } 27 | \description{ 28 | This function lets you modify individual axes of a color in HCL color space. 29 | } 30 | \details{ 31 | The expression used in \code{h}, \code{c}, and \code{l} is evaluated in the \code{hcl} space and 32 | you have access to \code{h}, \code{c}, and \code{l} as vectors along with vectors in the 33 | calling environment. 34 | 35 | \code{h} ranges from 0 to 360, \code{l} ranges from 0 to 100, and \code{c} while dependent 36 | on \code{h} and \code{l} will roughly be within 0 and 180, but often on a narrower 37 | range. Colors after modification will be adjusted to fit within the color 38 | space. 39 | } 40 | \examples{ 41 | plot(modify_hcl("red", h = 160)) 42 | plot(modify_hcl("red", h = h + 50)) 43 | 44 | plot(modify_hcl("red", h = h + 1:100)) 45 | plot(modify_hcl("red", c = c - 1:200)) 46 | plot(modify_hcl("red", l = l + 1:50)) 47 | 48 | plot(modify_hcl(rainbow(10), l = 25)) 49 | 50 | plot(modify_hcl(rainbow(10), h + h / 2, l = 70)) 51 | } 52 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: macos-latest, r: 'release'} 26 | 27 | - {os: windows-latest, r: 'release'} 28 | 29 | # use 4.1 to check with rtools40's older compiler 30 | - {os: windows-latest, r: '4.1'} 31 | 32 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 33 | - {os: ubuntu-latest, r: 'release'} 34 | - {os: ubuntu-latest, r: 'oldrel-1'} 35 | - {os: ubuntu-latest, r: 'oldrel-2'} 36 | - {os: ubuntu-latest, r: 'oldrel-3'} 37 | 38 | env: 39 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 40 | R_KEEP_PKG_SOURCE: yes 41 | 42 | steps: 43 | - uses: actions/checkout@v3 44 | 45 | - uses: r-lib/actions/setup-pandoc@v2 46 | 47 | - uses: r-lib/actions/setup-r@v2 48 | with: 49 | r-version: ${{ matrix.config.r }} 50 | http-user-agent: ${{ matrix.config.http-user-agent }} 51 | use-public-rspm: true 52 | 53 | - uses: r-lib/actions/setup-r-dependencies@v2 54 | with: 55 | extra-packages: any::rcmdcheck 56 | needs: check 57 | 58 | - uses: r-lib/actions/check-r-package@v2 59 | with: 60 | upload-snapshots: true 61 | -------------------------------------------------------------------------------- /tests/testthat/test-mix.R: -------------------------------------------------------------------------------- 1 | test_that("clr_mix() preserves length", { 2 | expect_length(clr_mix(rainbow(0), "blue"), 0) 3 | expect_length(clr_mix(rainbow(1), "blue"), 1) 4 | expect_length(clr_mix(rainbow(10), "blue"), 10) 5 | }) 6 | 7 | test_that("clr_mix()'s output has colors class", { 8 | expect_s3_class(clr_mix(rainbow(10), "blue"), "colors") 9 | }) 10 | 11 | test_that("clr_mix() complains when `col` is wrong", { 12 | expect_error(clr_mix("not a color")) 13 | expect_error(clr_mix(list(pal = "#000000"))) 14 | }) 15 | 16 | test_that("complains if `mix_in` is wrong length", { 17 | expect_error( 18 | clr_mix(rainbow(10), character()), "`mix_in` must be of length 1." 19 | ) 20 | expect_error( 21 | clr_mix(rainbow(10), rep("black", 2)), "`mix_in` must be of length 1." 22 | ) 23 | }) 24 | 25 | test_that("clr_mix() if the length of `ratio` isn't 1", { 26 | expect_visible(clr_mix(rainbow(10), "blue", rep(0, 1))) 27 | expect_visible(clr_mix(rainbow(10), "blue", seq(0, 1, length.out = 10))) 28 | expect_error( 29 | clr_mix(rainbow(10), "blue", seq(0, 1, length.out = 2)), 30 | "`ratio` must be of length 1 or the same length as `col`." 31 | ) 32 | expect_error( 33 | clr_mix(rainbow(10), "blue", seq(0, 1, length.out = 3)), 34 | "`ratio` must be of length 1 or the same length as `col`." 35 | ) 36 | }) 37 | 38 | test_that("clr_mix() setting `ratio` outside range gives error", { 39 | expect_error( 40 | clr_mix(rainbow(10), "blue", ratio = -1), 41 | "`ratio` must be between 0 and 1." 42 | ) 43 | expect_error( 44 | clr_mix(rainbow(10), "blue", ratio = 2), 45 | "`ratio` must be between 0 and 1." 46 | ) 47 | }) 48 | 49 | test_that("clr_mix() setting `ratio = 0` leaves input unchanged", { 50 | expect_equal_color(clr_mix(rainbow(10), "blue", 0), color(rainbow(10)), 0) 51 | }) 52 | 53 | test_that("setting `ratio = 1` turns all col to `mix_in`", { 54 | expect_equal(clr_mix(rainbow(10), "blue", ratio = 1), color(rep("blue", 10))) 55 | }) 56 | -------------------------------------------------------------------------------- /man/extract_hsl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/extract.R 3 | \name{clr_extract_hue} 4 | \alias{clr_extract_hue} 5 | \alias{clr_extract_saturation} 6 | \alias{clr_extract_lightness} 7 | \alias{clr_extract_luminance} 8 | \title{Extract HSL components} 9 | \usage{ 10 | clr_extract_hue(col, space = c("HSL", "HCL")) 11 | 12 | clr_extract_saturation(col) 13 | 14 | clr_extract_lightness(col) 15 | 16 | clr_extract_luminance(col) 17 | } 18 | \arguments{ 19 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 20 | kinds of R color specifications, i.e., either a color name (as listed by 21 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 22 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 23 | 24 | \item{space}{A character string specifying the color space where hue is 25 | extracted from. Can be either "HCL" or "HSL" (default).} 26 | } 27 | \value{ 28 | Numeric vector of values. 29 | } 30 | \description{ 31 | Extract the hue, saturation, or lightness color components from a vector of 32 | colors. 33 | } 34 | \details{ 35 | The range of the value are: 36 | \itemize{ 37 | \item From 0 to 360 for hue. This in a circular fashion such that 0 and 360 are 38 | near identical. 0 is red. 39 | \item From 0 to 100 for saturation where 100 is full saturation and 0 is no 40 | saturation. 41 | \item From 0 to 100 for lightness where 100 is full lightness and 0 is no 42 | lightness. 43 | } 44 | 45 | Use \code{\link[=clr_extract]{clr_extract()}} if you are planning to extraction multiple components. 46 | } 47 | \examples{ 48 | clr_extract_hue(rainbow(100), "HSL") 49 | clr_extract_saturation(rainbow(100)) 50 | clr_extract_lightness(rainbow(100)) 51 | } 52 | \seealso{ 53 | Other Extraction: 54 | \code{\link{clr_extract}()}, 55 | \code{\link{clr_extract_chroma}()}, 56 | \code{\link{extract_rgba}()} 57 | } 58 | \concept{Extraction} 59 | -------------------------------------------------------------------------------- /tests/testthat/test-contrast_ratio.R: -------------------------------------------------------------------------------- 1 | # contrast_ratio() ------------------------------------------------------------- 2 | 3 | test_that("contrast_ratio() works", { 4 | expect_equal(contrast_ratio("white", "white"), 1) 5 | expect_equal(contrast_ratio("red", "red"), 1) 6 | expect_equal(contrast_ratio("white", "black"), 21) 7 | expect_equal(contrast_ratio("red", "blue"), contrast_ratio("blue", "red")) 8 | expect_equal(contrast_ratio(color("white"), color("white")), 1) 9 | expect_equal(length(contrast_ratio("blue", rainbow(10))), 10) 10 | }) 11 | 12 | test_that("contrast_ratio() errors if `x` not length 1", { 13 | expect_error( 14 | length(contrast_ratio(rainbow(2), rainbow(10))), 15 | "`x` must have length 1. Length was: 2." 16 | ) 17 | }) 18 | 19 | # best_contrast() -------------------------------------------------------------- 20 | 21 | test_that("best_contrast() works", { 22 | expect_equal(best_contrast("white"), "#010101") 23 | expect_equal(best_contrast("white", c("black", "white")), "black") 24 | expect_equal(best_contrast("grey80", c("#999999", "black")), "black") 25 | expect_equal(best_contrast("grey80", c("#999999", "white")), "#999999") 26 | }) 27 | 28 | test_that("best_contrast() errors if `x` not length 1", { 29 | expect_error( 30 | length(contrast_ratio(rainbow(2), rainbow(10))), 31 | "`x` must have length 1. Length was: 2." 32 | ) 33 | }) 34 | 35 | test_that("best_contrast() errors if `NA` in `x` or `y`", { 36 | expect_error( 37 | best_contrast(c(NA, rainbow(10))), 38 | "`x` and `y` must not contain any `NA`." 39 | ) 40 | expect_error( 41 | best_contrast(rainbow(10), c("black", NA)), 42 | "`x` and `y` must not contain any `NA`." 43 | ) 44 | }) 45 | 46 | test_that("best_contrast() errors if elements in `y` not unique", { 47 | expect_error( 48 | best_contrast(rainbow(10), c("black", "blue", "black")), 49 | "Elements in `y` must be unique." 50 | ) 51 | expect_error( 52 | best_contrast(rainbow(10), c("black", "white", "black")), 53 | "Elements in `y` must be unique." 54 | ) 55 | }) 56 | -------------------------------------------------------------------------------- /man/contrast_ratio.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/contrast_ratio.R 3 | \name{contrast_ratio} 4 | \alias{contrast_ratio} 5 | \title{Contrast ratio between colors} 6 | \source{ 7 | \url{https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html} 8 | } 9 | \usage{ 10 | contrast_ratio(x, y) 11 | } 12 | \arguments{ 13 | \item{x}{A length 1 color object (see \code{\link[=color]{color()}}) or a length 1 vector of any 14 | of the three kinds of R color specifications, i.e., either a color name (as 15 | listed by \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or 16 | a positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 17 | 18 | \item{y}{A color object (see \code{\link[=color]{color()}}) or a vector of any of the three kinds 19 | of R color specifications, i.e., either a color name (as listed by 20 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 21 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 22 | } 23 | \value{ 24 | A numerical vector of the same length as \code{y} of the calculated 25 | contrast ratios. 26 | } 27 | \description{ 28 | \code{contrast_ratio()} calculates the contrast ratio between the color \code{x} and 29 | the color(s) \code{y}. Contrast ratios can range from 1 to 21 with 1 being no 30 | contrast (i.e., same color) and 21 being highest contrast. 31 | } 32 | \details{ 33 | The formula used for calculating a contrast ratio between two colors is 34 | 35 | \deqn{(L1 + 0.05) / (L2 + 0.05)} 36 | 37 | where 38 | 39 | \itemize{ 40 | \item L1 is the relative luminance of the lighter of the colors, and 41 | \item L2 is the relative luminance of the darker of the colors. 42 | } 43 | 44 | Relative luminance is calculated according to 45 | \url{https://www.w3.org/TR/WCAG21/#dfn-relative-luminance}. 46 | } 47 | \examples{ 48 | contrast_ratio("red", "blue") 49 | contrast_ratio("grey20", grey.colors(10)) 50 | contrast_ratio("white", c("white", "black")) 51 | } 52 | -------------------------------------------------------------------------------- /tests/testthat/test-color.R: -------------------------------------------------------------------------------- 1 | test_that("color()'s output has colors class", { 2 | expect_s3_class(color(rainbow(10)), "colors") 3 | }) 4 | 5 | test_that("colour()'s output has colors class", { 6 | expect_s3_class(colour(rainbow(10)), "colors") 7 | }) 8 | 9 | test_that("color() preserves length", { 10 | expect_length(color(rainbow(0)), 0) 11 | expect_length(color(rainbow(1)), 1) 12 | expect_length(color(rainbow(10)), 10) 13 | }) 14 | 15 | test_that("colour() preserves length", { 16 | expect_length(colour(rainbow(0)), 0) 17 | expect_length(colour(rainbow(1)), 1) 18 | expect_length(colour(rainbow(10)), 10) 19 | }) 20 | 21 | test_that("is_color() is working", { 22 | expect_true(is_color(color(rainbow(10)))) 23 | expect_false(is_color(rainbow(10))) 24 | }) 25 | 26 | test_that("plotting returns the data invisibly", { 27 | expect_invisible(plot(color(rainbow(10)))) 28 | expect_invisible(plot(colour(rainbow(10)))) 29 | res <- expect_invisible(plot(color(c("#D3D5D0", "#76716E")))) 30 | expect_equal(res, color(c("#D3D5D0", "#76716E"))) 31 | }) 32 | 33 | test_that("printing works", { 34 | expect_output(print(color(rainbow(10))), "") 35 | expect_output(print(colour(rainbow(10))), "") 36 | }) 37 | 38 | test_that("subsetting works", { 39 | colors <- color(rainbow(10)) 40 | 41 | expect_length(colors[1:4], 4) 42 | expect_s3_class(colors[6:8], "colors") 43 | }) 44 | 45 | test_that("color() complains when `col` is wrong", { 46 | expect_error(color("not a color")) 47 | expect_error(color(list(pal = "#000000"))) 48 | }) 49 | 50 | test_that("colour() complains when `col` is wrong", { 51 | expect_error(colour("not a color")) 52 | expect_error(colour(list(pal = "#000000"))) 53 | }) 54 | 55 | test_that("color() retains names", { 56 | x <- c(blue = "#0000FF", red = "#FF0000") 57 | expect_equal(names(color(x)), names(x)) 58 | 59 | y <- c(blue = "#0000FF", "#FF0000") 60 | expect_equal(names(color(y)), names(y)) 61 | 62 | z <- c("#0000FF", "#FF0000") 63 | expect_null(names(color(z))) 64 | }) 65 | 66 | test_that("plot.color() errors with bad label input", { 67 | expect_error( 68 | plot(color(rainbow(10)), labels = 1:3), "`labels` must be a character." 69 | ) 70 | expect_error( 71 | plot(color(rainbow(10)), labels = paste(1:3)), 72 | "`labels` must be the same length as `x`." 73 | ) 74 | }) 75 | -------------------------------------------------------------------------------- /man/colorblindness.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/color-blindness.R 3 | \name{clr_protan} 4 | \alias{clr_protan} 5 | \alias{clr_deutan} 6 | \alias{clr_tritan} 7 | \title{Simulate color vision deficiency} 8 | \source{ 9 | \url{http://www.inf.ufrgs.br/~oliveira/pubs_files/CVD_Simulation/CVD_Simulation.html} 10 | } 11 | \usage{ 12 | clr_protan(col, severity = 1) 13 | 14 | clr_deutan(col, severity = 1) 15 | 16 | clr_tritan(col, severity = 1) 17 | } 18 | \arguments{ 19 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 20 | kinds of R color specifications, i.e., either a color name (as listed by 21 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 22 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 23 | 24 | \item{severity}{A numeric indicating the severity of the color vision defect. 25 | Must be a number between 0 and 1, where 0 means no deficiency, and 1 means 26 | complete deficiency. Defaults to 1.} 27 | } 28 | \value{ 29 | A \code{colors} object of the same length as \code{col}. 30 | } 31 | \description{ 32 | Simulate color vision deficiency 33 | } 34 | \details{ 35 | The matrices used to perform transformations have been taken as the 36 | 1.0 value in table 1 in 37 | \url{http://www.inf.ufrgs.br/~oliveira/pubs_files/CVD_Simulation/CVD_Simulation.html}. 38 | Values for \code{severity} values between 0 and 1 will be linearly interpolated. 39 | } 40 | \examples{ 41 | rainbow_colors <- color(rainbow(10)) 42 | 43 | plot(clr_protan(rainbow_colors)) 44 | plot(clr_deutan(rainbow_colors)) 45 | plot(clr_tritan(rainbow_colors)) 46 | 47 | viridis_colors <- c( 48 | "#4B0055FF", "#422C70FF", "#185086FF", "#007094FF", 49 | "#008E98FF", "#00A890FF", "#00BE7DFF", "#6CD05EFF", 50 | "#BBDD38FF", "#FDE333FF" 51 | ) 52 | 53 | plot(clr_protan(viridis_colors)) 54 | plot(clr_deutan(viridis_colors)) 55 | plot(clr_tritan(viridis_colors)) 56 | } 57 | \references{ 58 | Gustavo M. Machado, Manuel M. Oliveira, and Leandro A. F. Fernandes "A 59 | Physiologically-based Model for Simulation of Color Vision Deficiency". IEEE 60 | Transactions on Visualization and Computer Graphics. Volume 15 (2009), 61 | Number 6, November/December 2009. pp. 1291-1298. 62 | } 63 | -------------------------------------------------------------------------------- /tests/testthat/test-extract.R: -------------------------------------------------------------------------------- 1 | test_that("extract_rgba rgba functions work", { 2 | rgb_cols <- rgb(1:10, 11:20, 21:30, 31:40, maxColorValue = 255) 3 | 4 | expect_equal(clr_extract_red(rgb_cols), 1:10) 5 | expect_equal(clr_extract_green(rgb_cols), 11:20) 6 | expect_equal(clr_extract_blue(rgb_cols), 21:30) 7 | expect_equal(clr_extract_alpha(rgb_cols), 31:40) 8 | }) 9 | 10 | test_that("extract_rgb hsl functions work", { 11 | colors <- topo.colors(10) 12 | 13 | hsl_cols <- decode_colour(colors, to = "hsl") 14 | 15 | expect_equal(clr_extract_hue(colors), hsl_cols[, "h"]) 16 | expect_equal(clr_extract_saturation(colors), hsl_cols[, "s"]) 17 | expect_equal(clr_extract_lightness(colors), hsl_cols[, "l"]) 18 | }) 19 | 20 | test_that("extract_rgb hcl functions work", { 21 | colors <- topo.colors(10) 22 | 23 | hcl_cols <- decode_colour(colors, to = "hcl") 24 | 25 | expect_equal(clr_extract_hue(colors, space = "HCL"), hcl_cols[, "h"]) 26 | expect_equal(clr_extract_chroma(colors), hcl_cols[, "c"]) 27 | expect_equal(clr_extract_luminance(colors), hcl_cols[, "l"]) 28 | }) 29 | 30 | test_that("clr_extract_red() complains when `col` is wrong", { 31 | expect_error(clr_extract_red("not a color")) 32 | expect_error(clr_extract_red(list(pal = "#000000"))) 33 | }) 34 | 35 | test_that("clr_extract_green() complains when `col` is wrong", { 36 | expect_error(clr_extract_green("not a color")) 37 | expect_error(clr_extract_green(list(pal = "#000000"))) 38 | }) 39 | 40 | test_that("clr_extract_blue() complains when `col` is wrong", { 41 | expect_error(clr_extract_blue("not a color")) 42 | expect_error(clr_extract_blue(list(pal = "#000000"))) 43 | }) 44 | 45 | test_that("clr_extract_alpha() complains when `col` is wrong", { 46 | expect_error(clr_extract_alpha("not a color")) 47 | expect_error(clr_extract_alpha(list(pal = "#000000"))) 48 | }) 49 | 50 | test_that("clr_extract_hue() complains when `col` is wrong", { 51 | expect_error(clr_extract_hue("not a color")) 52 | expect_error(clr_extract_hue(list(pal = "#000000"))) 53 | }) 54 | 55 | test_that("clr_extract_saturation() complains when `col` is wrong", { 56 | expect_error(clr_extract_saturation("not a color")) 57 | expect_error(clr_extract_saturation(list(pal = "#000000"))) 58 | }) 59 | 60 | test_that("clr_extract_lightness() complains when `col` is wrong", { 61 | expect_error(clr_extract_lightness("not a color")) 62 | expect_error(clr_extract_lightness(list(pal = "#000000"))) 63 | }) 64 | 65 | test_that("clr_extract_chroma() complains when `col` is wrong", { 66 | expect_error(clr_extract_chroma("not a color")) 67 | expect_error(clr_extract_chroma(list(pal = "#000000"))) 68 | }) 69 | 70 | test_that("clr_extract_luminance() complains when `col` is wrong", { 71 | expect_error(clr_extract_luminance("not a color")) 72 | expect_error(clr_extract_luminance(list(pal = "#000000"))) 73 | }) 74 | -------------------------------------------------------------------------------- /man/clr_darken.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lightness.R 3 | \name{clr_darken} 4 | \alias{clr_darken} 5 | \title{Make a color darker} 6 | \source{ 7 | \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 8 | 9 | \url{https://en.wikipedia.org/wiki/CIELUV} 10 | 11 | \url{https://arxiv.org/abs/1903.06490} 12 | } 13 | \usage{ 14 | clr_darken(col, shift = 0.5, space = c("HCL", "HSL", "combined")) 15 | } 16 | \arguments{ 17 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 18 | kinds of R color specifications, i.e., either a color name (as listed by 19 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 20 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 21 | 22 | \item{shift}{A number between 0 and 1. 0 will do zero darkening, and 1 will 23 | do complete darkening, turning the color to black. Defaults to 0.5.} 24 | 25 | \item{space}{A character string specifying the color space in which adjustment 26 | happens. Can be either "HCL", "HSL" or "combined". Defaults to "HCL".} 27 | } 28 | \value{ 29 | A \code{color} object of the same length as \code{col}. 30 | } 31 | \description{ 32 | Make a color darker 33 | } 34 | \details{ 35 | The colors will be transformed to HSL color space (hue, saturation, 36 | lightness) where the lightness of the color will be modified. The lightness 37 | of a color takes a value between 0 and 1, with 0 being black and 1 being 38 | white. \code{shift} takes a value between 0 and 1, where 0 means that the 39 | lightness stays unchanged and 1 means completely black. As an example, if 40 | the lightness of the color is 0.6 and \code{shift} is 0.5, then the lightness 41 | will be set to the halfway point between 0.6 and 0, which is 0.3. 42 | 43 | If \code{space = "HSL"} then the colors are transformed to HSL space where 44 | the lightness value L is adjusted. If \code{space = "HCL"} then the colors are 45 | transformed to Cylindrical HCL space where the luminance value L is adjusted. 46 | If \code{space = "combined"} then the colors are transformed into HSL and 47 | Cylindrical HCL space. Where the color adjusting is happening HSL is copied 48 | to the values in the HCL transformation. Thus the "combined" transformation 49 | adjusts the luminance in HCL space and chroma in HSL space. For more 50 | information regarding use of color spaces, please refer to the colorspace 51 | paper \url{https://arxiv.org/abs/1903.06490}. 52 | } 53 | \examples{ 54 | # Using linear shift 55 | plot(clr_darken(rep("red", 11), shift = seq(0, 1, 0.1))) 56 | plot(clr_darken(rep("red", 11), shift = seq(0, 1, 0.1), space = "HSL")) 57 | plot(clr_darken(rep("red", 11), shift = seq(0, 1, 0.1), space = "combined")) 58 | 59 | plot(clr_darken(terrain.colors(10))) 60 | 61 | # Using exponential shifts 62 | plot(clr_darken(rep("red", 11), shift = log(seq(1, exp(1), length.out = 11)))) 63 | 64 | } 65 | \seealso{ 66 | \code{\link[=clr_lighten]{clr_lighten()}} 67 | } 68 | -------------------------------------------------------------------------------- /man/clr_lighten.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lightness.R 3 | \name{clr_lighten} 4 | \alias{clr_lighten} 5 | \title{Make a color lighter} 6 | \source{ 7 | \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 8 | 9 | \url{https://en.wikipedia.org/wiki/CIELUV} 10 | 11 | \url{https://arxiv.org/abs/1903.06490} 12 | } 13 | \usage{ 14 | clr_lighten(col, shift = 0.5, space = c("HCL", "HSL", "combined")) 15 | } 16 | \arguments{ 17 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 18 | kinds of R color specifications, i.e., either a color name (as listed by 19 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 20 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 21 | 22 | \item{shift}{A number between 0 and 1. 0 will do zero lightening, and 1 will 23 | do complete lightening, turning the color to white. Defaults to 0.5.} 24 | 25 | \item{space}{A character string specifying the color space in which adjustment 26 | happens. Can be either "HCL", "HSL" or "combined". Defaults to "HCL".} 27 | } 28 | \value{ 29 | A \code{colors} object of the same length as \code{col}. 30 | } 31 | \description{ 32 | Make a color lighter 33 | } 34 | \details{ 35 | The colors will be transformed to HSL color space (hue, saturation, 36 | lightness) where the lightness of the color will be modified. The lightness 37 | of a color takes a value between 0 and 1, with 0 being black and 1 being 38 | white. \code{shift} takes a value between 0 and 1, where 0 means the lightness 39 | stays unchanged and 1 means completely white. As an example, if the lightness 40 | of the color is 0.6 and \code{shift} is 0.5, the lightness will be set to the 41 | halfway point between 0.6 and 1 which is 0.8. 42 | 43 | If \code{space = "HSL"} then the colors are transformed to HSL space where 44 | the lightness value L is adjusted. If \code{space = "HCL"} then the colors are 45 | transformed to Cylindrical HCL space where the luminance value L is adjusted. 46 | If \code{space = "combined"} then the colors are transformed into HSL and 47 | Cylindrical HCL space. Where the color adjusting is happening HLS is copied 48 | to the values in the HCL transformation. Thus, the "combined" transformation 49 | adjusts the luminance in HCL space and chroma in HSL space. For more 50 | information regarding use of color spaces, please refer to the colorspace 51 | paper \url{https://arxiv.org/abs/1903.06490}. 52 | } 53 | \examples{ 54 | # Using linear shift 55 | plot(clr_lighten(rep("red", 11), shift = seq(0, 1, 0.1))) 56 | plot(clr_lighten(rep("red", 11), shift = seq(0, 1, 0.1), space = "HSL")) 57 | plot(clr_lighten(rep("red", 11), shift = seq(0, 1, 0.1), space = "combined")) 58 | 59 | plot(clr_lighten(terrain.colors(10))) 60 | 61 | # Using exponential shifts 62 | plot(clr_lighten(rep("red", 11), shift = log(seq(1, exp(1), length.out = 11)))) 63 | 64 | } 65 | \seealso{ 66 | \code{\link[=clr_darken]{clr_darken()}} 67 | } 68 | -------------------------------------------------------------------------------- /tests/testthat/test-saturate.R: -------------------------------------------------------------------------------- 1 | test_that("clr_saturate() preserves length", { 2 | expect_length(clr_saturate(rainbow(0)), 0) 3 | expect_length(clr_saturate(rainbow(1)), 1) 4 | expect_length(clr_saturate(rainbow(10)), 10) 5 | }) 6 | 7 | test_that("clr_desaturate() preserves length", { 8 | expect_length(clr_desaturate(rainbow(0)), 0) 9 | expect_length(clr_desaturate(rainbow(1)), 1) 10 | expect_length(clr_desaturate(rainbow(10)), 10) 11 | }) 12 | 13 | test_that("clr_saturate()'s output has colors class", { 14 | expect_s3_class(clr_saturate(rainbow(10)), "colors") 15 | }) 16 | 17 | test_that("clr_desaturate()'s output has colors class", { 18 | expect_s3_class(clr_desaturate(rainbow(10)), "colors") 19 | }) 20 | 21 | test_that("clr_saturate() complains when `col` is wrong", { 22 | expect_error(clr_saturate("not a color")) 23 | expect_error(clr_saturate(list(pal = "#000000"))) 24 | }) 25 | 26 | test_that("clr_desaturate() complains when `col` is wrong", { 27 | expect_error(clr_desaturate("not a color")) 28 | expect_error(clr_desaturate(list(pal = "#000000"))) 29 | }) 30 | 31 | test_that("clr_saturate() if the length of `shift` isn't 1", { 32 | expect_visible(clr_saturate(rainbow(10), rep(1, 1))) 33 | expect_visible(clr_saturate(rainbow(10), seq(0, 1, length.out = 10))) 34 | expect_error( 35 | clr_saturate(rainbow(10), seq(0, 1, length.out = 2)), 36 | "`shift` must be of length 1 or the same length as `col`." 37 | ) 38 | expect_error( 39 | clr_saturate(rainbow(10), seq(0, 1, length.out = 3)), 40 | "`shift` must be of length 1 or the same length as `col`." 41 | ) 42 | }) 43 | 44 | test_that("clr_desaturate() if the length of `shift` isn't 1", { 45 | expect_visible(clr_desaturate(rainbow(10), rep(1, 1))) 46 | expect_visible(clr_desaturate(rainbow(10), seq(0, 1, length.out = 10))) 47 | expect_error( 48 | clr_desaturate(rainbow(10), seq(0, 1, length.out = 2)), 49 | "`shift` must be of length 1 or the same length as `col`." 50 | ) 51 | expect_error( 52 | clr_desaturate(rainbow(10), seq(0, 1, length.out = 3)), 53 | "`shift` must be of length 1 or the same length as `col`." 54 | ) 55 | }) 56 | 57 | test_that("clr_saturate() setting `shift` outside range gives error", { 58 | expect_error( 59 | clr_saturate(rainbow(10), shift = -1), "`shift` must be between 0 and 1." 60 | ) 61 | expect_error( 62 | clr_saturate(rainbow(10), shift = 2), "`shift` must be between 0 and 1." 63 | ) 64 | }) 65 | 66 | test_that("clr_desaturate() setting `shift` outside range gives error", { 67 | expect_error( 68 | clr_desaturate(rainbow(10), shift = -1), "`shift` must be between 0 and 1." 69 | ) 70 | expect_error( 71 | clr_desaturate(rainbow(10), shift = 2), "`shift` must be between 0 and 1." 72 | ) 73 | }) 74 | 75 | test_that("clr_saturate() setting `shift = 0` leaves input unchanged", { 76 | expect_equal_color(clr_saturate(rainbow(10), 0), color(rainbow(10)), 0) 77 | }) 78 | 79 | test_that("clr_desaturate() setting `shift = 0` leaves input unchanged", { 80 | expect_equal_color(clr_desaturate(rainbow(10), 0), color(rainbow(10)), 0) 81 | }) 82 | -------------------------------------------------------------------------------- /man/clr_grayscale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/greyscale.R 3 | \name{clr_grayscale} 4 | \alias{clr_grayscale} 5 | \alias{clr_greyscale} 6 | \title{Transform colors to grayscale} 7 | \source{ 8 | \url{https://tannerhelland.com/3643/grayscale-image-algorithm-vb6/} 9 | 10 | \url{https://en.wikipedia.org/wiki/Luma} 11 | } 12 | \usage{ 13 | clr_grayscale( 14 | col, 15 | method = c("luma", "averaging", "min_decomp", "max_decomp", "red_channel", 16 | "green_channel", "blue_channel") 17 | ) 18 | 19 | clr_greyscale( 20 | col, 21 | method = c("luma", "averaging", "min_decomp", "max_decomp", "red_channel", 22 | "green_channel", "blue_channel") 23 | ) 24 | } 25 | \arguments{ 26 | \item{col}{A \code{colors} object (see \code{\link[=color]{color()}}) or a vector of any of the three 27 | kinds of R color specifications, i.e., either a color name (as listed by 28 | \code{\link[grDevices:colors]{grDevices::colors()}}), a hexadecimal string (see \code{\link[=col2rgb]{col2rgb()}}), or a 29 | positive integer \code{i} meaning \code{\link[grDevices:palette]{grDevices::palette()}}\verb{[i]}.} 30 | 31 | \item{method}{A character string specifying the grayscaling method. Can be 32 | one of "luma", "averaging", "min_decomp", "max_decomp", "red_channel", 33 | "green_channel" and "blue_channel". Defaults to "luma".} 34 | } 35 | \value{ 36 | A \code{colors} object of the same length as \code{col}. 37 | } 38 | \description{ 39 | \code{clr_grayscale()} has a selection of different methods to turn colors into 40 | grayscale. 41 | } 42 | \details{ 43 | If \code{method = "averaging"} then the red, green and blue will be 44 | averaged together to create the grey value. This method does a poor job of 45 | representing the way the human eye sees color. If \code{method = "luma"} (the 46 | default), a weighted average is used to calculate the grayscale values. The 47 | BT. 709 method from the ITU Radiocommunication Sector have determined the 48 | weights. If \code{method} is \code{"min_decomp"} or \code{"max_decomp"}, then a decomposition 49 | method is used where the minimum or maximum color value have been selected 50 | for the color value. So the color rgb(60, 120, 40) would have the "min_decomp" 51 | value of 40 and "max_decomp" value of 120. If method is \code{"red_channel"}, 52 | \code{"green_channel"} or \code{"blue_channel"}, then the corresponding color channel 53 | will be selected for the values of grayscale. 54 | } 55 | \examples{ 56 | 57 | plot(clr_grayscale(rainbow(10))) 58 | 59 | plot(clr_grayscale(terrain.colors(10))) 60 | 61 | viridis_colors <- c( 62 | "#4B0055FF", "#422C70FF", "#185086FF", "#007094FF", 63 | "#008E98FF", "#00A890FF", "#00BE7DFF", "#6CD05EFF", 64 | "#BBDD38FF", "#FDE333FF" 65 | ) 66 | 67 | plot(clr_grayscale(viridis_colors, method = "luma")) 68 | plot(clr_grayscale(viridis_colors, method = "averaging")) 69 | plot(clr_grayscale(viridis_colors, method = "min_decomp")) 70 | plot(clr_grayscale(viridis_colors, method = "max_decomp")) 71 | plot(clr_grayscale(viridis_colors, method = "red_channel")) 72 | plot(clr_grayscale(viridis_colors, method = "green_channel")) 73 | plot(clr_grayscale(viridis_colors, method = "blue_channel")) 74 | } 75 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r opts, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # prismatic 17 | 18 | 19 | [![R-CMD-check](https://github.com/EmilHvitfeldt/prismatic/workflows/R-CMD-check/badge.svg)](https://github.com/EmilHvitfeldt/prismatic/actions) 20 | [![Codecov test coverage](https://codecov.io/gh/EmilHvitfeldt/prismatic/branch/main/graph/badge.svg)](https://app.codecov.io/gh/EmilHvitfeldt/prismatic?branch=main) 21 | [![CRAN status](http://www.r-pkg.org/badges/version/prismatic)](https://CRAN.R-project.org/package=prismatic) 22 | [![Downloads](http://cranlogs.r-pkg.org/badges/prismatic)](https://CRAN.R-project.org/package=prismatic) 23 | [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html) 24 | [![DOI](https://zenodo.org/badge/205078698.svg)](https://zenodo.org/record/4420786) 25 | 26 | 27 | The goal of prismatic is to provide color manipulation tools in R, in an intuitive, low-dependency and functional way. 28 | 29 | - **intuitive** All the working functions are prefixed with `clr_` (**c**o**l**o**r**) allowing for easy autocompletion. 30 | - **low-dependency** Only depends on [farver](https://github.com/thomasp85/farver). 31 | - **functional** All functions have consistent inputs and outputs and are thus fully pipeable. 32 | 33 | ## Installation 34 | 35 | You can install the released version of prismatic from [CRAN](https://CRAN.R-project.org) with: 36 | 37 | ``` r 38 | install.packages("prismatic") 39 | ``` 40 | 41 | And the development version from [GitHub](https://github.com/) with: 42 | 43 | ``` r 44 | # install.packages("devtools") 45 | devtools::install_github("EmilHvitfeldt/prismatic") 46 | ``` 47 | ## Examples 48 | 49 | All **prismatic** function return a `colors` object, which includes a new printing method and plotting method for quickly visualizing the colors. 50 | 51 | ```{r terraincols, dpi=320} 52 | library(prismatic) 53 | 54 | terrain10 <- terrain.colors(10) 55 | 56 | terrain10 57 | 58 | terrain_color <- color(terrain10) 59 | 60 | terrain_color 61 | 62 | plot(terrain_color) 63 | ``` 64 | 65 | If [cli](https://github.com/r-lib/cli) is available the print method will do its best to represent the colors. 66 | 67 | ![](man/figures/sceenshot.png) 68 | 69 | ```{r plotcols, dpi=320} 70 | ddd <- color(terrain.colors(10)) 71 | ddd 72 | 73 | plot(ddd) 74 | clr_grayscale(ddd) |> plot() 75 | clr_lighten(ddd, 0.7) |> plot() 76 | clr_darken(ddd, 0.5) |> plot() 77 | clr_saturate(ddd, 0.5) |> plot() 78 | clr_desaturate(ddd, 0.5) |> plot() 79 | clr_negate(ddd) |> plot() 80 | clr_rotate(ddd, 180) |> plot() 81 | 82 | clr_protan(ddd) |> plot() 83 | clr_tritan(ddd) |> plot() 84 | clr_deutan(ddd) |> plot() 85 | ``` 86 | 87 | ## Related work 88 | 89 | This package is hugely inspired by the JavaScript library [Qix-/color](https://github.com/Qix-/color). 90 | 91 | ## Code of Conduct 92 | 93 | Please note that the **prismatic** project is released with a [Contributor Code of Conduct](https://github.com/EmilHvitfeldt/prismatic/blob/main/CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms. 94 | -------------------------------------------------------------------------------- /R/contrast_ratio.R: -------------------------------------------------------------------------------- 1 | #' Contrast ratio between colors 2 | #' 3 | #' `contrast_ratio()` calculates the contrast ratio between the color `x` and 4 | #' the color(s) `y`. Contrast ratios can range from 1 to 21 with 1 being no 5 | #' contrast (i.e., same color) and 21 being highest contrast. 6 | #' 7 | #' @details 8 | #' The formula used for calculating a contrast ratio between two colors is 9 | #' 10 | #' \deqn{(L1 + 0.05) / (L2 + 0.05)} 11 | #' 12 | #' where 13 | #' 14 | #' \itemize{ 15 | #' \item L1 is the relative luminance of the lighter of the colors, and 16 | #' \item L2 is the relative luminance of the darker of the colors. 17 | #' } 18 | #' 19 | #' Relative luminance is calculated according to 20 | #' \url{https://www.w3.org/TR/WCAG21/#dfn-relative-luminance}. 21 | #' 22 | #' @param x A length 1 color object (see [color()]) or a length 1 vector of any 23 | #' of the three kinds of R color specifications, i.e., either a color name (as 24 | #' listed by [grDevices::colors()]), a hexadecimal string (see [col2rgb()]), or 25 | #' a positive integer `i` meaning [grDevices::palette()]`[i]`. 26 | #' @param y A color object (see [color()]) or a vector of any of the three kinds 27 | #' of R color specifications, i.e., either a color name (as listed by 28 | #' [grDevices::colors()]), a hexadecimal string (see [col2rgb()]), or a 29 | #' positive integer `i` meaning [grDevices::palette()]`[i]`. 30 | #' 31 | #' @return A numerical vector of the same length as `y` of the calculated 32 | #' contrast ratios. 33 | #' @export 34 | #' 35 | #' @source \url{https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html} 36 | #' @examples 37 | #' contrast_ratio("red", "blue") 38 | #' contrast_ratio("grey20", grey.colors(10)) 39 | #' contrast_ratio("white", c("white", "black")) 40 | contrast_ratio <- function(x, y) { 41 | if (length(x) != 1) { 42 | stop(paste0("`x` must have length 1. Length was: ", length(x), ".")) 43 | } 44 | x_l <- rel_l(x) 45 | y_l <- rel_l(y) 46 | 47 | res <- (pmax(x_l, y_l) + 0.05) / (pmin(x_l, y_l) + 0.05) 48 | unname(res) 49 | } 50 | 51 | #' Find highest contrast color 52 | #' 53 | #' `best_contrast()` finds the color in `y` with the highest contrast to the 54 | #' color `x`. 55 | #' 56 | #' @param x A vector of colors as described in `col` of [color()]. Must not 57 | #' contain any `NA`. 58 | #' @param y A vector of colors as described in `col` of [color()]. Must not 59 | #' contain any `NA`. 60 | #' 61 | #' @return A vector of the same length as `x` with, for each element of `x`, the 62 | #' element of `y` that has the highest contrast to `x`. 63 | #' @export 64 | #' 65 | #' @examples 66 | #' best_contrast("red") 67 | #' best_contrast("grey20") 68 | #' best_contrast("white") 69 | #' 70 | #' best_contrast(rainbow(10), rainbow(3)) 71 | best_contrast <- function(x, y = c("#010101", "#FFFFFF")) { 72 | if (any(is.na(x)) || any(is.na(y))) { 73 | stop("`x` and `y` must not contain any `NA`.") 74 | } 75 | 76 | if (length(unique(y)) != length(y)) { 77 | stop("Elements in `y` must be unique.") 78 | } 79 | 80 | constracts <- sapply(x, contrast_ratio, y) 81 | y[apply(constracts, 2, function(x) which(max(x) == x))] 82 | } 83 | 84 | # Source: https://www.w3.org/TR/WCAG21/#dfn-relative-luminance 85 | rel_l <- function(x) { 86 | scale <- function(x) { 87 | ifelse(x <= 0.04045, x / 12.92, ((x + 0.055) / 1.055)^2.4) 88 | } 89 | rgb <- decode_colour(x) / 255 90 | 0.2126 * scale(rgb[, 1]) + 0.7152 * scale(rgb[, 2]) + 0.0722 * scale(rgb[, 3]) 91 | } 92 | -------------------------------------------------------------------------------- /R/saturate.R: -------------------------------------------------------------------------------- 1 | #' Make a color more saturated 2 | #' 3 | #' @details The colors will be transformed to HSL color space (hue, saturation, 4 | #' lightness) where the saturation of the color will be modified. The 5 | #' saturation of a color takes a value between 0 and 1, with 0 being black and 6 | #' 1 being white. `shift` takes a value between 0 and 1, where 0 means that the 7 | #' saturation stays unchanged and 1 means completely saturated. As an example, 8 | #' if the saturation of the color is 0.6 and `shift` is 0.5, then the 9 | #' saturation will be set to the halfway point between 0.6 and 1 which is 0.8. 10 | #' 11 | #' @source \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 12 | #' 13 | #' @inheritParams color 14 | #' @param shift A numeric between 0 and 1. 0 will do zero saturation, 1 will do 15 | #' complete saturation. Defaults to 0.5. 16 | #' 17 | #' @return A `color` object of the same length as `col`. 18 | #' @export 19 | #' 20 | #' @seealso [clr_desaturate()] 21 | #' @examples 22 | #' 23 | #' plot(clr_saturate(terrain.colors(10), shift = 0.5)) 24 | #' 25 | #' plot(clr_saturate(terrain.colors(10), shift = 1)) 26 | #' 27 | #' plot(clr_saturate(rep("firebrick", 11), shift = seq(0, 1, 0.1))) 28 | clr_saturate <- function(col, shift = 0.5) { 29 | if (!(length(shift) == 1 || (length(shift) == length(col)))) { 30 | stop("`shift` must be of length 1 or the same length as `col`.") 31 | } 32 | 33 | if (!all(shift >= 0 & shift <= 1)) { 34 | stop("`shift` must be between 0 and 1.") 35 | } 36 | 37 | col <- color(col) 38 | 39 | hsl <- decode_colour(col, to = "hsl") 40 | hsl[, 2] <- pro_transform(hsl[, 2], 100, shift) 41 | 42 | rgb <- convert_colour(hsl, "hsl", "rgb") 43 | color(encode_colour(rgb_norm(rgb))) 44 | } 45 | 46 | #' Make a color more desaturated 47 | #' 48 | #' @details The colors will be transformed to HSL color space (hue, saturation, 49 | #' lightness) where the saturation of the color will be modified. The 50 | #' saturation of a color takes a value between 0 and 1, with 0 being black and 51 | #' 1 being white. `shift` takes a value between 0 and 1, where 0 means that the 52 | #' saturation stays unchanged and 1 means completely desaturated. As an example, 53 | #' if the saturation of the color is 0.6 and `shift` is 0.5, then the 54 | #' saturation will be set to the halfway point between 0.6 and 0 which is 0.3. 55 | #' 56 | #' @source \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 57 | #' 58 | #' @inheritParams color 59 | #' @param shift A numeric between 0 and 1. 0 will do zero desaturation, 1 will 60 | #' do complete desaturation. Defaults to 0.5. 61 | #' 62 | #' @return A `colors` object of the same length as `col`. 63 | #' @export 64 | #' 65 | #' @seealso [clr_saturate()] 66 | #' @examples 67 | #' 68 | #' plot(clr_desaturate(terrain.colors(10), shift = 0.5)) 69 | #' 70 | #' plot(clr_desaturate(terrain.colors(10), shift = 0.9)) 71 | #' 72 | #' plot(clr_desaturate(rep("firebrick", 11), shift = seq(0, 1, 0.1))) 73 | clr_desaturate <- function(col, shift = 0.5) { 74 | if (!(length(shift) == 1 || (length(shift) == length(col)))) { 75 | stop("`shift` must be of length 1 or the same length as `col`.") 76 | } 77 | 78 | if (!all(shift >= 0 & shift <= 1)) { 79 | stop("`shift` must be between 0 and 1.") 80 | } 81 | 82 | col <- color(col) 83 | 84 | hsl <- decode_colour(col, to = "hsl") 85 | hsl[, 2] <- pro_transform(hsl[, 2], 0, shift) 86 | 87 | rgb <- convert_colour(hsl, "hsl", "rgb") 88 | color(encode_colour(rgb_norm(rgb))) 89 | } 90 | 91 | -------------------------------------------------------------------------------- /R/color.R: -------------------------------------------------------------------------------- 1 | #' Turn vector of colors to `color` vector 2 | #' 3 | #' @details Alpha values will be automatically added to hexcodes. If no alpha 4 | #' value is present in `col`, it will default to no alpha (FF). 5 | #' 6 | #' @param col A `colors` object (see [color()]) or a vector of any of the three 7 | #' kinds of R color specifications, i.e., either a color name (as listed by 8 | #' [grDevices::colors()]), a hexadecimal string (see [col2rgb()]), or a 9 | #' positive integer `i` meaning [grDevices::palette()]`[i]`. 10 | #' 11 | #' @return A `colors` object of the same length as `col`. Returns hex 8 digits 12 | #' form "#rrggbbaa". See *Details*. 13 | #' @export 14 | #' 15 | #' @rdname color 16 | #' 17 | #' @examples 18 | #' terrain_10 <- color(terrain.colors(10)) 19 | #' 20 | #' terrain_10[1:4] 21 | #' 22 | #' plot(terrain_10) 23 | #' 24 | #' plot(terrain_10, labels = TRUE) 25 | #' 26 | #' grey_10 <- color(gray.colors(10, start = 0, end = 1)) 27 | #' 28 | #' grey_10 29 | #' 30 | #' plot(grey_10, labels = TRUE) 31 | color <- function(col) { 32 | if (is.list(col)) { 33 | stop("`col` must not be a list.") 34 | } 35 | if (length(col) < 0) { 36 | stop("The length of `col` must be positive.") 37 | } 38 | 39 | colors <- rgb2col(col2rgb(col, alpha = TRUE), alpha = TRUE) 40 | if (has_names(col)) { 41 | names(colors) <- names(col) 42 | } 43 | 44 | attr(colors, "class") <- "colors" 45 | colors 46 | } 47 | 48 | #' @rdname color 49 | #' @export 50 | colour <- function(col) { 51 | color(col) 52 | } 53 | 54 | #' Test if object is a `colors` object 55 | #' 56 | #' @param x An object. 57 | #' 58 | #' @return `TRUE` if the object inherits from the `colors` class, else `FALSE`. 59 | #' @export 60 | is_color <- function(x) { 61 | inherits(x, "colors") 62 | } 63 | 64 | #' @export 65 | `[.colors` <- function(x, i) { 66 | x <- unclass(x) 67 | color(x[i]) 68 | } 69 | 70 | #' @export 71 | plot.colors <- function(x, labels = FALSE, ...) { 72 | plot(0, 73 | type = "n", axes = FALSE, ann = FALSE, xlim = c(0, length(x) + 1), 74 | ylim = c(-0.1, 1.1), mar = rep(0, 4) 75 | ) 76 | rect( 77 | xleft = seq_along(x) - 0.5, ybottom = 0, xright = seq_along(x) + 0.5, 78 | ytop = 1, col = x, border = NA 79 | ) 80 | if (is.logical(labels)) { 81 | color_labels <- if (has_names(x)) names(x) else x 82 | show_labels <- isTRUE(labels) 83 | } else { 84 | stopifnot( 85 | "`labels` must be a character." = is.character(labels), 86 | "`labels` must be the same length as `x`." = length(x) == length(labels) 87 | ) 88 | color_labels <- labels 89 | show_labels <- TRUE 90 | } 91 | if (show_labels) { 92 | # Fill missing color labels with the color hex value 93 | color_labels[!nzchar(color_labels)] <- x[!nzchar(color_labels)] 94 | label_col <- vapply(x, best_contrast, FUN.VALUE = character(1)) 95 | text(x = seq_along(x), y = 0.5, labels = color_labels, srt = 90, col = label_col) 96 | } 97 | rect(xleft = 0.5, ybottom = 0, xright = length(x) + 0.5, ytop = 1) 98 | invisible(x) 99 | } 100 | 101 | color_styler <- function(x) { 102 | text <- cli::make_ansi_style(best_contrast(x), bg = FALSE) 103 | background <- cli::make_ansi_style(x, bg = TRUE, colors = 256, grey = FALSE) 104 | 105 | cli::combine_ansi_styles(text, background)(x) 106 | } 107 | 108 | pretty_print <- function(x) { 109 | cols <- vapply(x, color_styler, FUN.VALUE = character(1), USE.NAMES = FALSE) 110 | cat(paste(c(cols, "\n"), collapse = " ")) 111 | } 112 | 113 | #' @export 114 | print.colors <- function(x, ...) { 115 | cat("\n") 116 | if (requireNamespace("cli", quietly = TRUE)) { 117 | pretty_print(x) 118 | } else { 119 | print(unclass(x)) 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /R/greyscale.R: -------------------------------------------------------------------------------- 1 | #' Transform colors to grayscale 2 | #' 3 | #' `clr_grayscale()` has a selection of different methods to turn colors into 4 | #' grayscale. 5 | #' 6 | #' @inheritParams color 7 | #' @param method A character string specifying the grayscaling method. Can be 8 | #' one of "luma", "averaging", "min_decomp", "max_decomp", "red_channel", 9 | #' "green_channel" and "blue_channel". Defaults to "luma". 10 | #' 11 | #' @details If `method = "averaging"` then the red, green and blue will be 12 | #' averaged together to create the grey value. This method does a poor job of 13 | #' representing the way the human eye sees color. If `method = "luma"` (the 14 | #' default), a weighted average is used to calculate the grayscale values. The 15 | #' BT. 709 method from the ITU Radiocommunication Sector have determined the 16 | #' weights. If `method` is `"min_decomp"` or `"max_decomp"`, then a decomposition 17 | #' method is used where the minimum or maximum color value have been selected 18 | #' for the color value. So the color rgb(60, 120, 40) would have the "min_decomp" 19 | #' value of 40 and "max_decomp" value of 120. If method is `"red_channel"`, 20 | #' `"green_channel"` or `"blue_channel"`, then the corresponding color channel 21 | #' will be selected for the values of grayscale. 22 | #' 23 | #' @source \url{https://tannerhelland.com/3643/grayscale-image-algorithm-vb6/} 24 | #' @source \url{https://en.wikipedia.org/wiki/Luma} 25 | #' 26 | #' @rdname clr_grayscale 27 | #' 28 | #' @return A `colors` object of the same length as `col`. 29 | #' @export 30 | #' 31 | #' @examples 32 | #' 33 | #' plot(clr_grayscale(rainbow(10))) 34 | #' 35 | #' plot(clr_grayscale(terrain.colors(10))) 36 | #' 37 | #' viridis_colors <- c( 38 | #' "#4B0055FF", "#422C70FF", "#185086FF", "#007094FF", 39 | #' "#008E98FF", "#00A890FF", "#00BE7DFF", "#6CD05EFF", 40 | #' "#BBDD38FF", "#FDE333FF" 41 | #' ) 42 | #' 43 | #' plot(clr_grayscale(viridis_colors, method = "luma")) 44 | #' plot(clr_grayscale(viridis_colors, method = "averaging")) 45 | #' plot(clr_grayscale(viridis_colors, method = "min_decomp")) 46 | #' plot(clr_grayscale(viridis_colors, method = "max_decomp")) 47 | #' plot(clr_grayscale(viridis_colors, method = "red_channel")) 48 | #' plot(clr_grayscale(viridis_colors, method = "green_channel")) 49 | #' plot(clr_grayscale(viridis_colors, method = "blue_channel")) 50 | clr_grayscale <- function(col, 51 | method = c("luma", "averaging", "min_decomp", 52 | "max_decomp", "red_channel", 53 | "green_channel", "blue_channel")) { 54 | method <- match.arg(method) 55 | 56 | col <- color(col) 57 | 58 | colors <- switch(method, 59 | luma = grayscale_luma(col), 60 | averaging = grayscale_averaging(col), 61 | min_decomp = grayscale_decomp(col, min), 62 | max_decomp = grayscale_decomp(col, max), 63 | red_channel = grayscale_channel(col, "red"), 64 | green_channel = grayscale_channel(col, "green"), 65 | blue_channel = grayscale_channel(col, "blue") 66 | ) 67 | 68 | color(colors) 69 | } 70 | 71 | #' @rdname clr_grayscale 72 | #' @export 73 | clr_greyscale <- function(col, 74 | method = c("luma", "averaging", "min_decomp", 75 | "max_decomp", "red_channel", 76 | "green_channel", "blue_channel")) { 77 | method <- match.arg(method) 78 | col <- color(col) 79 | clr_grayscale(col, method) 80 | } 81 | 82 | grayscale_averaging <- function(col) { 83 | value <- matrix(c(1 / 3, 1 / 3, 1 / 3), nrow = 1) %*% col2rgb(col) / 256 84 | rgb(value, value, value) 85 | } 86 | 87 | grayscale_luma <- function(col) { 88 | value <- matrix(c(0.2126, 0.7152, 0.0722), nrow = 1) %*% col2rgb(col) / 256 89 | rgb(value, value, value) 90 | } 91 | 92 | grayscale_decomp <- function(col, fun) { 93 | value <- apply(col2rgb(col) / 256, 2, fun) 94 | rgb(value, value, value) 95 | } 96 | 97 | grayscale_channel <- function(col, channel) { 98 | value <- (col2rgb(col) / 256)[channel, ] 99 | rgb(value, value, value) 100 | } 101 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # prismatic 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/EmilHvitfeldt/prismatic/workflows/R-CMD-check/badge.svg)](https://github.com/EmilHvitfeldt/prismatic/actions) 9 | [![Codecov test 10 | coverage](https://codecov.io/gh/EmilHvitfeldt/prismatic/branch/main/graph/badge.svg)](https://app.codecov.io/gh/EmilHvitfeldt/prismatic?branch=main) 11 | [![CRAN 12 | status](http://www.r-pkg.org/badges/version/prismatic)](https://CRAN.R-project.org/package=prismatic) 13 | [![Downloads](http://cranlogs.r-pkg.org/badges/prismatic)](https://CRAN.R-project.org/package=prismatic) 14 | [![Lifecycle: 15 | stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html) 16 | [![DOI](https://zenodo.org/badge/205078698.svg)](https://zenodo.org/record/4420786) 17 | 18 | 19 | The goal of prismatic is to provide color manipulation tools in R, in an 20 | intuitive, low-dependency and functional way. 21 | 22 | - **intuitive** All the working functions are prefixed with `clr_` 23 | (**c**o**l**o**r**) allowing for easy autocompletion. 24 | - **low-dependency** Only depends on 25 | [farver](https://github.com/thomasp85/farver). 26 | - **functional** All functions have consistent inputs and outputs and 27 | are thus fully pipeable. 28 | 29 | ## Installation 30 | 31 | You can install the released version of prismatic from 32 | [CRAN](https://CRAN.R-project.org) with: 33 | 34 | ``` r 35 | install.packages("prismatic") 36 | ``` 37 | 38 | And the development version from [GitHub](https://github.com/) with: 39 | 40 | ``` r 41 | # install.packages("devtools") 42 | devtools::install_github("EmilHvitfeldt/prismatic") 43 | ``` 44 | 45 | ## Examples 46 | 47 | All **prismatic** function return a `colors` object, which includes a 48 | new printing method and plotting method for quickly visualizing the 49 | colors. 50 | 51 | ``` r 52 | library(prismatic) 53 | 54 | terrain10 <- terrain.colors(10) 55 | 56 | terrain10 57 | #> [1] "#00A600" "#2DB600" "#63C600" "#A0D600" "#E6E600" "#E8C32E" "#EBB25E" 58 | #> [8] "#EDB48E" "#F0C9C0" "#F2F2F2" 59 | 60 | terrain_color <- color(terrain10) 61 | 62 | terrain_color 63 | #> 64 | #> #00A600FF #2DB600FF #63C600FF #A0D600FF #E6E600FF #E8C32EFF #EBB25EFF #EDB48EFF #F0C9C0FF #F2F2F2FF 65 | 66 | plot(terrain_color) 67 | ``` 68 | 69 | 70 | 71 | If [cli](https://github.com/r-lib/cli) is available the print method 72 | will do its best to represent the colors. 73 | 74 | ![](man/figures/sceenshot.png) 75 | 76 | ``` r 77 | ddd <- color(terrain.colors(10)) 78 | ddd 79 | #> 80 | #> #00A600FF #2DB600FF #63C600FF #A0D600FF #E6E600FF #E8C32EFF #EBB25EFF #EDB48EFF #F0C9C0FF #F2F2F2FF 81 | 82 | plot(ddd) 83 | ``` 84 | 85 | 86 | 87 | ``` r 88 | clr_grayscale(ddd) |> plot() 89 | ``` 90 | 91 | 92 | 93 | ``` r 94 | clr_lighten(ddd, 0.7) |> plot() 95 | ``` 96 | 97 | 98 | 99 | ``` r 100 | clr_darken(ddd, 0.5) |> plot() 101 | ``` 102 | 103 | 104 | 105 | ``` r 106 | clr_saturate(ddd, 0.5) |> plot() 107 | ``` 108 | 109 | 110 | 111 | ``` r 112 | clr_desaturate(ddd, 0.5) |> plot() 113 | ``` 114 | 115 | 116 | 117 | ``` r 118 | clr_negate(ddd) |> plot() 119 | ``` 120 | 121 | 122 | 123 | ``` r 124 | clr_rotate(ddd, 180) |> plot() 125 | ``` 126 | 127 | 128 | 129 | ``` r 130 | 131 | clr_protan(ddd) |> plot() 132 | ``` 133 | 134 | 135 | 136 | ``` r 137 | clr_tritan(ddd) |> plot() 138 | ``` 139 | 140 | 141 | 142 | ``` r 143 | clr_deutan(ddd) |> plot() 144 | ``` 145 | 146 | 147 | 148 | ## Related work 149 | 150 | This package is hugely inspired by the JavaScript library 151 | [Qix-/color](https://github.com/Qix-/color). 152 | 153 | ## Code of Conduct 154 | 155 | Please note that the **prismatic** project is released with a 156 | [Contributor Code of 157 | Conduct](https://github.com/EmilHvitfeldt/prismatic/blob/main/CODE_OF_CONDUCT.md). 158 | By contributing to this project, you agree to abide by its terms. 159 | -------------------------------------------------------------------------------- /tests/testthat/test-color-blindness.R: -------------------------------------------------------------------------------- 1 | test_that("clr_deutan() preserves length", { 2 | expect_length(clr_deutan(rainbow(0)), 0) 3 | expect_length(clr_deutan(rainbow(1)), 1) 4 | expect_length(clr_deutan(rainbow(10)), 10) 5 | }) 6 | 7 | test_that("clr_protan() preserves length", { 8 | expect_length(clr_protan(rainbow(0)), 0) 9 | expect_length(clr_protan(rainbow(1)), 1) 10 | expect_length(clr_protan(rainbow(10)), 10) 11 | }) 12 | 13 | test_that("clr_tritan() preserves length", { 14 | expect_length(clr_tritan(rainbow(0)), 0) 15 | expect_length(clr_tritan(rainbow(1)), 1) 16 | expect_length(clr_tritan(rainbow(10)), 10) 17 | }) 18 | 19 | test_that("clr_deutan()'s output has colors class", { 20 | expect_s3_class(clr_deutan(rainbow(10)), "colors") 21 | }) 22 | 23 | test_that("clr_protan()'s output has colors class", { 24 | expect_s3_class(clr_protan(rainbow(10)), "colors") 25 | }) 26 | 27 | test_that("clr_tritan()'s output has colors class", { 28 | expect_s3_class(clr_tritan(rainbow(10)), "colors") 29 | }) 30 | 31 | test_that("clr_deutan() complains when `col` is wrong", { 32 | expect_error(clr_deutan("not a color")) 33 | expect_error(clr_deutan(list(pal = "#000000"))) 34 | }) 35 | 36 | test_that("clr_protan() complains when `col` is wrong", { 37 | expect_error(clr_protan("not a color")) 38 | expect_error(clr_protan(list(pal = "#000000"))) 39 | }) 40 | 41 | test_that("clr_tritan() complains when `col` is wrong", { 42 | expect_error(clr_tritan("not a color")) 43 | expect_error(clr_tritan(list(pal = "#000000"))) 44 | }) 45 | 46 | test_that("clr_deutan() if the length of `severity` isn't 1", { 47 | expect_visible(clr_deutan(rainbow(10), rep(1, 1))) 48 | expect_error( 49 | clr_deutan(rainbow(10), seq(0, 1, length.out = 2)), 50 | "`severity` must be of length 1." 51 | ) 52 | expect_error( 53 | clr_deutan(rainbow(10), seq(0, 1, length.out = 3)), 54 | "`severity` must be of length 1." 55 | ) 56 | expect_error( 57 | clr_deutan(rainbow(10), seq(0, 1, length.out = 10)), 58 | "`severity` must be of length 1." 59 | ) 60 | }) 61 | 62 | test_that("clr_protan() if the length of `severity` isn't 1", { 63 | expect_visible(clr_protan(rainbow(10), rep(1, 1))) 64 | expect_error( 65 | clr_protan(rainbow(10), seq(0, 1, length.out = 2)), 66 | "`severity` must be of length 1." 67 | ) 68 | expect_error( 69 | clr_protan(rainbow(10), seq(0, 1, length.out = 3)), 70 | "`severity` must be of length 1." 71 | ) 72 | expect_error( 73 | clr_protan(rainbow(10), seq(0, 1, length.out = 10)), 74 | "`severity` must be of length 1." 75 | ) 76 | }) 77 | 78 | test_that("clr_tritan() if the length of `severity` isn't 1", { 79 | expect_visible(clr_tritan(rainbow(10), rep(1, 1))) 80 | expect_error( 81 | clr_tritan(rainbow(10), seq(0, 1, length.out = 2)), 82 | "`severity` must be of length 1." 83 | ) 84 | expect_error( 85 | clr_tritan(rainbow(10), seq(0, 1, length.out = 3)), 86 | "`severity` must be of length 1." 87 | ) 88 | expect_error( 89 | clr_tritan(rainbow(10), seq(0, 1, length.out = 10)), 90 | "`severity` must be of length 1." 91 | ) 92 | }) 93 | 94 | test_that("clr_deutan() setting `severity` outside range gives error", { 95 | expect_error( 96 | clr_deutan(rainbow(10), severity = -1), "`severity` must be between 0 and 1." 97 | ) 98 | expect_error( 99 | clr_deutan(rainbow(10), severity = 2), "`severity` must be between 0 and 1." 100 | ) 101 | }) 102 | 103 | test_that("clr_protan() setting `severity` outside range gives error", { 104 | expect_error( 105 | clr_protan(rainbow(10), severity = -1), "`severity` must be between 0 and 1." 106 | ) 107 | expect_error( 108 | clr_protan(rainbow(10), severity = 2), "`severity` must be between 0 and 1." 109 | ) 110 | }) 111 | 112 | test_that("clr_tritan() setting `severity` outside range gives error", { 113 | expect_error( 114 | clr_tritan(rainbow(10), severity = -1), "`severity` must be between 0 and 1." 115 | ) 116 | expect_error( 117 | clr_tritan(rainbow(10), severity = 2), "`severity` must be between 0 and 1." 118 | ) 119 | }) 120 | 121 | test_that("clr_deutan() setting `severity = 0` leaves input unchanged", { 122 | expect_equal_color(clr_deutan(rainbow(10), 0), color(rainbow(10)), 0) 123 | }) 124 | 125 | test_that("clr_protan() setting `severity = 0` leaves input unchanged", { 126 | expect_equal_color(clr_protan(rainbow(10), 0), color(rainbow(10)), 0) 127 | }) 128 | 129 | test_that("clr_tritan() setting `severity = 0` leaves input unchanged", { 130 | expect_equal_color(clr_tritan(rainbow(10), 0), color(rainbow(10)), 0) 131 | }) 132 | 133 | test_that("plotting returns the data invisibly", { 134 | res <- expect_invisible(check_color_blindness(c("#D3D5D0", "#76716E"))) 135 | expect_equal(res, c("#D3D5D0", "#76716E")) 136 | }) 137 | -------------------------------------------------------------------------------- /tests/testthat/test-lightness.R: -------------------------------------------------------------------------------- 1 | test_that("clr_lighten() preserves length", { 2 | expect_length(clr_lighten(rainbow(0), space = "HSL"), 0) 3 | expect_length(clr_lighten(rainbow(1), space = "HSL"), 1) 4 | expect_length(clr_lighten(rainbow(10), space = "HSL"), 10) 5 | expect_length(clr_lighten(rainbow(0), space = "HCL"), 0) 6 | expect_length(clr_lighten(rainbow(1), space = "HCL"), 1) 7 | expect_length(clr_lighten(rainbow(10), space = "HCL"), 10) 8 | expect_length(clr_lighten(rainbow(0), space = "combined"), 0) 9 | expect_length(clr_lighten(rainbow(1), space = "combined"), 1) 10 | expect_length(clr_lighten(rainbow(10), space = "combined"), 10) 11 | }) 12 | 13 | test_that("clr_darken() preserves length", { 14 | expect_length(clr_darken(rainbow(0), space = "HSL"), 0) 15 | expect_length(clr_darken(rainbow(1), space = "HSL"), 1) 16 | expect_length(clr_darken(rainbow(10), space = "HSL"), 10) 17 | expect_length(clr_darken(rainbow(0), space = "HCL"), 0) 18 | expect_length(clr_darken(rainbow(1), space = "HCL"), 1) 19 | expect_length(clr_darken(rainbow(10), space = "HCL"), 10) 20 | expect_length(clr_darken(rainbow(0), space = "combined"), 0) 21 | expect_length(clr_darken(rainbow(1), space = "combined"), 1) 22 | expect_length(clr_darken(rainbow(10), space = "combined"), 10) 23 | }) 24 | 25 | test_that("clr_lighten()'s output has colors class", { 26 | expect_s3_class(clr_lighten(rainbow(10), space = "HSL"), "colors") 27 | expect_s3_class(clr_lighten(rainbow(10), space = "HCL"), "colors") 28 | expect_s3_class(clr_lighten(rainbow(10), space = "combined"), "colors") 29 | }) 30 | 31 | test_that("clr_darken()'s output has colors class", { 32 | expect_s3_class(clr_darken(rainbow(10), space = "HSL"), "colors") 33 | expect_s3_class(clr_darken(rainbow(10), space = "HCL"), "colors") 34 | expect_s3_class(clr_darken(rainbow(10), space = "combined"), "colors") 35 | }) 36 | 37 | test_that("clr_lighten() complains when `col` is wrong", { 38 | expect_error(clr_lighten("not a color")) 39 | expect_error(clr_lighten(list(pal = "#000000"))) 40 | }) 41 | 42 | test_that("clr_darken() complains when `col` is wrong", { 43 | expect_error(clr_darken("not a color")) 44 | expect_error(clr_darken(list(pal = "#000000"))) 45 | }) 46 | 47 | test_that("clr_lighten() if the length of `shift` isn't 1", { 48 | expect_visible(clr_lighten(rainbow(10), rep(1, 1))) 49 | expect_visible(clr_lighten(rainbow(10), seq(0, 1, length.out = 10))) 50 | expect_error( 51 | clr_lighten(rainbow(10), seq(0, 1, length.out = 2)), 52 | "`shift` must be of length 1 or the same length as `col`." 53 | ) 54 | expect_error( 55 | clr_lighten(rainbow(10), seq(0, 1, length.out = 3)), 56 | "`shift` must be of length 1 or the same length as `col`." 57 | ) 58 | }) 59 | 60 | test_that("clr_darken() if the length of `shift` isn't 1", { 61 | expect_visible(clr_darken(rainbow(10), rep(1, 1))) 62 | expect_visible(clr_darken(rainbow(10), seq(0, 1, length.out = 10))) 63 | expect_error( 64 | clr_darken(rainbow(10), seq(0, 1, length.out = 2)), 65 | "`shift` must be of length 1 or the same length as `col`." 66 | ) 67 | expect_error( 68 | clr_darken(rainbow(10), seq(0, 1, length.out = 3)), 69 | "`shift` must be of length 1 or the same length as `col`." 70 | ) 71 | }) 72 | 73 | test_that("clr_lighten() setting `shift = 0` leaves input unchanged", { 74 | expect_equal_color( 75 | clr_lighten(rainbow(10), 0, space = "HSL"), color(rainbow(10)), 0 76 | ) 77 | expect_equal_color( 78 | clr_lighten(rainbow(10), 0, space = "HCL"), color(rainbow(10)), 0 79 | ) 80 | expect_equal_color( 81 | clr_lighten(rainbow(10), 0, space = "combined"), color(rainbow(10)), 0 82 | ) 83 | }) 84 | 85 | test_that("clr_darken() setting `shift = 0` leaves input unchanged", { 86 | expect_equal_color( 87 | clr_darken(rainbow(10), 0, space = "HSL"), color(rainbow(10)), 0 88 | ) 89 | expect_equal_color( 90 | clr_darken(rainbow(10), 0, space = "HCL"), color(rainbow(10)), 0 91 | ) 92 | expect_equal_color( 93 | clr_darken(rainbow(10), 0, space = "combined"), color(rainbow(10)), 0 94 | ) 95 | }) 96 | 97 | test_that("setting `shift = 1` leaves result complete black or white", { 98 | expect_equal(clr_lighten(rainbow(10), shift = 1), color(rep("white", 10))) 99 | expect_equal(clr_darken(rainbow(10), shift = 1), color(rep("black", 10))) 100 | 101 | expect_equal_color( 102 | clr_lighten(rainbow(10), shift = 1, space = "HCL"), 103 | color(rep("white", 10)), 104 | 0 105 | ) 106 | 107 | expect_equal( 108 | clr_darken(rainbow(10), shift = 1, space = "HCL"), 109 | color(rep("black", 10)) 110 | ) 111 | 112 | expect_equal_color( 113 | clr_lighten(rainbow(10), shift = 1, space = "combined"), 114 | color(rep("white", 10)), 115 | 0 116 | ) 117 | 118 | expect_equal( 119 | clr_darken(rainbow(10), shift = 1, space = "combined"), 120 | color(rep("black", 10)) 121 | ) 122 | }) 123 | 124 | -------------------------------------------------------------------------------- /R/color-blindness.R: -------------------------------------------------------------------------------- 1 | #' Simulate color vision deficiency 2 | #' 3 | #' @details The matrices used to perform transformations have been taken as the 4 | #' 1.0 value in table 1 in 5 | #' \url{http://www.inf.ufrgs.br/~oliveira/pubs_files/CVD_Simulation/CVD_Simulation.html}. 6 | #' Values for `severity` values between 0 and 1 will be linearly interpolated. 7 | #' 8 | #' @rdname colorblindness 9 | #' 10 | #' @inheritParams color 11 | #' @param severity A numeric indicating the severity of the color vision defect. 12 | #' Must be a number between 0 and 1, where 0 means no deficiency, and 1 means 13 | #' complete deficiency. Defaults to 1. 14 | #' 15 | #' @return A `colors` object of the same length as `col`. 16 | #' @export 17 | #' 18 | #' @source \url{http://www.inf.ufrgs.br/~oliveira/pubs_files/CVD_Simulation/CVD_Simulation.html} 19 | #' 20 | #' @references 21 | #' Gustavo M. Machado, Manuel M. Oliveira, and Leandro A. F. Fernandes "A 22 | #' Physiologically-based Model for Simulation of Color Vision Deficiency". IEEE 23 | #' Transactions on Visualization and Computer Graphics. Volume 15 (2009), 24 | #' Number 6, November/December 2009. pp. 1291-1298. 25 | #' 26 | #' @examples 27 | #' rainbow_colors <- color(rainbow(10)) 28 | #' 29 | #' plot(clr_protan(rainbow_colors)) 30 | #' plot(clr_deutan(rainbow_colors)) 31 | #' plot(clr_tritan(rainbow_colors)) 32 | #' 33 | #' viridis_colors <- c( 34 | #' "#4B0055FF", "#422C70FF", "#185086FF", "#007094FF", 35 | #' "#008E98FF", "#00A890FF", "#00BE7DFF", "#6CD05EFF", 36 | #' "#BBDD38FF", "#FDE333FF" 37 | #' ) 38 | #' 39 | #' plot(clr_protan(viridis_colors)) 40 | #' plot(clr_deutan(viridis_colors)) 41 | #' plot(clr_tritan(viridis_colors)) 42 | clr_protan <- function(col, severity = 1) { 43 | check_severity_range(severity) 44 | if (!(length(severity) == 1)) { 45 | stop("`severity` must be of length 1.") 46 | } 47 | 48 | col <- color(col) 49 | 50 | rgb <- decode_colour(col) %*% 51 | t((diag(3) * (1 - severity) + protan_matrix * (severity))) 52 | color(encode_colour(rgb_norm(rgb))) 53 | } 54 | 55 | #' @rdname colorblindness 56 | #' @export 57 | clr_deutan <- function(col, severity = 1) { 58 | check_severity_range(severity) 59 | if (!(length(severity) == 1)) { 60 | stop("`severity` must be of length 1.") 61 | } 62 | 63 | col <- color(col) 64 | 65 | rgb <- decode_colour(col) %*% 66 | t((diag(3) * (1 - severity) + deutan_matrix * (severity))) 67 | color(encode_colour(rgb_norm(rgb))) 68 | } 69 | 70 | #' @rdname colorblindness 71 | #' @export 72 | clr_tritan <- function(col, severity = 1) { 73 | check_severity_range(severity) 74 | if (!(length(severity) == 1)) { 75 | stop("`severity` must be of length 1.") 76 | } 77 | 78 | col <- color(col) 79 | 80 | rgb <- decode_colour(col) %*% 81 | t((diag(3) * (1 - severity) + tritan_matrix * (severity))) 82 | color(encode_colour(rgb_norm(rgb))) 83 | } 84 | 85 | check_severity_range <- function(x) { 86 | if (!all(x >= 0 & x <= 1)) { 87 | stop("`severity` must be between 0 and 1.") 88 | } 89 | } 90 | 91 | protan_matrix <- matrix( 92 | nrow = 3, byrow = TRUE, 93 | c( 94 | 0.152286, 1.052583, -0.204868, 95 | 0.114503, 0.786281, 0.099216, 96 | -0.003882, -0.048116, 1.051998 97 | ) 98 | ) 99 | 100 | deutan_matrix <- matrix( 101 | nrow = 3, byrow = TRUE, 102 | c( 103 | 0.367322, 0.860646, -0.227968, 104 | 0.280085, 0.672501, 0.047413, 105 | -0.011820, 0.042940, 0.968881 106 | ) 107 | ) 108 | 109 | tritan_matrix <- matrix( 110 | nrow = 3, byrow = TRUE, 111 | c( 112 | 1.255528, -0.076749, -0.178779, 113 | -0.078411, 0.930809, 0.147602, 114 | 0.004733, 0.691367, 0.303900 115 | ) 116 | ) 117 | 118 | #' Visualize color vision deficiency 119 | #' 120 | #' `check_color_blindness()` will showcase the effect of the three kinds of 121 | #' color vision deficiency, Deuteranopia, Protanopia, and Tritanopia, at the 122 | #' same time side by side in a plot. 123 | #' 124 | #' @inheritParams color 125 | #' 126 | #' @return Invisibly `col`. 127 | #' @export 128 | #' 129 | #' @examples 130 | #' check_color_blindness(rainbow(10)) 131 | #' 132 | #' check_color_blindness(terrain.colors(10)) 133 | check_color_blindness <- function(col) { 134 | plot(NULL, 135 | xlim = c(-0.1, 4.1), ylim = c(0, length(col) + 2), 136 | xaxs = "i", yaxs = "i", mar = rep(0, 4), axes = FALSE, ann = FALSE 137 | ) 138 | 139 | rect( 140 | ybottom = seq_along(col) - 0.5, ytop = seq_along(col) + 0.5, 141 | xleft = 3.1, xright = 3.9, col = clr_tritan(col), border = NA 142 | ) 143 | rect( 144 | ybottom = seq_along(col) - 0.5, ytop = seq_along(col) + 0.5, 145 | xleft = 2.1, xright = 2.9, col = clr_protan(col), border = NA 146 | ) 147 | rect( 148 | ybottom = seq_along(col) - 0.5, ytop = seq_along(col) + 0.5, 149 | xleft = 1.1, xright = 1.9, col = clr_deutan(col), border = NA 150 | ) 151 | rect( 152 | ybottom = seq_along(col) - 0.5, ytop = seq_along(col) + 0.5, 153 | xleft = 0.1, xright = 0.9, col = col, border = NA 154 | ) 155 | 156 | rect(ybottom = 0.5, xleft = 0.1, ytop = length(col) + 0.5, xright = 0.9) 157 | rect(ybottom = 0.5, xleft = 1.1, ytop = length(col) + 0.5, xright = 1.9) 158 | rect(ybottom = 0.5, xleft = 2.1, ytop = length(col) + 0.5, xright = 2.9) 159 | rect(ybottom = 0.5, xleft = 3.1, ytop = length(col) + 0.5, xright = 3.9) 160 | 161 | text( 162 | x = 1:4 - 0.5, y = length(col) + 1, 163 | labels = c("Normal", "Deuteranopia", "Protanopia", "Tritanopia") 164 | ) 165 | 166 | invisible(col) 167 | } 168 | 169 | -------------------------------------------------------------------------------- /R/extract.R: -------------------------------------------------------------------------------- 1 | #' Extract RGB components 2 | #' 3 | #' Extract the red, green, or blue color components from a vector of colors. 4 | #' 5 | #' @inheritParams color 6 | #' 7 | #' @name extract_rgba 8 | #' @rdname extract_rgba 9 | #' 10 | #' @details 11 | #' The values of the output will range between 0 and 255. 12 | #' 13 | #' Use [clr_extract()] if you are planning to extract multiple components. 14 | #' 15 | #' @family Extraction 16 | #' 17 | #' @return A numeric vector giving the extracted values. 18 | #' @export 19 | #' 20 | #' @examples 21 | #' clr_extract_red(rainbow(100)) 22 | #' clr_extract_green(rainbow(100)) 23 | #' clr_extract_blue(rainbow(100)) 24 | #' clr_extract_alpha(rainbow(100)) 25 | NULL 26 | 27 | #' @rdname extract_rgba 28 | #' @export 29 | clr_extract_red <- function(col) { 30 | col <- color(col) 31 | extract_rgba(col)[["red"]] 32 | } 33 | 34 | #' @rdname extract_rgba 35 | #' @export 36 | clr_extract_green <- function(col) { 37 | col <- color(col) 38 | extract_rgba(col)[["green"]] 39 | } 40 | 41 | #' @rdname extract_rgba 42 | #' @export 43 | clr_extract_blue <- function(col) { 44 | col <- color(col) 45 | extract_rgba(col)[["blue"]] 46 | } 47 | 48 | #' @rdname extract_rgba 49 | #' @export 50 | clr_extract_alpha <- function(col) { 51 | col <- color(col) 52 | extract_rgba(col)[["alpha"]] 53 | } 54 | 55 | extract_rgba <- function(col) { 56 | as.data.frame(t(col2rgb(col, alpha = TRUE))) 57 | } 58 | 59 | #' Extract HSL components 60 | #' 61 | #' Extract the hue, saturation, or lightness color components from a vector of 62 | #' colors. 63 | #' 64 | #' @inheritParams color 65 | #' @param space A character string specifying the color space where hue is 66 | #' extracted from. Can be either "HCL" or "HSL" (default). 67 | #' 68 | #' @rdname extract_hsl 69 | #' 70 | #' @details 71 | #' The range of the value are: 72 | #' 73 | #' - From 0 to 360 for hue. This in a circular fashion such that 0 and 360 are 74 | #' near identical. 0 is red. 75 | #' - From 0 to 100 for saturation where 100 is full saturation and 0 is no 76 | #' saturation. 77 | #' - From 0 to 100 for lightness where 100 is full lightness and 0 is no 78 | #' lightness. 79 | #' 80 | #' Use [clr_extract()] if you are planning to extraction multiple components. 81 | #' 82 | #' @family Extraction 83 | #' 84 | #' @return Numeric vector of values. 85 | #' @export 86 | #' 87 | #' @examples 88 | #' clr_extract_hue(rainbow(100), "HSL") 89 | #' clr_extract_saturation(rainbow(100)) 90 | #' clr_extract_lightness(rainbow(100)) 91 | clr_extract_hue <- function(col, space = c("HSL", "HCL")) { 92 | space <- match.arg(space) 93 | 94 | col <- color(col) 95 | switch(space, 96 | HSL = extract_hsl(col)[["hue_hsl"]], 97 | HCL = extract_hcl(col)[["hue_hcl"]] 98 | ) 99 | } 100 | 101 | #' @rdname extract_hsl 102 | #' @export 103 | clr_extract_saturation <- function(col) { 104 | col <- color(col) 105 | extract_hsl(col)[["saturation"]] 106 | } 107 | 108 | #' @rdname extract_hsl 109 | #' @export 110 | clr_extract_lightness <- function(col) { 111 | col <- color(col) 112 | extract_hsl(col)[["lightness"]] 113 | } 114 | 115 | extract_hsl <- function(col) { 116 | hsl <- decode_colour(col, to = "hsl") 117 | new_names <- c("h" = "hue_hsl", "s" = "saturation", "l" = "lightness") 118 | hsl <- as.data.frame(hsl) 119 | names(hsl) <- new_names[names(hsl)] 120 | hsl 121 | } 122 | 123 | #' Extract HCL components 124 | #' 125 | #' Extract the hue, chroma, or luminance color components from a vector of 126 | #' colors. 127 | #' 128 | #' @inheritParams color 129 | #' 130 | #' @rdname extract_hcl 131 | #' 132 | #' @details 133 | #' The range of the value are: 134 | #' 135 | #' - Hue is ranging from 0 to 360. 136 | #' - Luminance is ranging from 0 to 100. 137 | #' - Chroma, while dependent on hue and luminance, will roughly be within 0 and 138 | #' 180. 139 | #' 140 | #' Use [clr_extract()] if you are planning to extraction multiple components. 141 | #' 142 | #' @family Extraction 143 | #' 144 | #' @return Numeric vector of values. 145 | #' @export 146 | #' 147 | #' @examples 148 | #' clr_extract_hue(rainbow(100), "HCL") 149 | #' clr_extract_chroma(rainbow(100)) 150 | #' clr_extract_luminance(rainbow(100)) 151 | clr_extract_chroma <- function(col) { 152 | col <- color(col) 153 | extract_hcl(col)[["chroma"]] 154 | } 155 | 156 | #' @rdname extract_hsl 157 | #' @export 158 | clr_extract_luminance <- function(col) { 159 | col <- color(col) 160 | extract_hcl(col)[["luminance"]] 161 | } 162 | 163 | extract_hcl <- function(col) { 164 | hcl <- decode_colour(col, to = "hcl") 165 | new_names <- c("h" = "hue_hcl", "c" = "chroma", "l" = "luminance") 166 | hcl <- as.data.frame(hcl) 167 | names(hcl) <- new_names[names(hcl)] 168 | hcl 169 | } 170 | 171 | #' Extract multiple components 172 | #' 173 | #' Extract multiple color components at the same time. 174 | #' 175 | #' @inheritParams color 176 | #' @param components A character vector of components that should be extracted. 177 | #' See *Details* for allowed components. 178 | #' 179 | #' @details 180 | #' The allowed values for `components` are: 181 | #' 182 | #' - red 183 | #' - green 184 | #' - blue 185 | #' - hue_hsl 186 | #' - saturation 187 | #' - lightness 188 | #' - hue_hcl 189 | #' - chroma 190 | #' - luminance 191 | #' 192 | #' `clr_extract()` is to be preferred over other extraction functions if you 193 | #' need to extract multiple components at the same time, since it doesn't 194 | #' repeat transformations. 195 | #' 196 | #' @family Extraction 197 | #' 198 | #' @return A [data.frame] of components. 199 | #' @export 200 | #' 201 | #' @examples 202 | #' clr_extract(rainbow(10)) 203 | #' 204 | #' clr_extract(rainbow(10), c("hue_hsl", "saturation")) 205 | clr_extract <- function(col, 206 | components = c("red", "green", "blue", "hue_hsl", 207 | "saturation", "lightness", "hue_hcl", 208 | "chroma", "luminance")) { 209 | components <- match.arg(components, several.ok = TRUE) 210 | col <- color(col) 211 | cbind( 212 | extract_rgba(col), 213 | extract_hsl(col), 214 | extract_hcl(col) 215 | )[components] 216 | } 217 | -------------------------------------------------------------------------------- /R/lightness.R: -------------------------------------------------------------------------------- 1 | #' Make a color lighter 2 | #' 3 | #' @details The colors will be transformed to HSL color space (hue, saturation, 4 | #' lightness) where the lightness of the color will be modified. The lightness 5 | #' of a color takes a value between 0 and 1, with 0 being black and 1 being 6 | #' white. `shift` takes a value between 0 and 1, where 0 means the lightness 7 | #' stays unchanged and 1 means completely white. As an example, if the lightness 8 | #' of the color is 0.6 and `shift` is 0.5, the lightness will be set to the 9 | #' halfway point between 0.6 and 1 which is 0.8. 10 | #' 11 | #' @details If `space = "HSL"` then the colors are transformed to HSL space where 12 | #' the lightness value L is adjusted. If `space = "HCL"` then the colors are 13 | #' transformed to Cylindrical HCL space where the luminance value L is adjusted. 14 | #' If `space = "combined"` then the colors are transformed into HSL and 15 | #' Cylindrical HCL space. Where the color adjusting is happening HLS is copied 16 | #' to the values in the HCL transformation. Thus, the "combined" transformation 17 | #' adjusts the luminance in HCL space and chroma in HSL space. For more 18 | #' information regarding use of color spaces, please refer to the colorspace 19 | #' paper \url{https://arxiv.org/abs/1903.06490}. 20 | #' 21 | #' @source \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 22 | #' @source \url{https://en.wikipedia.org/wiki/CIELUV} 23 | #' @source \url{https://arxiv.org/abs/1903.06490} 24 | #' 25 | #' @inheritParams color 26 | #' @param shift A number between 0 and 1. 0 will do zero lightening, and 1 will 27 | #' do complete lightening, turning the color to white. Defaults to 0.5. 28 | #' @param space A character string specifying the color space in which adjustment 29 | #' happens. Can be either "HCL", "HSL" or "combined". Defaults to "HCL". 30 | #' 31 | #' @return A `colors` object of the same length as `col`. 32 | #' @export 33 | #' 34 | #' @seealso [clr_darken()] 35 | #' @examples 36 | #' # Using linear shift 37 | #' plot(clr_lighten(rep("red", 11), shift = seq(0, 1, 0.1))) 38 | #' plot(clr_lighten(rep("red", 11), shift = seq(0, 1, 0.1), space = "HSL")) 39 | #' plot(clr_lighten(rep("red", 11), shift = seq(0, 1, 0.1), space = "combined")) 40 | #' 41 | #' plot(clr_lighten(terrain.colors(10))) 42 | #' 43 | #' # Using exponential shifts 44 | #' plot(clr_lighten(rep("red", 11), shift = log(seq(1, exp(1), length.out = 11)))) 45 | #' 46 | clr_lighten <- function(col, shift = 0.5, space = c("HCL", "HSL", "combined")) { 47 | if (!(length(shift) == 1 || (length(shift) == length(col)))) { 48 | stop("`shift` must be of length 1 or the same length as `col`.") 49 | } 50 | 51 | if (all(shift == 0)) { 52 | return(col) 53 | } 54 | 55 | space <- match.arg(space) 56 | 57 | col <- color(col) 58 | 59 | if (space == "HSL") { 60 | hsl <- decode_colour(col, to = "hsl") 61 | 62 | hsl[, "l"] <- pro_transform(hsl[, "l"], (shift >= 0) * 100, abs(shift)) 63 | 64 | rgb <- convert_colour(hsl, "hsl", "rgb") 65 | } else if (space == "HCL") { 66 | hcl <- decode_colour(col, to = "hcl") 67 | 68 | hcl[, "l"] <- pmin(100, pmax(0, hcl[, "l"])) 69 | hcl[, "l"] <- (shift >= 0) * (100 - (100 - hcl[, "l"]) * (1 - shift)) + 70 | (shift < 0) * hcl[, "l"] * (1 + shift) 71 | hcl[, "l"] <- pmin(100, pmax(0, hcl[, "l"])) 72 | hcl[, "c"] <- pmin( 73 | max_chroma(hcl[, "h"], hcl[, "l"], floor = TRUE), 74 | pmax(0, hcl[, "c"]) 75 | ) 76 | 77 | rgb <- convert_colour(hcl, "hcl", "rgb") 78 | } else { 79 | hsl <- decode_colour(col, to = "hsl") 80 | hsl[, "l"] <- (shift >= 0) * (1 - (1 - hsl[, "l"]) * 81 | (1 - shift)) + (shift < 0) * hsl[, "l"] * (1 + shift) 82 | hsl[, "l"] <- pmin(100, pmax(0, hsl[, "l"])) 83 | 84 | hcl <- decode_colour(col, to = "hcl") 85 | hcl[, "l"] <- pmin(100, pmax(0, hcl[, "l"])) 86 | hcl[, "l"] <- (shift >= 0) * (100 - (100 - hcl[, "l"]) * (1 - shift)) + 87 | (shift < 0) * hcl[, "l"] * (1 + shift) 88 | hcl[, "l"] <- pmin(100, pmax(0, hcl[, "l"])) 89 | hcl[, "c"] <- convert_colour(hsl, "hsl", "hcl")[, "c"] 90 | hcl[, "c"] <- pmin( 91 | max_chroma(hcl[, "h"], hcl[, "l"], floor = TRUE), 92 | hcl[, "c"] 93 | ) 94 | 95 | rgb <- convert_colour(hcl, "hcl", "rgb") 96 | } 97 | color(encode_colour(rgb_norm(rgb))) 98 | } 99 | 100 | 101 | #' Make a color darker 102 | #' 103 | #' @details The colors will be transformed to HSL color space (hue, saturation, 104 | #' lightness) where the lightness of the color will be modified. The lightness 105 | #' of a color takes a value between 0 and 1, with 0 being black and 1 being 106 | #' white. `shift` takes a value between 0 and 1, where 0 means that the 107 | #' lightness stays unchanged and 1 means completely black. As an example, if 108 | #' the lightness of the color is 0.6 and `shift` is 0.5, then the lightness 109 | #' will be set to the halfway point between 0.6 and 0, which is 0.3. 110 | #' 111 | #' @details If `space = "HSL"` then the colors are transformed to HSL space where 112 | #' the lightness value L is adjusted. If `space = "HCL"` then the colors are 113 | #' transformed to Cylindrical HCL space where the luminance value L is adjusted. 114 | #' If `space = "combined"` then the colors are transformed into HSL and 115 | #' Cylindrical HCL space. Where the color adjusting is happening HSL is copied 116 | #' to the values in the HCL transformation. Thus the "combined" transformation 117 | #' adjusts the luminance in HCL space and chroma in HSL space. For more 118 | #' information regarding use of color spaces, please refer to the colorspace 119 | #' paper \url{https://arxiv.org/abs/1903.06490}. 120 | #' 121 | #' @source \url{https://en.wikipedia.org/wiki/HSL_and_HSV} 122 | #' @source \url{https://en.wikipedia.org/wiki/CIELUV} 123 | #' @source \url{https://arxiv.org/abs/1903.06490} 124 | #' 125 | #' @inheritParams color 126 | #' @inheritParams clr_lighten 127 | #' @param shift A number between 0 and 1. 0 will do zero darkening, and 1 will 128 | #' do complete darkening, turning the color to black. Defaults to 0.5. 129 | #' 130 | #' @return A `color` object of the same length as `col`. 131 | #' @export 132 | #' 133 | #' @seealso [clr_lighten()] 134 | #' @examples 135 | #' # Using linear shift 136 | #' plot(clr_darken(rep("red", 11), shift = seq(0, 1, 0.1))) 137 | #' plot(clr_darken(rep("red", 11), shift = seq(0, 1, 0.1), space = "HSL")) 138 | #' plot(clr_darken(rep("red", 11), shift = seq(0, 1, 0.1), space = "combined")) 139 | #' 140 | #' plot(clr_darken(terrain.colors(10))) 141 | #' 142 | #' # Using exponential shifts 143 | #' plot(clr_darken(rep("red", 11), shift = log(seq(1, exp(1), length.out = 11)))) 144 | #' 145 | clr_darken <- function(col, shift = 0.5, space = c("HCL", "HSL", "combined")) { 146 | clr_lighten(col, -1 * shift, space) 147 | } 148 | 149 | max_chroma <- function(h, l, floor = FALSE) { 150 | n <- max(c(length(h), length(l))) 151 | h <- rep_len(h, n) 152 | l <- rep_len(l, n) 153 | while (any(h < 0)) { 154 | h[h < 0] <- h[h < 0] + 360 155 | } 156 | while (any(h >= 360)) { 157 | h[h >= 360] <- h[h >= 360] - 360 158 | } 159 | l <- pmin(100, pmax(0, l)) 160 | hmin <- floor(h + 1e-08) 161 | hmax <- ceiling(h + 1e-08) 162 | lmin <- floor(l + 1e-08) 163 | lmax <- ceiling(l + 1e-08) 164 | cc <- (hmax - h) * (lmax - l) * 165 | max_chroma_table[paste(hmin, lmin, sep = "-")] + (hmax - h) * (l - lmin) * 166 | max_chroma_table[paste(hmin, lmax, sep = "-")] + (h - hmin) * (lmax - l) * 167 | max_chroma_table[paste(hmax, lmin, sep = "-")] + (h - hmin) * (l - lmin) * 168 | max_chroma_table[paste(hmax, lmax, sep = "-")] 169 | cc <- as.numeric(cc) 170 | cc[l <= 0 | l >= 100] <- 0 171 | if (floor) { 172 | cc <- floor(cc) 173 | } 174 | cc 175 | } 176 | 177 | --------------------------------------------------------------------------------