pax_global_header00006660000000000000000000000064141131620420014504gustar00rootroot0000000000000052 comment=5777b6be2e33dddf8531fc22c48ff4646a479d69 r-cran-shades-1.4.0/000077500000000000000000000000001411316204200141355ustar00rootroot00000000000000r-cran-shades-1.4.0/DESCRIPTION000066400000000000000000000011321411316204200156400ustar00rootroot00000000000000Package: shades Version: 1.4.0 Date: 2019-08-02 Title: Simple Colour Manipulation Author: Jon Clayden Maintainer: Jon Clayden Description: Functions for easily manipulating colours, creating colour scales and calculating colour distances. Suggests: testthat, covr, ggplot2 Enhances: colorspace Encoding: UTF-8 License: BSD_3_clause + file LICENCE URL: https://github.com/jonclayden/shades BugReports: https://github.com/jonclayden/shades/issues RoxygenNote: 6.1.1 NeedsCompilation: no Packaged: 2019-08-02 14:53:11 UTC; jon Repository: CRAN Date/Publication: 2019-08-02 16:00:02 UTC r-cran-shades-1.4.0/LICENCE000066400000000000000000000001211411316204200151140ustar00rootroot00000000000000YEAR: 2019 COPYRIGHT HOLDER: Jon Clayden ORGANIZATION: University College London r-cran-shades-1.4.0/MD5000066400000000000000000000047511411316204200144540ustar00rootroot00000000000000be44176ff6116021341e60ef86e4a114 *DESCRIPTION b836f7cb04510360aee66dd8dd92981b *LICENCE 4d391197cafd1ca8a46684e16a9bf6a8 *NAMESPACE ca54447ee202c839698662455b9302a0 *NEWS 2bbc1f893ab7f33e705672af28d7af3c *R/adaptation.R edd993008976060aaebfedc5290d9e29 *R/distance.R 7e0feaa5676829016ddd425f228cf25d *R/mixtures.R d1c65b53f36997a733efd3b125cc5dc1 *R/properties.R b6a0910c10a8f4e4d5f3b21e7ae517bb *R/scales.R 814eaac01f9b6857fd7a518bca80c1ee *R/shade.R 35b23360ffba0fd97bab541618902b7a *R/swatch.R b22f4a24caca5f4387a67677876316bb *R/zzz.R f3b184d0fd2d32553efc05445ee9e260 *README.md 3f100fb1f9d9365df02649b02e120386 *man/complement.Rd 3ed050d58953fbddadfdbe65422b8186 *man/coords.Rd 67745c0b6fef6ab97a6118cce7f47d96 *man/dichromat.Rd 2d8cf30f939a20ad9d7e54fa2c922bab *man/distance.Rd 57742168277a0085bd52ba8e080720f2 *man/gradient.Rd 2a1ef1bb9995882e1593a16992dd6dc4 *man/mixtures.Rd a779408499d43cd4a04be60f99056fda *man/properties.Rd 68edef1c07c6abfd69a28510122de5cf *man/shade.Rd d7f8737a07ffa79de86274538be80de0 *man/space.Rd f0df3d4947baac1b408b49e46b8015ab *man/swatch.Rd c75fb0c2f2d9e38788bf1cddfaec6153 *man/warp.Rd e64602db170f24100d10c54c7908b5c4 *tests/testthat.R fd2ba79fcbb25bbb9f027880717eefef *tests/testthat/test-05-shade.R 65af21d3428dda32b824c5dd6f2f4208 *tests/testthat/test-10-scales.R d7d1bcd9c55b6bfeab12d150ff6f2f27 *tests/testthat/test-15-properties.R bd3c36c780d5b8f02997414703a2d617 *tests/testthat/test-20-mixtures.R 11dee6e8eca32f69663e34ff452bffa8 *tests/testthat/test-25-distance.R fd60a24a96abfbcb5fe5c55c32a96038 *tests/testthat/test-30-adaptation.R 868c67e2e613df9017855644c2c483c7 *tests/testthat/test-35-swatch.R d675b40ea1b3294fde610ea39c47241e *tests/testthat/test-40-alpha.R 4e71f509082997fcb399a355fe2fcb05 *tests/testthat/test-45-functions.R c98b907eedb47b980e2c1d91c163431d *tests/testthat/test-50-missing.R 73a1d9e013d1b2b1865ae546416e9eed *tools/figures/addmix-1.svg 62492b36323a8a2216124cf9339429da *tools/figures/dichromat-1.svg 62db49a5b00c482109a8f8acdbf9c8b2 *tools/figures/dichromat-2.svg 3ee2697c4bae9f86dae529b483f9ffac *tools/figures/ggplot-1.svg 67d17ce44d84790b588a3b23ba34faab *tools/figures/gradients-1.svg 00946f04fd83be679cd4bdbceae9c57a *tools/figures/gradients-2.svg 9d69b736c0c5b2feda9b7b611791cd59 *tools/figures/missing-1.svg 3a7fd2e348dd68f0322c7c626dd19b04 *tools/figures/saturation-1.svg ebcfeb70316f14eee6e665e74bbbfd16 *tools/figures/scales-1.svg 4f46953b1f1891600cd5cac474cc5f0f *tools/figures/scales-2.svg aaefba522878b90f4273183c068c110c *tools/figures/submix-1.svg r-cran-shades-1.4.0/NAMESPACE000066400000000000000000000015721411316204200153610ustar00rootroot00000000000000# Generated by roxygen2: do not edit by hand S3method("!=",shade) S3method("==",shade) S3method("[",shade) S3method("[<-",shade) S3method(all.equal,shade) S3method(c,shade) S3method(coords,default) S3method(coords,shade) S3method(print,shade) S3method(rep,shade) S3method(rev,shade) S3method(shade,character) S3method(shade,color) S3method(shade,default) S3method(shade,matrix) S3method(shade,shade) S3method(space,default) S3method(space,shade) export("%.)%") export("%_/%") export(addmix) export(brightness) export(chroma) export(complement) export(coords) export(delta) export(dichromat) export(distance) export(gradient) export(hue) export(lightness) export(opacity) export(recycle) export(saturation) export(scalefac) export(shade) export(space) export(submix) export(swatch) export(warp) import(grDevices) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,rect) r-cran-shades-1.4.0/NEWS000066400000000000000000000121701411316204200146350ustar00rootroot00000000000000Significant changes to the shades package are laid out below for each release. =============================================================================== VERSION 1.4.0 - The package now handles missing values, patching up some of the limitations of the underlying core graphics functions. In particular, shade vectors may contain NAs, and will propagate them through manipulations, while NAs are accepted as pass-through values when updating colour properties. =============================================================================== VERSION 1.3.1 - A fix has been made for compatibility with changes in the next annual release of R and its core packages. =============================================================================== VERSION 1.3.0 - It is now possible to manipulate palette functions and ggplot2 scales using the colour manipulation functions in this package (#5, #7). When passed one of these objects, a modified wrapper object is returned. This allows colour tweaks to be made to standard scales in ggplot2 plots. See the README for a visual example. - The gradient() function now returns a function if its second argument is missing or NULL. This change is complementary to the one above, allowing palette functions to be created. - Conversions from HSV to RGB coordinates are now more precise. =============================================================================== VERSION 1.2.0 - There is now support for transparency, which can be queried or modified through the new opacity() function, which functions just like the other colour property functions (#4). Opacity (alpha) values are stored as an attribute with shade objects, and reflected in the RGB hex representation only when less than 1. - The scalefac() functional has been added, which multiplies its argument just as delta() adds it. Both functions now accept, and concatenate, multiple arguments for convenience. - The usual behaviour of the colour property manipulation functions, which vectorise over both arguments, can be suppressed by wrapping replacement values with the recycle() function, which reverts to a standard R "recycling" scheme with final dimensions matching the original. =============================================================================== VERSION 1.1.0 - The dichromat() function now offers a pass-through (normal colour vision) option, and is also vectorised over its second argument (#3). Some of the coefficients it uses internally are now pre-calculated and cached for efficiency. - There is now a print method for vectors of class shade. - An empty shade vector is now explicitly an error. - The README now includes an example of using shades with ggplot2 (#2), as well as links to several related packages. =============================================================================== VERSION 1.0.0 - Support for two new colour spaces has been added: LMS, a direct representation of the response levels of each of the three colour receptor types in the eye; and LCh, a polar representation of Lab space. - The new dichromat() function can be used to simulate colour blindness. - The gradient() function now additionally supports predefined colour maps from matplotlib and ColorBrewer. Its second argument is now interpreted a little differently. - The hueshift() function has been removed, in favour of the more general combination of hue() and delta(). hue(x, delta(y)) is the equivalent of the old hueshift(x,y), and delta() can also be used with other colour properties. - New colour property functions lightness() and chroma() have been added. - Dimensions are now set when two or more colour properties are changed, and the swatch() visualisation function plots multidimensional shades in a grid. - There is now a rev() method for shades. - The all.equal() method for shades now passes on its ellipsis argument when checking colour coordinates. =============================================================================== VERSION 0.2.0 - The package has been reworked to use functions from base R to warp colour coordinates between spaces and so on. It therefore no longer depends on the "colorspace" package, but the list of supported colour spaces has changed somewhat as a result. - The warp() function has been added for colour space conversions. - New function complement() returns complementary colours, while addmix() and submix(), plus infix shorthands, implement additive and subtractive colour mixing. - The new distance() function can be used to calculate a standardised measure of the perceptual "distance" between colours. - The shade class gains indexing and equality operators, plus methods for c(), rep() and all.equal(). - There are now accessor functions space() and coords(), for obtaining the current space and coordinates of colour vectors. - The swatch() function now draws grey borders around colour boxes, to make the delineation of near-white colours clearer. =============================================================================== VERSION 0.1.0 - First public release. =============================================================================== r-cran-shades-1.4.0/R/000077500000000000000000000000001411316204200143365ustar00rootroot00000000000000r-cran-shades-1.4.0/R/adaptation.R000066400000000000000000000070751411316204200166160ustar00rootroot00000000000000# The Brettel algorithm calls for "the brightest possible metamer of an equal- # energy stimulus". The equal-energy stimulus, CIE illuminant E, has equal # values for each coordinate in XYZ space. 0.8388 is the largest equal-energy # value (to 4 d.p.) within the sRGB gamut, according to my experimentation. .equalEnergy <- matrix(0.8388, nrow=1, ncol=3) # XYZ space coordinates for the specified wavelengths, using the standard (CIE # 1931) observer. This is a small subset of the values available from # http://files.cie.co.at/204.xls. .standardObserver <- list("475"=matrix(c(0.1421,0.1126,1.0419), nrow=1), "485"=matrix(c(0.05795,0.1693,0.6162), nrow=1), "575"=matrix(c(0.8425,0.9154,0.0018), nrow=1), "660"=matrix(c(0.1649,0.061,0), nrow=1)) # Derived coefficients from the values above, calculated and cached when the # package namespace is loaded .cache <- new.env() #' Simulate colour appearance for dichromats #' #' This functions manipulates colours to simulate the effects of different #' kinds of colour blindness, and specifically dichromacy, in which only two of #' the usual three types of photoreceptors are present. There are three types, #' corresponding to the loss of red, green or blue photoreceptors. #' #' @param shades One or more colours, in any suitable form (see #' \code{\link{shade}}). #' @param type The type of colour vision deficiency to simulate: protanopia #' (red blindness), deuteranopia (green blindness) or tritanopia (blue #' blindness). The latter is the rarest in the population. \code{"none"} is #' also available, as a pass-through option. Abbrevations, such as the first #' letter, may be used, and multiple values are acceptable. #' @return New colours of class \code{"shade"} in LMS space, representing #' projections of the original shades onto a submanifold appropriate to the #' type of dichromacy being simulated. #' #' @examples #' dichromat(c("red", "green", "blue")) #' @references #' Brettel, H., Viénot, F. and Mollon, J.D. (1997). Computerized simulation of #' color appearance for dichromats. Journal of the Optical Society of America A #' 14(10):2647-2655. #' @author Jon Clayden #' @export dichromat <- function (shades, type = c("protanopic","deuteranopic","tritanopic","none")) { if (missing(type)) type <- "protanopic" else type <- match.arg(type, several.ok=TRUE) shades <- warp(shades, "LMS") Q <- coords(shades) coords <- do.call(rbind, lapply(type, function(t) { Qprime <- Q if (t != "none") { lambda <- switch(t, protanopic=ifelse(Q[,3]/Q[,2] < .cache$Er[1], 575, 475), deuteranopic=ifelse(Q[,3]/Q[,1] < .cache$Er[2], 575, 475), tritanopic=ifelse(Q[,2]/Q[,1] < .cache$Er[3], 660, 485)) lambda <- as.character(lambda) if (t == "protanopic") Qprime[,1] <- -(.cache$b[lambda]*Q[,2] + .cache$c[lambda]*Q[,3]) / .cache$a[lambda] else if (t == "deuteranopic") Qprime[,2] <- -(.cache$a[lambda]*Q[,1] + .cache$c[lambda]*Q[,3]) / .cache$b[lambda] else Qprime[,3] <- -(.cache$a[lambda]*Q[,1] + .cache$b[lambda]*Q[,2]) / .cache$c[lambda] } return (Qprime) })) indices <- rep(seq_along(shades),each=length(type)) + length(shades) * (seq_along(type)-1) coords <- coords[indices,,drop=FALSE] return (drop(structure(shade(coords,space="LMS"), dim=c(length(type),.dims(shades))))) } r-cran-shades-1.4.0/R/distance.R000066400000000000000000000046541411316204200162640ustar00rootroot00000000000000#' Colour distance #' #' This function calculates a distance measure that aims to quantify the #' perceptual difference between a vector of colours and a reference colour. #' The measure in question is the CIE Delta E (2000), which is calculated based #' on colour coordinates in Lab space. #' #' @param shades One or more colours, in any suitable form (see #' \code{\link{shade}}). #' @param reference A single reference colour. #' @return A numeric vector of distances. #' #' @examples #' distance(c("red","green","blue"), "red") #' @references #' \url{http://www.brucelindbloom.com/index.html?Eqn_DeltaE_CIE2000.html} #' @author Jon Clayden #' @export distance <- function (shades, reference) { deg2rad <- function(x) x / 180 * pi rad2deg <- function(x) x / pi * 180 shadeCoords <- coords(warp(shades, "Lab")) L2 <- shadeCoords[,1] a2 <- shadeCoords[,2] b2 <- shadeCoords[,3] if (length(reference) != 1L) stop("Reference should be a single shade") refCoords <- coords(warp(reference, "Lab")) L1 <- refCoords[,1] a1 <- refCoords[,2] b1 <- refCoords[,3] LBarPrime <- (L1 + L2) / 2 C1 <- sqrt(a1^2 + b1^2) C2 <- sqrt(a2^2 + b2^2) CBar <- (C1 + C2) / 2 G <- (1 - sqrt(CBar^7/(CBar^7+25^7))) / 2 a1Prime <- a1 * (1+G) a2Prime <- a2 * (1+G) C1Prime <- sqrt(a1Prime^2 + b1^2) C2Prime <- sqrt(a2Prime^2 + b2^2) CBarPrime <- (C1Prime + C2Prime) / 2 h1Prime <- atan2(b1, a1Prime) %% (2*pi) h2Prime <- atan2(b2, a2Prime) %% (2*pi) largeDiff <- abs(h1Prime-h2Prime) > pi HBarPrime <- (h1Prime + h2Prime + ifelse(largeDiff, 2*pi, 0)) / 2 bigT <- 1 - 0.17*cos(HBarPrime-deg2rad(30)) + 0.24*cos(2*HBarPrime) + 0.32*cos(3*HBarPrime+deg2rad(6)) - 0.20*cos(4*HBarPrime-deg2rad(63)) deltahPrime <- h2Prime - h1Prime + ifelse(largeDiff, ifelse(h2Prime>h1Prime,-2*pi,2*pi), 0) deltaLPrime <- L2 - L1 deltaCPrime <- C2Prime - C1Prime deltaHPrime <- 2 * sqrt(C1Prime*C2Prime) * sin(deltahPrime/2) SL <- 1 + 0.015 * (LBarPrime-50)^2 / sqrt(20 + (LBarPrime-50)^2) SC <- 1 + 0.045 * CBarPrime SH <- 1 + 0.015 * CBarPrime * bigT deltatheta <- deg2rad(30 * exp(-((rad2deg(HBarPrime)-275) / 25)^2)) RC <- 2 * sqrt(CBarPrime^7 / (CBarPrime^7 + 25^7)) RT <- -RC * sin(2*deltatheta) unname(sqrt((deltaLPrime/SL)^2 + (deltaCPrime/SC)^2 + (deltaHPrime/SH)^2 + RT*(deltaCPrime/SC)*(deltaHPrime/SH))) } r-cran-shades-1.4.0/R/mixtures.R000066400000000000000000000076201411316204200163460ustar00rootroot00000000000000.mix <- function (base, mixer, op, amount = 1, space = NULL) { op <- match.fun(op) if (is.null(space)) space <- space(base) amount <- rep(amount, length.out=length(mixer)) base <- warp(base, space) mixer <- warp(mixer, space) baseIndices <- rep(seq_along(base), each=length(mixer)) mixerIndices <- rep(seq_along(mixer), length(base)) coords <- sapply(1:3, function(i) op(coords(base)[baseIndices,i], amount[mixerIndices]*coords(mixer)[mixerIndices,i])) if (!is.matrix(coords)) coords <- matrix(coords, nrow=1) shade(.clip(coords,space), space=space) } #' Complementary colours #' #' This function returns the complement of its argument, the "opposite" colours #' in the specified space. #' #' @param shades One or more colours, in any suitable form (see #' \code{\link{shade}}), or a palette function or scale. #' @param space The space in which to take the complement. #' @return New colours of class \code{"shade"}, or a new palette function. #' #' @examples #' complement("cyan") #' complement("cyan", space="HSV") #' complement("cyan", space="Lab") #' @export complement <- function (shades, space = NULL) { if (is.function(shades)) function (...) complement(shades(...), space) else if (inherits(shades, "Scale")) { ggplot2::ggproto(NULL, shades, palette=function(self,...) { colours <- ggplot2::ggproto_parent(shades, self)$palette(...) complement(colours, space) }) } else { if (is.null(space)) space <- space(shades) if (tolower(space) == "hsv") hue(shades, delta(180)) else { white <- warp("white", space=space) .mix(white, shades, "-", space=space) } } } #' Colour mixtures #' #' These functions allow colours to be mixed in any colour space, either #' additively (like light) or subtractively (like paint). The infix form #' \code{\%.)\%} is an alternative for \code{addmix}, and \code{\%_/\%} for #' \code{submix}, with the mixing amount being fixed to 1 in these cases. #' #' @param base,X A vector of base colours, or a palette function or scale. #' @param mixer,Y A vector of colours to mix in. #' @param amount The amount of each colour to mix in, relative to the amount #' of the base. This will be recycled to the length of \code{mixer}. #' @param space A string giving the space in which to perform the mixing, or #' \code{NULL}. In the latter case, the space of \code{base} will be used. #' @return New colours of class \code{"shade"}, or a new palette function. #' #' @examples #' addmix(c("red","green","blue"), "red") #' submix(c("cyan","magenta","yellow"), "cyan") #' @author Jon Clayden #' @rdname mixtures #' @export addmix <- function (base, mixer, amount = 1, space = NULL) { if (is.function(base)) function (...) addmix(base(...), mixer, amount, space) else if (inherits(base, "Scale")) { ggplot2::ggproto(NULL, base, palette=function(self,...) { colours <- ggplot2::ggproto_parent(base, self)$palette(...) addmix(colours, mixer, amount, space) }) } else .mix(base, mixer, "+", amount, space) } #' @rdname mixtures #' @export submix <- function (base, mixer, amount = 1, space = NULL) { if (is.function(base)) function (...) submix(base(...), mixer, amount, space) else if (inherits(base, "Scale")) { ggplot2::ggproto(NULL, base, palette=function(self,...) { colours <- ggplot2::ggproto_parent(base, self)$palette(...) submix(colours, mixer, amount, space) }) } else complement(.mix(complement(base,space), complement(mixer,space), "+", amount, space)) } #' @rdname mixtures #' @export "%.)%" <- function (X, Y) { addmix(X, Y) } #' @rdname mixtures #' @export "%_/%" <- function (X, Y) { submix(X, Y) } r-cran-shades-1.4.0/R/properties.R000066400000000000000000000142311411316204200166560ustar00rootroot00000000000000.replaceProperty <- function (shades, replacement, space, dim) { UseMethod(".replaceProperty") } .replaceProperty.function <- function (shades, replacement, space, dim) { function (...) .replaceProperty(shades(...), replacement, space, dim) } .replaceProperty.Scale <- function (shades, replacement, space, dim) { ggplot2::ggproto(NULL, shades, palette=function(self,...) { colours <- ggplot2::ggproto_parent(shades, self)$palette(...) .replaceProperty(colours, replacement, space, dim) }) } .replaceProperty.default <- function (shades, replacement, space, dim) { shades <- warp(shades, space) if (is.null(replacement)) return (unname(coords(shades)[,dim])) else { if (is.numeric(replacement) || is.logical(replacement)) { arity <- length(replacement) replacement <- rep(replacement, length(shades)) } else { fun <- match.fun(replacement) arity <- length(fun(coords(shades)[1,dim])) replacement <- fun(coords(shades)[,dim]) } missing <- is.na(replacement) indices <- rep(seq_along(shades), each=arity) coords <- coords(shades)[indices,,drop=FALSE] coords[!missing,dim] <- replacement[!missing] coords <- .clip(coords, space) alpha <- .alpha(shades, allowNull=FALSE)[indices] return (drop(structure(shade(coords,space=space,alpha=alpha), dim=c(arity,.dims(shades))))) } } #' Query or change colour properties #' #' These functions obtain the value of a colour property, or modify it. They #' will convert between colour spaces as required, but the RGB representation #' will be appropriately updated in the result. #' #' Brightness and lightness differ technically, in the sense that one is #' absolute and the other is relative. Intuitively, a grey square on white #' paper is brighter under bright sunlight than in a dark room, but its #' lightness (relative to the white around it) is constant between conditions. #' In these functions, brightness is ``value'' in HSV space and is between 0 #' and 1, while lightness is defined in Lab space and is between 0 and 100. #' Saturation and chroma are also related. Hue is defined in HSV space, with #' red at 0º (and 360º), which is generally the most familiar parameterisation. #' #' @param shades One or more colours, in any suitable form (see #' \code{\link{shade}}), or a palette function or scale. #' @param values New values for the property in question, with \code{NA} as a #' pass-through value that will leave the property as-is. If \code{NULL}, the #' current value(s) will be returned. May also be a function computing new #' values from old ones, such as \code{delta}, which adds its argument, or #' \code{scalefac}, which multiplies it. #' @param ... Arguments to replacement functions \code{delta}, \code{scalefac} #' and \code{recycle}, which will be concatenated. #' @return Current colour property values, or new colours of class #' \code{"shade"}. If \code{shades} is a function, the result will be a new #' function that wraps the old one and modifies its return value accordingly. #' #' @note The colour property functions are vectorised over both of their #' arguments, such that the dimensions of the result will be #' \code{c(length(values),dim(shades))}. However, the \code{recycle} function #' can be used to suppress the usual dimensional expansion, and instead #' follow R's standard recycling rule. #' #' @examples #' saturation(c("papayawhip","lavenderblush","olivedrab")) #' #' saturation("papayawhip", 0.7) #' saturation("papayawhip", delta(0.2)) #' saturation("papayawhip", scalefac(1.5)) #' #' saturation(c("red","green"), c(0.4,0.6)) #' saturation(c("red","green"), recycle(0.4,0.6)) #' @author Jon Clayden #' @rdname properties #' @export saturation <- function (shades, values = NULL) { .replaceProperty(shades, values, "HSV", 2) } #' @rdname properties #' @export brightness <- function (shades, values = NULL) { .replaceProperty(shades, values, "HSV", 3) } #' @rdname properties #' @export lightness <- function (shades, values = NULL) { .replaceProperty(shades, values, "Lab", 1) } #' @rdname properties #' @export chroma <- function (shades, values = NULL) { .replaceProperty(shades, values, "LCh", 2) } #' @rdname properties #' @export hue <- function (shades, values = NULL) { .replaceProperty(shades, values, "HSV", 1) } #' @rdname properties #' @export opacity <- function (shades, values = NULL) { # Handle functions and ggplot2 scales if (is.function(shades)) return (function (...) opacity(shades(...), values)) else if (inherits(shades, "Scale")) { result <- ggplot2::ggproto(NULL, shades, palette=function(self,...) { colours <- ggplot2::ggproto_parent(shades, self)$palette(...) opacity(colours, values) }) return (result) } # From here on we're dealing with literal colours shades <- shade(shades) if (is.null(values)) return (.alpha(shades, allowNull=FALSE)) else { if (is.numeric(values) || is.logical(values)) { arity <- length(values) values <- rep(values, length(shades)) } else { fun <- match.fun(values) arity <- length(fun(.alpha(shades,allowNull=FALSE)[1])) values <- fun(.alpha(shades, allowNull=FALSE)) } indices <- rep(seq_along(shades), each=arity) coords <- coords(shades)[indices,,drop=FALSE] values[is.na(values)] <- .alpha(shades, allowNull=FALSE)[indices][is.na(values)] return (drop(structure(shade(coords,space=space(shades),alpha=values), dim=c(arity,.dims(shades))))) } } #' @rdname properties #' @export delta <- function (...) { values <- as.numeric(c(...)) return (function(x) x+values) } #' @rdname properties #' @export scalefac <- function (...) { values <- as.numeric(c(...)) return (function(x) x*values) } #' @rdname properties #' @export recycle <- function (...) { values <- as.numeric(c(...)) return (function(x) rep(values,length.out=length(x))) } r-cran-shades-1.4.0/R/scales.R000066400000000000000000000100721411316204200157330ustar00rootroot00000000000000# These are approximations to matplotlib's colour scales, with 16 key colours each .colmaps <- list(magma=c("#000004", "#0B0924", "#20114B", "#3B0F70", "#57157E", "#721F81", "#8C2981", "#A8327D", "#C43C75", "#DE4968", "#F1605D", "#FA7F5E", "#FE9F6D", "#FEBF84", "#FDDEA0", "#FCFDBF"), inferno=c("#000004", "#0C0826", "#240C4F", "#420A68", "#5D126E", "#781C6D", "#932667", "#AE305C", "#C73E4C", "#DD513A", "#ED6925", "#F8850F", "#FCA50A", "#FAC62D", "#F2E661", "#FCFFA4"), plasma=c("#0D0887", "#330597", "#5002A2", "#6A00A8", "#8405A7", "#9C179E", "#B12A90", "#C33D80", "#D35171", "#E16462", "#ED7953", "#F68F44", "#FCA636", "#FEC029", "#F9DC24", "#F0F921"), viridis=c("#440154", "#481A6C", "#472F7D", "#414487", "#39568C", "#31688E", "#2A788E", "#23888E", "#1F988B", "#22A884", "#35B779", "#54C568", "#7AD151", "#A5DB36", "#D2E21B", "#FDE725"), blues=c("#F7FBFF", "#DEEBF7", "#C6DBEF", "#9ECAE1", "#6BAED6", "#4292C6", "#2171B5", "#08519C", "#08306B"), reds=c("#FFF5F0", "#FEE0D2", "#FCBBA1", "#FC9272", "#FB6A4A", "#EF3B2C", "#CB181D", "#A50F15", "#67000D"), rdbu=c("#053061", "#2166AC", "#4393C3", "#92C5DE", "#D1E5F0", "#F7F7F7", "#FDDBC7", "#F4A582", "#D6604D", "#B2182B", "#67001F"), ylorrd=c("#800026", "#BD0026", "#E31A1C", "#FC4E2A", "#FD8D3C", "#FEB24C", "#FED976", "#FFEDA0", "#FFFFCC")) .colmapspaces <- list(magma="Lab", inferno="Lab", plasma="Lab", viridis="Lab", blues="sRGB", reds="sRGB", rdbu="sRGB", ylorrd="sRGB") #' Colour gradients #' #' This function returns a set of colours interpolating between the specified #' key colours, equally separated in the specified space. #' #' The key colours may be specified explicitly, or else a built-in colour map #' may be used. The maps available are currently those developed for Python's #' \code{matplotlib} 2.0, namely \code{"magma"}, \code{"inferno"}, #' \code{"plasma"} and \code{"viridis"}, and certain ColorBrewer palettes, #' namely \code{"Blues"}, \code{"Reds"}, \code{"YlOrRd"} (yellow-orange-red) #' and \code{"RdBu"} (red-grey-blue, a balanced diverging scale). #' #' @param shades Two or more colours, in any suitable form (see #' \code{\link{shade}}), or a named colour map such as \code{"viridis"}. #' @param steps An integer giving the number of shades required in the palette. #' If \code{NULL}, a function will instead be returned that takes this #' argument. #' @param space The colour space to traverse. Defaults to the current space of #' \code{shades}, or \code{"Lab"} for the \code{matplotlib} colour maps, or #' \code{"sRGB"} otherwise. #' @return A character vector of class \code{"shade"} containing the gradient #' elements in the specified space, or a palette function. #' #' @examples #' gradient(c("red","blue"), 5) #' gradient(c("red","blue"), 5, space="Lab") #' gradient("viridis", 5) #' @references #' \url{http://bids.github.io/colormap/} for the \code{matplotlib} colour maps; #' \url{http://colorbrewer2.org} for the ColorBrewer ones. #' @author Jon Clayden #' @export gradient <- function (shades, steps = NULL, space = NULL) { if (length(shades) == 1) { if (is.character(shades) && tolower(shades) %in% names(.colmaps)) shades <- warp(shade(.colmaps[[tolower(shades)]]), .colmapspaces[[tolower(shades)]]) else stop("A single-element argument should specify a predefined colour map") } else shades <- shade(shades) if (is.null(space)) space <- space(shades) else if (space != attr(shades,"space")) shades <- warp(shades, space) if (is.null(steps)) return (function (steps) gradient(shades,steps,space)) nShades <- length(shades) locs <- seq(1, nShades, length.out=steps) finalCols <- matrix(NA, steps, 3L) for (i in seq_along(locs)) { loc <- locs[i] fraction <- loc - floor(loc) finalCols[i,] <- (1 - fraction) * coords(shades)[floor(loc),] + fraction * coords(shades)[ceiling(loc),] } return (shade(finalCols, space=space)) } r-cran-shades-1.4.0/R/shade.R000066400000000000000000000316461411316204200155570ustar00rootroot00000000000000# Linearised transformation matrices .bradfordXYZtoLMS <- matrix(c(0.8951, -0.7502, 0.0389, 0.2664, 1.7135, -0.0685, -0.1614, 0.0367, 1.0296), 3, 3) .bradfordLMStoXYZ <- solve(.bradfordXYZtoLMS) # Standard and additional colour space converters .converters <- list(rgb="sRGB", srgb="sRGB", xyz="XYZ", "apple rgb"="Apple RGB", "cie rgb"="CIE RGB", lab="Lab", luv="Luv") # Since R 3.6.0, colorConverter() has a "vectorized" argument that allows converters to indicate that they can handle multiple colours at once. For now we don't use that, for backwards compatibility .converters$hsv <- colorConverter( toXYZ = function (hsv, ...) { c <- hsv[2] * hsv[3] # chroma base <- (1 - hsv[2]) * hsv[3] sextile <- (hsv[1] %% 360) / 60 + 1 f <- sextile - floor(sextile) rgb <- base + switch(as.integer(sextile), c(c,f*c,0), c((1-f)*c,c,0), c(0,c,f*c), c(0,(1-f)*c,c), c(f*c,0,c), c(c,0,(1-f)*c)) colorspaces$sRGB$toXYZ(rgb, ...) }, fromXYZ = function (xyz, ...) { # This rounding operation mirrors convertColor(), and avoids numerical variability between platforms rgb <- round(colorspaces$sRGB$fromXYZ(xyz, ...), 5) rgb[rgb < 0] <- 0 rgb[rgb > 1] <- 1 rgb <- (if (is.matrix(rgb)) t(rgb) else matrix(rgb,ncol=1L)) hsv <- drop(rgb2hsv(rgb, maxColorValue=1)) hsv[1] <- (hsv[1] * 360) %% 360 structure(hsv, names=c("H","S","V")) }, name = "HSV") .converters$lms <- colorConverter( toXYZ = function (lms, ...) { .bradfordLMStoXYZ %*% lms }, fromXYZ = function (xyz, ...) { structure(.bradfordXYZtoLMS %*% xyz, names=c("L","M","S")) }, name = "LMS") .converters$lch <- colorConverter( toXYZ = function (lch, ...) { angle <- lch[3] / 180 * pi lab <- c(lch[1], lch[2] * cos(angle), lch[2] * sin(angle)) colorspaces$Lab$toXYZ(lab, ...) }, fromXYZ = function (xyz, ...) { lab <- colorspaces$Lab$fromXYZ(xyz, ...) lch <- c(lab[1], sqrt(lab[2]^2 + lab[3]^2), atan2(lab[3],lab[2]) / pi * 180) lch[3] <- lch[3] %% 360 structure(lch, names=c("L","C","h")) }, name = "LCh") .toHex <- function (coords, space, alpha = NULL) { space <- tolower(space) missing <- apply(coords, 1, anyNA) if (any(!missing) && !identical(.converters[[space]], "sRGB")) coords[!missing,] <- convertColor(coords[!missing,,drop=FALSE], .converters[[space]], "sRGB") result <- rep(NA_character_, nrow(coords)) if (is.null(alpha) || all(alpha == 1)) result[!missing] <- rgb(coords[!missing,1], coords[!missing,2], coords[!missing,3], maxColorValue=1) else result[!missing] <- rgb(coords[!missing,1], coords[!missing,2], coords[!missing,3], pmax(0,pmin(1,alpha[!missing])), maxColorValue=1) return (result) } .clip <- function (coords, space) { if (grepl("rgb$", tolower(space))) { coords[coords < 0] <- 0 coords[coords > 1] <- 1 } else if (tolower(space) == "hsv") { temp <- coords[,1] %% 360 coords[coords < 0] <- 0 coords[coords > 1] <- 1 coords[,1] <- temp } return (coords) } .dims <- function (x, collapse = FALSE) { if (is.null(dim(x))) return (length(x)) else if (length(dim(x)) > 2 && collapse) return (c(dim(x)[1], prod(dim(x)[-1]))) else return (dim(x)) } .alpha <- function (x, ..., allowNull = TRUE) { if (!missing(..1)) { elements <- lapply(list(x,...), .alpha, allowNull=FALSE) result <- do.call("c", elements) } else { if (!is.null(attr(x, "alpha"))) result <- pmax(0, pmin(1, attr(x,"alpha"))) else if (any(grepl("#[0-9A-Fa-f]{8}", as.character(x), perl=TRUE))) result <- unname(col2rgb(as.character(x), alpha=TRUE)["alpha",] / 255) else result <- rep(1, length(x)) } if (allowNull && all(result == 1)) return (NULL) else return (result) } #' The shade class #' #' Objects of class \code{"shade"} are simply standard R character vectors #' representing one or more 8-bit (s)RGB colours in CSS-like hex format, but #' with extra attributes giving the current colour space and coordinates. #' #' Comparison between \code{"shade"} objects \code{x} and \code{y} is achieved #' by converting \code{y} (the second argument) into the colour space of #' \code{x} and then comparing coordinates, after any clipping. #' #' @param x,y R objects, or \code{"shade"} objects for methods. #' @param space For a matrix, the space in which coordinates are being #' provided. #' @param alpha For a matrix, an associated vector of opacity values between 0 #' and 1, if required. #' @param target,current Shade vectors to compare. #' @param i An index vector. #' @param value A vector of replacement colours. #' @param hexonly If \code{TRUE}, compare only on the basis of the hex strings. #' Otherwise test for equal coordinates. #' @param ... Additional parameters to methods. For \code{c}, any number of #' colours in any acceptable form. #' @return A character vector of class \code{"shade"}, with additional #' attributes as follows. #' \item{space}{A string naming a color space.} #' \item{coords}{A matrix giving colour coordinates in the relevant space, #' one colour per row.} #' #' @note When concatenating, shades that are all from the same space will #' remain in that space, but shades from different spaces will be warped to #' ``XYZ'' space. #' #' @examples #' s <- shade(c("red", "green", "blue")) #' s[1] #' s[1] <- "pink" #' @author Jon Clayden #' @aliases shades #' @export shade <- function (x, ...) { UseMethod("shade") } #' @rdname shade #' @export shade.shade <- function (x, ...) { return (x) } #' @rdname shade #' @export shade.color <- function (x, ...) { hex <- colorspace::hex(x, fixup=TRUE) structure(hex, space=class(x), coords=colorspace::coords(x), alpha=.alpha(hex), class="shade") } #' @rdname shade #' @export shade.matrix <- function (x, space = "sRGB", alpha = NULL, ...) { hex <- .toHex(x, space, alpha) structure(hex, space=space, coords=x, alpha=.alpha(hex), class="shade") } #' @rdname shade #' @export shade.character <- function (x, ...) { if (length(x) == 0) stop("Colour vector must not be empty") coords <- structure(t(col2rgb(x)/255), dimnames=list(NULL,c("R","G","B"))) coords[is.na(x),] <- NA structure(x, space="sRGB", coords=coords, alpha=.alpha(x), class="shade") } #' @rdname shade #' @export shade.default <- function (x, ...) { if (missing(x)) stop("Colour vector must not be empty") shade.character(as.character(x), ...) } #' @rdname shade #' @export print.shade <- function (x, ...) { len <- length(x) hasAlpha <- !is.null(attr(x, "alpha")) cat(paste0(" ", len, ifelse(len==1," shade"," shades"), " in ", space(x), " space, ", ifelse(hasAlpha,"with","without"), " transparency\n")) print(structure(x, space=NULL, coords=NULL, alpha=NULL, class=NULL), quote=FALSE) } #' @rdname shade #' @export "[.shade" <- function (x, i) { structure(as.character(x)[i], space=attr(x,"space"), coords=attr(x,"coords")[i,,drop=FALSE], alpha=attr(x,"alpha")[i], class="shade") } #' @rdname shade #' @export "[<-.shade" <- function (x, i, value) { replacement <- warp(value, attr(x,"space")) attr(x,"coords")[i,] <- attr(replacement,"coords") alpha <- .alpha(x, allowNull=FALSE) alpha[i] <- .alpha(value, allowNull=FALSE) if (all(alpha == 1)) attr(x, "alpha") <- NULL else attr(x, "alpha") <- alpha NextMethod("[<-") } #' @rdname shade #' @export c.shade <- function (...) { shades <- lapply(list(...), shade) spaces <- sapply(shades, space) if (all(spaces == spaces[1])) space <- spaces[1] else { space <- "XYZ" shades <- lapply(shades, warp, "XYZ") } structure(do.call("c",lapply(shades,as.character)), space=space, coords=do.call("rbind",lapply(shades,coords)), alpha=do.call(".alpha",shades), class="shade") } #' @rdname shade #' @export rep.shade <- function (x, ...) { indices <- rep(seq_along(x), ...) structure(as.character(x)[indices], space=attr(x,"space"), coords=attr(x,"coords")[indices,,drop=FALSE], alpha=attr(x,"alpha")[indices], class="shade") } #' @rdname shade #' @export rev.shade <- function (x) { indices <- rev(seq_along(x)) structure(as.character(x)[indices], space=attr(x,"space"), coords=attr(x,"coords")[indices,,drop=FALSE], alpha=attr(x,"alpha")[indices], class="shade") } #' @rdname shade #' @export "==.shade" <- function (x, y) { y <- rep(warp(y,attr(x,"space")), length.out=length(x)) xCoords <- coords(x) yCoords <- coords(y) coordsAgree <- sapply(seq_along(x), function(i) all(xCoords[i,] == yCoords[i,])) alphaAgrees <- .alpha(x, allowNull=FALSE) == .alpha(y, allowNull=FALSE) return (coordsAgree & alphaAgrees) } #' @rdname shade #' @export "!=.shade" <- function (x, y) { return (!`==.shade`(x,y)) } #' @rdname shade #' @export all.equal.shade <- function (target, current, hexonly = FALSE, ...) { if (hexonly) all.equal(as.character(target), as.character(current), ...) else if (length(target) != length(current)) paste0("Lengths do not match (", length(target), " and ", length(current), ")") else if (!all(.alpha(target,allowNull=FALSE) == .alpha(current,allowNull=FALSE))) paste0("Alpha values do not match (mean absolute difference is ", signif(mean(abs(.alpha(target,allowNull=FALSE) - .alpha(current,allowNull=FALSE))),4), ")") else { target <- warp(target, space(current)) result <- all.equal(coords(target), coords(current), ...) if (isTRUE(result)) return (TRUE) else { distances <- sapply(seq_along(target), function(i) distance(target[i],current[i])) paste0("Mean colour distance is ", signif(mean(distances,4))) } } } #' Retrieve the space of a colour vector #' #' This function retrieves the colour space in which its argument is currently #' defined. #' #' @param x An R object. #' @param ... Additional arguments to methods. #' @return A string naming a colour space. #' #' @examples #' space("red") #' @author Jon Clayden #' @export space <- function (x, ...) { UseMethod("space") } #' @export space.shade <- function (x, ...) { attr(x, "space") } #' @export space.default <- function (x, ...) { space.shade(shade(x, ...)) } #' Retrieve the coordinates of a colour vector #' #' This function retrieves the coordinates of a colour vector's elements, #' within whatever space it is currently defined. #' #' @param x An R object. #' @param ... Additional arguments to methods. #' @return A matrix giving colour coordinates in the relevant space, one colour #' per row. Columns are typically named. #' #' @examples #' coords("red") #' @author Jon Clayden #' @export coords <- function (x, ...) { UseMethod("coords") } #' @export coords.shade <- function (x, ...) { attr(x, "coords") } #' @export coords.default <- function (x, ...) { coords.shade(shade(x, ...)) } #' Shift colours between spaces #' #' This function shifts the current colour space of its arguments to the #' specified space, returning a new object of class \code{"shade"}. #' #' Valid names for spaces are currently those supported by the #' \code{\link{convertColor}} function, namely ``sRGB'', ``Apple RGB'', ``CIE #' RGB'', ``XYZ'', ``Lab'' and ``Luv''; plus ``RGB'' (which is treated as an #' alias for ``sRGB''), ``HSV'', ``LCh'' and ``LMS''. Case is not significant. #' #' @param x An R object which can be coerced to class \code{"shade"}. #' @param space A string naming the new space. #' @return A new object of class \code{"shade"}. #' #' @note LMS space, used for chromatic adaptation and simulating colour #' blindness, is not uniquely defined. Here we use the (linearised) Bradford #' transform, obtained by Lam (1985) and used widely in ICC colour profiles #' and elsewhere, to transform to and from CIE XYZ space. #' #' R uses the D65 standard illuminant as the reference white for the ``Lab'' #' and ``Luv'' spaces. #' #' @examples #' warp("red", "HSV") #' @references #' Lam, K.M. (1985). Metamerism and colour constancy. PhD thesis, University of #' Bradford. #' @seealso \code{\link{convertColor}} #' @author Jon Clayden #' @export warp <- function (x, space) { x <- shade(x) sourceSpace <- tolower(attr(x, "space")) targetSpace <- tolower(space) if (sourceSpace == targetSpace) return (x) coords <- attr(x, "coords") missing <- apply(coords, 1, anyNA) if (any(!missing)) coords[!missing,] <- convertColor(coords[!missing,,drop=FALSE], .converters[[sourceSpace]], .converters[[targetSpace]]) alpha <- .alpha(x) return (structure(.toHex(coords,targetSpace,alpha), dim=dim(x), space=space, coords=coords, alpha=alpha, class="shade")) } r-cran-shades-1.4.0/R/swatch.R000066400000000000000000000030731411316204200157550ustar00rootroot00000000000000#' Simple colour swatches #' #' This function provides a simple visualisation of a colour series as a series #' of boxes against the specified background colour. If the input has more than #' one dimension then the boxes will be arranged in a grid (flattening further #' dimensions after the second). #' #' @param x One or more colours, in any suitable form (see #' \code{\link{shade}}). #' @param bg A background colour. #' @param ... Additional arguments (currently unused). #' #' @examples #' swatch(c("red", "green", "blue")) #' @author Jon Clayden #' @export swatch <- function (x, bg = "white", ...) { shades <- shade(x) grid <- .dims(shades, collapse=TRUE) if (length(grid) == 1) grid <- c(grid, 1) width <- 0.9 / (max(grid) + 1) gap <- 1 / (max(grid) + 1) # The first line generates one centre value per location in each dimension # The second expands out one x and y position per shade centres <- lapply(grid, function(i) gap * ((max(grid) - i) / 2 + seq_len(i))) centres <- as.matrix(expand.grid(centres)) oldPars <- par(mai=c(0,0,0,0), bg=bg) on.exit(par(oldPars)) devSize <- dev.size() devRatio <- devSize[2] / devSize[1] # Centre coordinates are reversed in the y-axis so that the plot "reads" top-to-bottom plot(NA, NA, xlim=c(-0.1,1.1), ylim=0.5+c(-1,1)*devRatio*0.6, xlab="", ylab="", xaxt="n", yaxt="n", bty="n", asp=1) rect(centres[,1]-width/2, rev(centres[,2])-width/2, centres[,1]+width/2, rev(centres[,2])+width/2, col=shades, border="grey50", lwd=2) } r-cran-shades-1.4.0/R/zzz.R000066400000000000000000000012621411316204200153170ustar00rootroot00000000000000#' @import grDevices #' @importFrom graphics par rect plot .onLoad <- function (libname, pkgname) { # Illuminant E E <- coords(warp(shade(.equalEnergy,space="XYZ"), "LMS")) abc <- sapply(.standardObserver, function(xyz) { A <- coords(warp(shade(xyz,space="XYZ"), "LMS")) a <- E[,2] * A[,3] - E[,3] * A[,2] b <- E[,3] * A[,1] - E[,1] * A[,3] c <- E[,1] * A[,2] - E[,2] * A[,1] c(a, b, c) }) # Coefficients used by dichromat() .cache$a <- abc[1,] .cache$b <- abc[2,] .cache$c <- abc[3,] # Ratios of components of E, also used by dichromat() .cache$Er <- c(E[,3]/E[,2], E[,3]/E[,1], E[,2]/E[,1]) } r-cran-shades-1.4.0/README.md000066400000000000000000000211461411316204200154200ustar00rootroot00000000000000 [![Build Status](https://travis-ci.org/jonclayden/shades.svg?branch=master)](https://travis-ci.org/jonclayden/shades) [![codecov](https://codecov.io/gh/jonclayden/shades/branch/master/graph/badge.svg)](https://codecov.io/gh/jonclayden/shades) # Simple colour manipulation in R 😎 The `shades` package allows colours to be manipulated easily in R. Properties such as brightness and saturation can be quickly queried, changed or varied, and perceptually uniform colour gradients can be constructed. It plays nicely with the pipe operator from the [popular `magrittr` package](https://github.com/tidyverse/magrittr), and fits naturally into that paradigm. It can also be used [with `ggplot2` scales](#interoperability-with-ggplot2). The package is available on [CRAN](https://cran.r-project.org/package=shades). You can also install the current development version from GitHub using [`devtools`](https://github.com/r-lib/devtools): ```r # install.packages("devtools") devtools::install_github("jonclayden/shades") ``` Feedback on the package or suggestions are welcome, either by filing an issue or by email. ## Usage Colours are represented in R using [CSS-style hex strings](https://en.wikipedia.org/wiki/Web_colors), but there is also a dictionary of predefined named colours such as `"red"` and `"blue"`. Either of these may be passed to most graphics functions, but creating variations on a particular colour can be awkward. The `shades` package defines a simple class, `shade`, which uses exactly this same convention and is entirely compatible with built-in colours, but it also stores information about the coordinates of the colours in a particular [colour space](https://en.wikipedia.org/wiki/Color_space). ```r library(shades) red <- shade("red") print(unclass(red)) ## [1] "red" ## attr(,"space") ## [1] "sRGB" ## attr(,"coords") ## R G B ## [1,] 1 0 0 ``` From here, the package switches between colour spaces as required, allowing various kinds of colour manipulation to be performed straightforwardly. For example, let's find the saturation level of a few built-in colours. ```r saturation(c("papayawhip","lavenderblush","olivedrab")) ## [1] 0.1647100 0.0588200 0.7535287 ``` Now let's consider a colour gradient stepping through two different colour spaces, which we might want to use as a palette or colour scale. ```r swatch(gradient(c("red","blue"), 5)) ``` ![plot of chunk gradients](tools/figures/gradients-1.svg) ```r swatch(gradient(c("red","blue"), 5, space="Lab")) ``` ![plot of chunk gradients](tools/figures/gradients-2.svg) Here, we are using the `swatch` function to visualise a set of colours as a series of squares. Notice the more uniform appearance of the gradient when it traverses through the [Lab colour space](https://en.wikipedia.org/wiki/Lab_color_space). Similarly, we can create a set of new colours by changing the brightness and saturation levels of some base colours, and make the code more readable by using the [`magrittr` pipe operator](https://github.com/tidyverse/magrittr). ```r library(shades); library(magrittr) c("red","blue") %>% brightness(0.6) %>% saturation(seq(0,1,0.25)) %>% swatch ``` ![plot of chunk saturation](tools/figures/saturation-1.svg) This operation takes the original two colours, reduces their brightness to 60%, assigns a whole series of saturation levels to the result, and then passes it to `swatch` for visualisation. Notice that the pipeline is combinative (like the base function `outer`), returning each combination of parameters in a multidimensional array. The final shades are arranged in two rows by `swatch`, for convenience. Note that `NA` can be used as a pass-through value: ```r "cornflowerblue" %>% saturation(c(NA,seq(0,1,0.25))) %>% swatch ``` ![plot of chunk missing](tools/figures/missing-1.svg) Any of these gradients can be directly passed to a standard graphical function, to be used as a colour scale. However, when choosing a colour scale, it is helpful to bear in mind that some viewers may have a colour vision deficiency (colour blindness), making it harder for them to distinguish certain colours and therefore to see a continuous scale. The `dichromat` function can be used to simulate this. ```r rev(grDevices::rainbow(9)) %>% dichromat %>% swatch ``` ![plot of chunk dichromat](tools/figures/dichromat-1.svg) ```r gradient("viridis",9) %>% dichromat %>% swatch ``` ![plot of chunk dichromat](tools/figures/dichromat-2.svg) Here we are using the built-in "viridis" colour map, [developed for Python's `matplotlib`](http://bids.github.io/colormap/), which was specifically designed to appear continuous under as many conditions as possible. When shown with simulated red-blindness, the default for `dichromat`, it is clearly much more interpretable than a typical rainbow palette generated by R's built-in graphics functions. The package also supports colour mixing, either additively (as with light) or subtractively (as with paint). For example, consider additive mixtures of the three primary RGB colours. ```r c("red", addmix("red","green"), "green", addmix("green","blue"), "blue") %>% swatch ``` ![plot of chunk addmix](tools/figures/addmix-1.svg) Similarly, we can subtractively combine the three secondary colours. ```r c("cyan", submix("cyan","magenta"), "magenta", submix("magenta","yellow"), "yellow") %>% swatch ``` ![plot of chunk submix](tools/figures/submix-1.svg) A "light mixture" infix operator, `%.)%`, and a "paint mixture" infix operator, `%_/%`, are also available. ```r ("red" %.)% "green") == "yellow" ## [1] TRUE ("cyan" %_/% "magenta") == "blue" ## [1] TRUE ``` Finally, you can calculate perceptual distances to a reference colour, as in ```r distance(c("red","green","blue"), "red") ## [1] 0.00000 86.52385 53.07649 ``` ## Interoperability with ggplot2 The `shades` package can be used with the popular [`ggplot2` graphics library](https://github.com/tidyverse/ggplot2) in different ways, with different levels of integration. Firstly, gradients from this package can be used as `ggplot2` colour scales through the manual scale functions; for example, ```r library(shades); library(ggplot2) mtcars$cyl<- factor(mtcars$cyl) ggplot(mtcars, aes(cyl,mpg,fill=cyl)) + geom_boxplot() + scale_fill_manual(values=gradient("viridis",3)) ``` ![plot of chunk ggplot](tools/figures/ggplot-1.svg) This does not require the two packages to know anything about each other, and is flexible and powerful, but it doesn't easily allow existing `ggplot2` scales to be modified using the colour manipulation functions from `shades`. As of `shades` version 1.3.0, it is also possible to call the package's colour property functions directly on palette functions and scales, so that (for example), we can darken all colours in an existing scale slightly: ```r ggplot(mtcars, aes(cyl,mpg,fill=cyl)) + geom_boxplot() + scale_fill_brewer(type="qual") ``` ![plot of chunk scales](tools/figures/scales-1.svg) ```r ggplot(mtcars, aes(cyl,mpg,fill=cyl)) + geom_boxplot() + lightness(scale_fill_brewer(type="qual"), delta(-20)) ``` ![plot of chunk scales](tools/figures/scales-2.svg) Notice here that we have chosen to use the `delta()` function, which is available in all colour property functions, to request a *relative* reduction of 20 to the original lightness of each colour in the scale. We could also have given a literal value to fix the lightness of all colours to a certain level. ## Related packages The `shades` package aims to bring together a range of colour manipulation tools and make them easy to use. However, there are several other packages available that can do similar things, sometimes in slightly different ways. These include - the `grDevices` package, which is shipped with R and used as the basis for `shades`; - the venerable [`colorspace` package](https://cran.r-project.org/package=colorspace), which provides formal colour classes and transformations between spaces; - [`munsell`](https://cran.r-project.org/package=munsell), which interprets colours in Munsell notation and does some colour manipulation; - [`viridis`](https://cran.r-project.org/package=viridis) and [`RColorBrewer`](https://cran.r-project.org/package=RColorBrewer), which provide the colour scales from `matplotlib` and ColorBrewer; - [`dichromat`](https://cran.r-project.org/package=dichromat), which provides another implementation of the `dichromat` function (a duplication which I didn't discover until after writing this package's version!); and - [`colorblindr`](https://github.com/clauswilke/colorblindr), which provides alternative tools for simulating colour blindness in figures. This package was also partly influenced by [Colors.jl](https://github.com/JuliaGraphics/Colors.jl), a colour manipulation package for Julia. r-cran-shades-1.4.0/man/000077500000000000000000000000001411316204200147105ustar00rootroot00000000000000r-cran-shades-1.4.0/man/complement.Rd000066400000000000000000000012421411316204200173410ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mixtures.R \name{complement} \alias{complement} \title{Complementary colours} \usage{ complement(shades, space = NULL) } \arguments{ \item{shades}{One or more colours, in any suitable form (see \code{\link{shade}}), or a palette function or scale.} \item{space}{The space in which to take the complement.} } \value{ New colours of class \code{"shade"}, or a new palette function. } \description{ This function returns the complement of its argument, the "opposite" colours in the specified space. } \examples{ complement("cyan") complement("cyan", space="HSV") complement("cyan", space="Lab") } r-cran-shades-1.4.0/man/coords.Rd000066400000000000000000000011251411316204200164670ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shade.R \name{coords} \alias{coords} \title{Retrieve the coordinates of a colour vector} \usage{ coords(x, ...) } \arguments{ \item{x}{An R object.} \item{...}{Additional arguments to methods.} } \value{ A matrix giving colour coordinates in the relevant space, one colour per row. Columns are typically named. } \description{ This function retrieves the coordinates of a colour vector's elements, within whatever space it is currently defined. } \examples{ coords("red") } \author{ Jon Clayden } r-cran-shades-1.4.0/man/dichromat.Rd000066400000000000000000000027131411316204200171540ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adaptation.R \name{dichromat} \alias{dichromat} \title{Simulate colour appearance for dichromats} \usage{ dichromat(shades, type = c("protanopic", "deuteranopic", "tritanopic", "none")) } \arguments{ \item{shades}{One or more colours, in any suitable form (see \code{\link{shade}}).} \item{type}{The type of colour vision deficiency to simulate: protanopia (red blindness), deuteranopia (green blindness) or tritanopia (blue blindness). The latter is the rarest in the population. \code{"none"} is also available, as a pass-through option. Abbrevations, such as the first letter, may be used, and multiple values are acceptable.} } \value{ New colours of class \code{"shade"} in LMS space, representing projections of the original shades onto a submanifold appropriate to the type of dichromacy being simulated. } \description{ This functions manipulates colours to simulate the effects of different kinds of colour blindness, and specifically dichromacy, in which only two of the usual three types of photoreceptors are present. There are three types, corresponding to the loss of red, green or blue photoreceptors. } \examples{ dichromat(c("red", "green", "blue")) } \references{ Brettel, H., Viénot, F. and Mollon, J.D. (1997). Computerized simulation of color appearance for dichromats. Journal of the Optical Society of America A 14(10):2647-2655. } \author{ Jon Clayden } r-cran-shades-1.4.0/man/distance.Rd000066400000000000000000000014701411316204200167730ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/distance.R \name{distance} \alias{distance} \title{Colour distance} \usage{ distance(shades, reference) } \arguments{ \item{shades}{One or more colours, in any suitable form (see \code{\link{shade}}).} \item{reference}{A single reference colour.} } \value{ A numeric vector of distances. } \description{ This function calculates a distance measure that aims to quantify the perceptual difference between a vector of colours and a reference colour. The measure in question is the CIE Delta E (2000), which is calculated based on colour coordinates in Lab space. } \examples{ distance(c("red","green","blue"), "red") } \references{ \url{http://www.brucelindbloom.com/index.html?Eqn_DeltaE_CIE2000.html} } \author{ Jon Clayden } r-cran-shades-1.4.0/man/gradient.Rd000066400000000000000000000032341411316204200167760ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scales.R \name{gradient} \alias{gradient} \title{Colour gradients} \usage{ gradient(shades, steps = NULL, space = NULL) } \arguments{ \item{shades}{Two or more colours, in any suitable form (see \code{\link{shade}}), or a named colour map such as \code{"viridis"}.} \item{steps}{An integer giving the number of shades required in the palette. If \code{NULL}, a function will instead be returned that takes this argument.} \item{space}{The colour space to traverse. Defaults to the current space of \code{shades}, or \code{"Lab"} for the \code{matplotlib} colour maps, or \code{"sRGB"} otherwise.} } \value{ A character vector of class \code{"shade"} containing the gradient elements in the specified space, or a palette function. } \description{ This function returns a set of colours interpolating between the specified key colours, equally separated in the specified space. } \details{ The key colours may be specified explicitly, or else a built-in colour map may be used. The maps available are currently those developed for Python's \code{matplotlib} 2.0, namely \code{"magma"}, \code{"inferno"}, \code{"plasma"} and \code{"viridis"}, and certain ColorBrewer palettes, namely \code{"Blues"}, \code{"Reds"}, \code{"YlOrRd"} (yellow-orange-red) and \code{"RdBu"} (red-grey-blue, a balanced diverging scale). } \examples{ gradient(c("red","blue"), 5) gradient(c("red","blue"), 5, space="Lab") gradient("viridis", 5) } \references{ \url{http://bids.github.io/colormap/} for the \code{matplotlib} colour maps; \url{http://colorbrewer2.org} for the ColorBrewer ones. } \author{ Jon Clayden } r-cran-shades-1.4.0/man/mixtures.Rd000066400000000000000000000023461411316204200170640ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mixtures.R \name{addmix} \alias{addmix} \alias{submix} \alias{\%.)\%} \alias{\%_/\%} \title{Colour mixtures} \usage{ addmix(base, mixer, amount = 1, space = NULL) submix(base, mixer, amount = 1, space = NULL) X \%.)\% Y X \%_/\% Y } \arguments{ \item{base, X}{A vector of base colours, or a palette function or scale.} \item{mixer, Y}{A vector of colours to mix in.} \item{amount}{The amount of each colour to mix in, relative to the amount of the base. This will be recycled to the length of \code{mixer}.} \item{space}{A string giving the space in which to perform the mixing, or \code{NULL}. In the latter case, the space of \code{base} will be used.} } \value{ New colours of class \code{"shade"}, or a new palette function. } \description{ These functions allow colours to be mixed in any colour space, either additively (like light) or subtractively (like paint). The infix form \code{\%.)\%} is an alternative for \code{addmix}, and \code{\%_/\%} for \code{submix}, with the mixing amount being fixed to 1 in these cases. } \examples{ addmix(c("red","green","blue"), "red") submix(c("cyan","magenta","yellow"), "cyan") } \author{ Jon Clayden } r-cran-shades-1.4.0/man/properties.Rd000066400000000000000000000053421411316204200173770ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/properties.R \name{saturation} \alias{saturation} \alias{brightness} \alias{lightness} \alias{chroma} \alias{hue} \alias{opacity} \alias{delta} \alias{scalefac} \alias{recycle} \title{Query or change colour properties} \usage{ saturation(shades, values = NULL) brightness(shades, values = NULL) lightness(shades, values = NULL) chroma(shades, values = NULL) hue(shades, values = NULL) opacity(shades, values = NULL) delta(...) scalefac(...) recycle(...) } \arguments{ \item{shades}{One or more colours, in any suitable form (see \code{\link{shade}}), or a palette function or scale.} \item{values}{New values for the property in question, with \code{NA} as a pass-through value that will leave the property as-is. If \code{NULL}, the current value(s) will be returned. May also be a function computing new values from old ones, such as \code{delta}, which adds its argument, or \code{scalefac}, which multiplies it.} \item{...}{Arguments to replacement functions \code{delta}, \code{scalefac} and \code{recycle}, which will be concatenated.} } \value{ Current colour property values, or new colours of class \code{"shade"}. If \code{shades} is a function, the result will be a new function that wraps the old one and modifies its return value accordingly. } \description{ These functions obtain the value of a colour property, or modify it. They will convert between colour spaces as required, but the RGB representation will be appropriately updated in the result. } \details{ Brightness and lightness differ technically, in the sense that one is absolute and the other is relative. Intuitively, a grey square on white paper is brighter under bright sunlight than in a dark room, but its lightness (relative to the white around it) is constant between conditions. In these functions, brightness is ``value'' in HSV space and is between 0 and 1, while lightness is defined in Lab space and is between 0 and 100. Saturation and chroma are also related. Hue is defined in HSV space, with red at 0º (and 360º), which is generally the most familiar parameterisation. } \note{ The colour property functions are vectorised over both of their arguments, such that the dimensions of the result will be \code{c(length(values),dim(shades))}. However, the \code{recycle} function can be used to suppress the usual dimensional expansion, and instead follow R's standard recycling rule. } \examples{ saturation(c("papayawhip","lavenderblush","olivedrab")) saturation("papayawhip", 0.7) saturation("papayawhip", delta(0.2)) saturation("papayawhip", scalefac(1.5)) saturation(c("red","green"), c(0.4,0.6)) saturation(c("red","green"), recycle(0.4,0.6)) } \author{ Jon Clayden } r-cran-shades-1.4.0/man/shade.Rd000066400000000000000000000047141411316204200162710ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shade.R \name{shade} \alias{shade} \alias{shades} \alias{shade.shade} \alias{shade.color} \alias{shade.matrix} \alias{shade.character} \alias{shade.default} \alias{print.shade} \alias{[.shade} \alias{[<-.shade} \alias{c.shade} \alias{rep.shade} \alias{rev.shade} \alias{==.shade} \alias{!=.shade} \alias{all.equal.shade} \title{The shade class} \usage{ shade(x, ...) \method{shade}{shade}(x, ...) \method{shade}{color}(x, ...) \method{shade}{matrix}(x, space = "sRGB", alpha = NULL, ...) \method{shade}{character}(x, ...) \method{shade}{default}(x, ...) \method{print}{shade}(x, ...) \method{[}{shade}(x, i) \method{[}{shade}(x, i) <- value \method{c}{shade}(...) \method{rep}{shade}(x, ...) \method{rev}{shade}(x) \method{==}{shade}(x, y) \method{!=}{shade}(x, y) \method{all}{equal.shade}(target, current, hexonly = FALSE, ...) } \arguments{ \item{x, y}{R objects, or \code{"shade"} objects for methods.} \item{...}{Additional parameters to methods. For \code{c}, any number of colours in any acceptable form.} \item{space}{For a matrix, the space in which coordinates are being provided.} \item{alpha}{For a matrix, an associated vector of opacity values between 0 and 1, if required.} \item{i}{An index vector.} \item{value}{A vector of replacement colours.} \item{target, current}{Shade vectors to compare.} \item{hexonly}{If \code{TRUE}, compare only on the basis of the hex strings. Otherwise test for equal coordinates.} } \value{ A character vector of class \code{"shade"}, with additional attributes as follows. \item{space}{A string naming a color space.} \item{coords}{A matrix giving colour coordinates in the relevant space, one colour per row.} } \description{ Objects of class \code{"shade"} are simply standard R character vectors representing one or more 8-bit (s)RGB colours in CSS-like hex format, but with extra attributes giving the current colour space and coordinates. } \details{ Comparison between \code{"shade"} objects \code{x} and \code{y} is achieved by converting \code{y} (the second argument) into the colour space of \code{x} and then comparing coordinates, after any clipping. } \note{ When concatenating, shades that are all from the same space will remain in that space, but shades from different spaces will be warped to ``XYZ'' space. } \examples{ s <- shade(c("red", "green", "blue")) s[1] s[1] <- "pink" } \author{ Jon Clayden } r-cran-shades-1.4.0/man/space.Rd000066400000000000000000000007351411316204200162770ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shade.R \name{space} \alias{space} \title{Retrieve the space of a colour vector} \usage{ space(x, ...) } \arguments{ \item{x}{An R object.} \item{...}{Additional arguments to methods.} } \value{ A string naming a colour space. } \description{ This function retrieves the colour space in which its argument is currently defined. } \examples{ space("red") } \author{ Jon Clayden } r-cran-shades-1.4.0/man/swatch.Rd000066400000000000000000000013331411316204200164700ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/swatch.R \name{swatch} \alias{swatch} \title{Simple colour swatches} \usage{ swatch(x, bg = "white", ...) } \arguments{ \item{x}{One or more colours, in any suitable form (see \code{\link{shade}}).} \item{bg}{A background colour.} \item{...}{Additional arguments (currently unused).} } \description{ This function provides a simple visualisation of a colour series as a series of boxes against the specified background colour. If the input has more than one dimension then the boxes will be arranged in a grid (flattening further dimensions after the second). } \examples{ swatch(c("red", "green", "blue")) } \author{ Jon Clayden } r-cran-shades-1.4.0/man/warp.Rd000066400000000000000000000025611411316204200161540ustar00rootroot00000000000000% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shade.R \name{warp} \alias{warp} \title{Shift colours between spaces} \usage{ warp(x, space) } \arguments{ \item{x}{An R object which can be coerced to class \code{"shade"}.} \item{space}{A string naming the new space.} } \value{ A new object of class \code{"shade"}. } \description{ This function shifts the current colour space of its arguments to the specified space, returning a new object of class \code{"shade"}. } \details{ Valid names for spaces are currently those supported by the \code{\link{convertColor}} function, namely ``sRGB'', ``Apple RGB'', ``CIE RGB'', ``XYZ'', ``Lab'' and ``Luv''; plus ``RGB'' (which is treated as an alias for ``sRGB''), ``HSV'', ``LCh'' and ``LMS''. Case is not significant. } \note{ LMS space, used for chromatic adaptation and simulating colour blindness, is not uniquely defined. Here we use the (linearised) Bradford transform, obtained by Lam (1985) and used widely in ICC colour profiles and elsewhere, to transform to and from CIE XYZ space. R uses the D65 standard illuminant as the reference white for the ``Lab'' and ``Luv'' spaces. } \examples{ warp("red", "HSV") } \references{ Lam, K.M. (1985). Metamerism and colour constancy. PhD thesis, University of Bradford. } \seealso{ \code{\link{convertColor}} } \author{ Jon Clayden } r-cran-shades-1.4.0/tests/000077500000000000000000000000001411316204200152775ustar00rootroot00000000000000r-cran-shades-1.4.0/tests/testthat.R000066400000000000000000000000701411316204200172570ustar00rootroot00000000000000library(testthat) library(shades) test_check("shades") r-cran-shades-1.4.0/tests/testthat/000077500000000000000000000000001411316204200171375ustar00rootroot00000000000000r-cran-shades-1.4.0/tests/testthat/test-05-shade.R000066400000000000000000000034671411316204200215570ustar00rootroot00000000000000context("Creating and converting shade objects") test_that("shade objects can be created from various objects", { expect_error(shade(), "must not be empty") expect_error(shade(character(0)), "must not be empty") expect_output(print(shade("red")), "1 shade") expect_equal(space(shade("red")), "sRGB") expect_equivalent(coords("red"), matrix(c(1,0,0),nrow=1)) expect_equivalent(shade(matrix(c(1,0,0),nrow=1)), shade("#FF0000")) # Using a factor to check the default initialisation method expect_equivalent(shade(factor(rep("red",3))), rep(shade("red"),3)) skip_if_not_installed("colorspace") expect_true(shade(colorspace::sRGB(1,0,0)) == "red") }) test_that("shade objects can be converted between spaces", { expect_equivalent(coords(warp("red","HSV")), matrix(c(0,1,1),nrow=1)) expect_equivalent(round(coords(warp(shade("red"),"LAB"))), matrix(c(53,80,67),nrow=1)) # Check that precision loss isn't too great when making a round-trip conversion shade <- shade(matrix(runif(3),nrow=1), space="sRGB") expect_equivalent(coords(warp(warp(shade,"HSV"),"sRGB")), coords(shade), tolerance=1e-4) }) test_that("shade object can be indexed, combined and compared", { shades <- shade(c("red","green","blue")) expect_true(shades[1] == "red") shades[1] <- "darkred" expect_false(shades[1] == "red") expect_equal(c(shade("red"),shade("green")), shade(c("red","green"))) expect_true(shade("red") != shade("green")) expect_true(shade("red") == shade(matrix(c(0,1,1),nrow=1),space="HSV")) expect_equal(space(c(shade("red"), shade(matrix(c(0,1,1),nrow=1),space="HSV"))), "XYZ") expect_match(all.equal(shade("red"),shade("green")), "Mean colour distance is") expect_match(all.equal(shade("red"),shade(c("green","blue"))), "Lengths do not match") }) r-cran-shades-1.4.0/tests/testthat/test-10-scales.R000066400000000000000000000010641411316204200217300ustar00rootroot00000000000000context("Creating colour scales") test_that("colour scales can traverse different spaces", { expect_equal(gradient(c("red","blue"),3), c("#FF0000","#800080","#0000FF"), hexonly=TRUE) expect_equal(rev(gradient(c("red","blue"),3)), c("#0000FF","#800080","#FF0000"), hexonly=TRUE) expect_equal(gradient(c("red","blue"),3,space="LAB"), c("#FF0000","#C90089","#0000FF"), hexonly=TRUE) expect_equal(gradient("magma",3), c("#000004","#B63779","#FCFDBF"), hexonly=TRUE) expect_error(gradient("nothing",3), "should specify a predefined colour map") }) r-cran-shades-1.4.0/tests/testthat/test-15-properties.R000066400000000000000000000031701411316204200226570ustar00rootroot00000000000000context("Extracting and modifying colour properties") test_that("colour properties can be extracted", { expect_equal(saturation("red"), 1) expect_equal(brightness("red"), 1) expect_equal(saturation("grey40"), 0) expect_equal(brightness(c("grey40","grey60")), c(0.4,0.6)) expect_equal(round(chroma(c("black","white","red"))), c(0,0,105)) expect_equal(round(lightness(c("black","white","red"))), c(0,100,53)) }) test_that("colour properties can be manipulated", { expect_equal(saturation("red",0.5), shade("#FF8080"), hexonly=TRUE) expect_equal(brightness("red",0.5), shade("#800000"), hexonly=TRUE) expect_equal(hue("red",delta(240)), shade("#0000FF"), hexonly=TRUE) expect_equal(hue("blue",delta(240)), shade("#00FF00"), hexonly=TRUE) expect_equal(lightness("red",scalefac(0.5)), shade("#A60000"), hexonly=TRUE) expect_equal(brightness("red",scalefac(0.4,0.6)), c("#660000","#990000"), hexonly=TRUE) expect_equivalent(coords(brightness("grey40",c(0.2,0.6))), matrix(c(0,0,0,0,0.2,0.6),nrow=2)) }) test_that("manipulated colour matrices have the expected dimensions", { shades <- shade(c("red","green","blue")) matrix <- rep(shades, 2) dim(matrix) <- c(3L,2L) expect_null(dim(brightness(shades,0.5))) expect_equal(length(brightness(shades,0.5)), 3L) expect_equal(dim(brightness(shades,c(0.4,0.6))), c(2L,3L)) expect_equal(brightness(shades,c(0.4,0.6)), c("#660000","#990000","#006600","#009900","#000066","#000099"), hexonly=TRUE) expect_equal(dim(brightness(matrix,c(0.4,0.6))), c(2L,3L,2L)) expect_equal(dim(brightness(matrix,recycle(0.4,0.6))), c(3L,2L)) }) r-cran-shades-1.4.0/tests/testthat/test-20-mixtures.R000066400000000000000000000010721411316204200223360ustar00rootroot00000000000000context("Mixing colours") test_that("shade objects can be mixed and complements calculated", { expect_equivalent(coords(complement("cyan")), coords(shade("red"))) expect_equal(complement("cyan",space="HSV"), warp("red","HSV")) expect_equal(complement("cyan",space="Lab"), "#4F0002", hexonly=TRUE) expect_equivalent(addmix("blue","green"), shade("#00FFFF")) expect_equivalent(submix("cyan","yellow"), shade("#00FF00")) expect_equivalent("blue" %.)% "green", shade("#00FFFF")) expect_equivalent("cyan" %_/% "yellow", shade("#00FF00")) }) r-cran-shades-1.4.0/tests/testthat/test-25-distance.R000066400000000000000000000004141411316204200222540ustar00rootroot00000000000000context("Calculating colour distances") test_that("colour distances can be calculated", { expect_equal(round(distance(c("red","green","blue"),"red")), c(0,87,53)) expect_error(distance("red", c("red","green","blue")), "Reference should be a single shade") }) r-cran-shades-1.4.0/tests/testthat/test-30-adaptation.R000066400000000000000000000010271411316204200226030ustar00rootroot00000000000000context("Colour adaptation") test_that("dichromacy can be simulated", { primaries <- shade(c("red", "green", "blue")) expect_equivalent(dichromat(primaries), c("#4D4222","#FFF600","#0027FF"), hexonly=TRUE) expect_equivalent(dichromat(primaries,"protanopic"), c("#4D4222","#FFF600","#0027FF"), hexonly=TRUE) expect_equivalent(dichromat(primaries,"deuteranopic"), c("#C5A700","#D0B335","#0068FE"), hexonly=TRUE) expect_equivalent(dichromat(primaries,"tritanopic"), c("#FF0050","#00FBFF","#372828"), hexonly=TRUE) }) r-cran-shades-1.4.0/tests/testthat/test-35-swatch.R000066400000000000000000000004221411316204200217530ustar00rootroot00000000000000context("Graphics") test_that("the swatch function works", { expect_null(swatch(c("red", "green", "blue"))) grDevices::dev.off() expect_null(swatch(saturation(brightness(c("red", "green", "blue"), c(0.25,0.75)), c(0.25,0.75)))) grDevices::dev.off() }) r-cran-shades-1.4.0/tests/testthat/test-40-alpha.R000066400000000000000000000021771411316204200215540ustar00rootroot00000000000000context("Working with transparency") test_that("opacity can be obtained and manipulated", { expect_equal(opacity("red"), 1) expect_equal(opacity("#FF000080"), 128/255) expect_equal(opacity(saturation("#FF000080",0.5)), 128/255) expect_equal(warp("#FF000080","HSV"), "#FF000080", hexonly=TRUE) expect_equal(opacity("red",c(0,0.5)), c("#FF000000","#FF000080"), hexonly=TRUE) expect_equal(opacity("red",delta(-0.5)), "#FF000080", hexonly=TRUE) expect_null(attr(opacity("#FF000080",delta(0.5)),"alpha")) shades <- shade(c("red","green","blue")) matrix <- rep(shades, 2) dim(matrix) <- c(3L,2L) expect_null(attr(shades,"alpha")) expect_equal(opacity(c(shades,"#00000000")), c(1,1,1,0)) shades[2] <- "#00FF0000" expect_equal(attr(shades,"alpha"), c(1,0,1)) expect_equal(dim(opacity(matrix,0.5)), c(3L,2L)) expect_equal(dim(opacity(matrix,recycle(0.4,0.6))), c(3L,2L)) expect_true(shade("#FF8080") == shade("#FF8080FF")) expect_false(shade("#FF8080") == shade("#FF8080DD")) expect_match(all.equal(shade("#FF8080"), "#FF8080DD"), "Alpha values do not match") }) r-cran-shades-1.4.0/tests/testthat/test-45-functions.R000066400000000000000000000042761411316204200225060ustar00rootroot00000000000000context("Handling palette functions") test_that("property methods can be applied to functions", { viridis <- gradient("viridis") expect_equal(viridis(5L), gradient("viridis",5L)) # The distinction is in the parentheses here: in one case lightness() is called on colours generated by the colour ramp; in the other, the ramp function is wrapped by lightness() and then called expect_equal(lightness(viridis(5L)), lightness(viridis)(5L)) expect_equal(lightness(viridis(5L),50), lightness(viridis,50)(5L)) expect_equal(opacity(viridis(5L),0.5), opacity(viridis,0.5)(5L)) expect_equal(complement(viridis(5L)), complement(viridis)(5L)) expect_equal(addmix(viridis(5L),"red"), addmix(viridis,"red")(5L)) expect_equal(submix(viridis(5L),"red"), submix(viridis,"red")(5L)) skip_if_not_installed("ggplot2") library(ggplot2) data <- data.frame(sex=c("M","M","F","F"), age=c(23,34,28,26), height=c(180,168,159,170)) # This relies on scales::viridis_pal (at time of writing) agreeing with our viridis scale, but this seems less fragile than assuming that scales and ggplot2 continue to interact the way they do now (and adding another suggested dependency) plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + lightness(scale_colour_viridis_d(), 50) expect_true(all(layer_data(plot)$colour %in% lightness(viridis(2), 50))) plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + opacity(scale_colour_viridis_d(), 0.5) expect_true(all(layer_data(plot)$colour %in% opacity(viridis(2), 0.5))) plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + complement(scale_colour_viridis_d()) expect_true(all(layer_data(plot)$colour %in% complement(viridis(2),space="sRGB"))) plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + addmix(scale_colour_viridis_d(), "red") expect_true(all(layer_data(plot)$colour %in% addmix(viridis(2), "red", space="sRGB"))) plot <- ggplot(data, aes(x=age,y=height,colour=sex)) + geom_point() + submix(scale_colour_viridis_d(), "red") expect_true(all(layer_data(plot)$colour %in% submix(viridis(2), "red", space="sRGB"))) }) r-cran-shades-1.4.0/tests/testthat/test-50-missing.R000066400000000000000000000017531411316204200221400ustar00rootroot00000000000000context("Missing value handling") test_that("missing shades are handled properly", { shades <- gradient(c("red","blue"), 3) shades[2] <- NA expect_equal(is.na(shades), c(FALSE,TRUE,FALSE)) expect_true(all(is.na(coords(shades)[2,]))) expect_equal(saturation(shades), c(1,NA,1)) expect_equal(saturation(shades,0.5), shade(c("#FF8080",NA,"#8080FF")), hexonly=TRUE) expect_equivalent(is.na(saturation(shades, c(0,0.5,1))), matrix(c(FALSE,TRUE,FALSE),3,3,byrow=TRUE)) expect_equivalent(complement(shades), shade(c("#00FFFF",NA,"#FFFF00"))) expect_equivalent(dichromat(shades)[2], shade(NA)) expect_equal(opacity(shades,0.5), c("#FF000080",NA,"#0000FF80"), hexonly=TRUE) }) test_that("NAs as new property values lead to pass-through", { expect_equal(saturation(saturation("olivedrab",NA)), saturation("olivedrab")) expect_equal(opacity("red",NA), "red") expect_equal(opacity("red",c(0,NA,1)), c("#FF000000","#FF0000FF","#FF0000FF"), hexonly=TRUE) }) r-cran-shades-1.4.0/tools/000077500000000000000000000000001411316204200152755ustar00rootroot00000000000000r-cran-shades-1.4.0/tools/figures/000077500000000000000000000000001411316204200167415ustar00rootroot00000000000000r-cran-shades-1.4.0/tools/figures/addmix-1.svg000066400000000000000000000037451411316204200210770ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/dichromat-1.svg000066400000000000000000000062101411316204200215710ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/dichromat-2.svg000066400000000000000000000063061411316204200216000ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/ggplot-1.svg000066400000000000000000001037351411316204200211250ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/gradients-1.svg000066400000000000000000000040121411316204200215750ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/gradients-2.svg000066400000000000000000000040111411316204200215750ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/missing-1.svg000066400000000000000000000043141411316204200212730ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/saturation-1.svg000066400000000000000000000073101411316204200220120ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/scales-1.svg000066400000000000000000001037351411316204200211030ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/scales-2.svg000066400000000000000000001037351411316204200211040ustar00rootroot00000000000000 r-cran-shades-1.4.0/tools/figures/submix-1.svg000066400000000000000000000037471411316204200211420ustar00rootroot00000000000000