#' Generate qualitative color palettes
#'
#' Given a color space or collection of colors, \code{qualpal()} projects
#' these colors to the DIN99d color space, where it generates a color palette
#' from the most visually distinct colors, optionally taking color vision
#' deficiency into account.
#'
#' The function takes a color subspace in the HSL color space, where lightness
#' and saturation take values from 0 to 1. Hue take values from -360 to 360,
#' although negative values are brought to lie in the range \{0, 360\}; this
#' behavior exists to enable color subspaces that span all hues being that the
#' hue space is circular.
#'
#' The HSL color subspace that the user provides is projected into the DIN99d
#' color space, which is approximately perceptually uniform, i.e. color
#' difference is proportional to the euclidean distance between two colors. A
#' distance matrix is computed and, as an additional step, is transformed using
#' power transformations discovered by Huang 2015 in order to fine tune
#' differences.
#'
#' \code{qualpal} then searches the distance matrix for the most
#' distinct colors; it does this iteratively by first selecting a random set of
#' colors and then iterates over each color, putting colors back into the total
#' set and replaces it with a new color until it has gone through the whole
#' range without changing any of the colors.
#'
#' Optionally, \code{qualpal} can adapt palettes to cater to color vision
#' deficiency (cvd). This is accomplished by taking the colors
#' provided by the user and transforming them to colors that someone with cvd
#' would see, that is, simulating cvd. qualpal then chooses colors from
#' these new colors.
#'
#' \code{qualpal} currently only supports the sRGB color space with the D65
#' white point reference.
#'
#' @param n The number of colors to generate.
#' @param colorspace A color space to generate colors from. Can be any of the
#' following:
#' \itemize{
#' \item A \code{\link{list}} with the following \emph{named} vectors,
#' each of length two, giving a range for each item.
#' \describe{
#' \item{\code{h}}{Hue, in range from -360 to 360}
#' \item{\code{s}}{Saturation, in the range from 0 to 1}
#' \item{\code{l}}{Lightness, in the range from 0 to 1}
#' }
#' \item A \code{\link{character}} vector of length one specifying one of
#' these predefined color spaces:
#' \describe{
#' \item{\code{pretty}}{
#' Tries to provide aesthetically pleasing,
#' but still distinct color palettes. Hue ranges from 0 to 360,
#' saturation from 0.1 to 0.5, and lightness from 0.5 to 0.85. This
#' palette is not suitable for high \code{n}}
#' \item{\code{pretty_dark}}{
#' Like \code{pretty} but darker. Hue ranges from 0 to 360, saturation
#' from 0.1 to 0.5, and lightness from 0.2 to 0.4.
#' }
#' \item{\code{rainbow}}{
#' Uses all hues, chromas, and most of the lightness range. Provides
#' distinct but not aesthetically pleasing colors.
#' }
#' \item{\code{pastels}}{
#' Pastel colors from the complete range of hues (0-360), with
#' saturation between 0.2 and 0.4, and lightness between 0.8 and 0.9.
#' }
#' }
#' \item A \code{\link{matrix}} of colors from the sRGB color space, each
#' row representing a unique color.
#' \item A \code{\link{data.frame}} that can be converted to a matrix via
#' \link{data.matrix}
#' }
#'
#' @param cvd Color vision deficiency adaptation. Use \code{cvd_severity}
#' to set the severity of color vision deficiency to adapt to. Permissible
#' values are \code{"protan", "deutan",} and \code{"tritan"}.
#' @param cvd_severity Severity of color vision deficiency to adapt to. Can take
#' any value from 0, for normal vision (the default), and 1, for dichromatic
#' vision.
#'
#' @return A list of class \code{qualpal} with the following
#' components.
#' \item{HSL}{
#' A matrix of the colors in the HSL color space.
#' }
#' \item{DIN99d}{
#' A matrix of the colors in the DIN99d color space (after power
#' transformations).
#' }
#' \item{RGB}{
#' A matrix of the colors in the sRGB color space.} \item{hex}{A
#' character vector of the colors in hex notation.} \item{de_DIN99d}{A
#' distance matrix of color differences according to delta E DIN99d.
#' }
#' \item{min_de_DIN99d}{
#' The smallest pairwise DIN99d color difference.
#' }
#' @seealso \code{\link{plot.qualpal}}, \code{\link{pairs.qualpal}}
#' @examples
#' # Generate 3 distinct colors from the default color space
#' qualpal(3)
#'
#' # Provide a custom color space
#' qualpal(n = 3, list(h = c(35, 360), s = c(0.5, 0.7), l = c(0, 0.45)))
#'
#' qualpal(3, "pretty")
#'
#' # Adapt palette to deuteranopia
#' qualpal(5, colorspace = "pretty_dark", cvd = "deutan", cvd_severity = 1)
#'
#' # Adapt palette to protanomaly with severity 0.4
#' qualpal(8, colorspace = "pretty_dark", cvd = "protan", cvd_severity = 0.4)
#'
#' \dontrun{
#' # The range of hue cannot exceed 360
#' qualpal(3, list(h = c(-20, 360), s = c(0.5, 0.7), l = c(0, 0.45)))
#' }
#'
#' @export
qualpal <- function(n,
colorspace = "pretty",
cvd = c("protan", "deutan", "tritan"),
cvd_severity = 0) {
UseMethod("qualpal", colorspace)
}
#' @export
qualpal.matrix <- function(n,
colorspace,
cvd = c("protan", "deutan", "tritan"),
cvd_severity = 0) {
assertthat::assert_that(
assertthat::is.count(n),
is.character(cvd),
assertthat::is.number(cvd_severity),
is.matrix(colorspace),
max(colorspace) <= 1,
min(colorspace) >= 0,
n < 100,
n > 1,
cvd_severity >= 0,
cvd_severity <= 1,
ncol(colorspace) == 3,
length(cvd_severity) == 1,
n > 0,
is_integer(n)
)
rgb_mat <- colorspace
cvd_list <- list(protan = 0, deutan = 0, tritan = 0)
cvd_list[[match.arg(cvd)]] <- cvd_severity
res <- qualpal_cpp_rgb(n, rgb_mat, cvd_list)
res$de_DIN99d <- stats::as.dist(res$de_DIN99d)
res
}
#' @export
qualpal.data.frame <- function(n, colorspace,
cvd = c("protan", "deutan", "tritan"),
cvd_severity = 0) {
mat <- data.matrix(colorspace)
qualpal(n = n, colorspace = mat, cvd = cvd, cvd_severity = cvd_severity)
}
#' @export
qualpal.character <- function(n, colorspace = "pretty",
cvd = c("protan", "deutan", "tritan"),
cvd_severity = 0) {
assertthat::assert_that(
assertthat::is.string(colorspace),
cvd_severity >= 0,
cvd_severity <= 1
)
colorspace <- predefined_colorspaces(colorspace)
qualpal(
n = n,
colorspace = colorspace,
cvd = match.arg(cvd),
cvd_severity = cvd_severity
)
}
#' @export
qualpal.list <- function(n,
colorspace,
cvd = c("protan", "deutan", "tritan"),
cvd_severity = 0) {
assertthat::assert_that(
assertthat::has_attr(colorspace, "names"),
"h" %in% names(colorspace),
"s" %in% names(colorspace),
"l" %in% names(colorspace)
)
h <- colorspace[["h"]]
s <- colorspace[["s"]]
l <- colorspace[["l"]]
n_points <- 1000
assertthat::assert_that(
diff(range(h)) <= 360,
min(h) >= -360,
max(h) <= 360,
min(s) >= 0,
max(s) <= 1,
min(l) >= 0,
max(l) <= 1,
length(h) == 2,
length(s) == 2,
length(l) == 2,
is.numeric(h),
is.numeric(s),
is.numeric(l),
cvd_severity >= 0,
cvd_severity <= 1,
n > 0,
n <= n_points,
is_integer(n)
)
cvd_list <- list(protan = 0, deutan = 0, tritan = 0)
cvd_list[[match.arg(cvd)]] <- cvd_severity
res <- qualpal_cpp_colorspace(n, colorspace, n_points, cvd_list)
res$de_DIN99d <- stats::as.dist(res$de_DIN99d)
res
}
#' Print qualpal palette
#'
#' Print the result from a call to \code{\link{qualpal}}.
#'
#' @param x An object of class \code{"qualpal"}.
#' @param colorspace Color space to print colors in.
#' @param digits Number of significant digits for the output.
#' (See \link{print.default}.) Setting it to \code{NULL} uses
#' \code{\link{getOption}("digits")}.
#' @param \dots Arguments to pass to \code{\link{print.default}}.
#'
#' @return Prints the colors as a matrix in the specified color space as well
#' as a distance matrix of the color differences. Invisibly returns x.
#' @export
#'
#' @examples
#' f <- qualpal(3)
#' print(f, colorspace = "DIN99d", digits = 3)
print.qualpal <- function(x,
colorspace = c("HSL", "DIN99d", "RGB"),
digits = 2,
...) {
vsep <- strrep("-", 0.5 * getOption("width"))
cat(vsep, "\n")
cat("Colors in the", match.arg(colorspace), "color space", "\n\n")
print(x[[match.arg(colorspace)]], digits = digits, ...)
cat("\n", vsep, "\n")
cat("DIN99d color difference distance matrix", "\n\n")
print(x[["de_DIN99d"]], digits = digits, ...)
invisible(x)
}
# Predefined color spaces -------------------------------------------------
predefined_colorspaces <- function(colorspace) {
spaces <- list(
pretty = list(h = c(0, 360), s = c(0.2, 0.5), l = c(0.6, 0.85)),
pretty_dark = list(h = c(0, 360), s = c(0.1, 0.5), l = c(0.2, 0.4)),
rainbow = list(h = c(0, 360), s = c(0, 1), l = c(0, 1)),
pastels = list(h = c(0, 360), s = c(0.2, 0.4), l = c(0.8, 0.9))
)
assertthat::assert_that(colorspace %in% names(spaces))
spaces[[colorspace]]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.