R/color_scales.R

In Rbearcat: University of Cincinnati Themes and Utilities for Econometrics and Data Science

#' Okabe-Ito color scale
#'
#' This is a color-blind friendly, qualitative scale with eight different colors from
#' the colorblindr package (\url{https://github.com/clauswilke/colorblindr}).
#' @param use_black If \code{TRUE}, scale includes black, otherwise includes gray.
#' @param order Numeric vector listing the order in which the colors should be used. Default is 1:8.
#' @param darken Relative amount by which the scale should be darkened (for positive values) or lightened (for negative
#'   values).
#' @param alpha Alpha transparency level of the color. Default is no transparency.
#' @param ... common discrete scale parameters: \code{name}, \code{breaks}, \code{labels},
#' \code{na.value}, \code{limits}, \code{guide}, and \code{aesthetics}. see \code{ggplot2::discrete_scale} for more details.
#' @examples
#' library(ggplot2)
#' ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
#'   geom_point() + scale_color_OkabeIto()
#' ggplot(iris, aes(Sepal.Length, fill = Species)) +
#'   geom_density(alpha = 0.7) + scale_fill_OkabeIto(order = c(1, 3, 5))
#'
#' @return A discrete \code{ggplot2} scale object. The helper aliases return the
#'   same scale with \code{aesthetics} preset for colour or fill mappings.
#'
#' @family palettes
#' @export
#' @usage NULL
scale_OkabeIto <- function(aesthetics, use_black = FALSE, order = 1:8, darken = 0, alpha = NA, ...) {
  if (use_black) {

    values <- as.vector(palette_OkabeIto_black[order])
  }
  else {
    values <- as.vector(palette_OkabeIto[order])
  }

  n <- length(values)
  darken <- rep_len(darken, n)
  alpha <- rep_len(alpha, n)

  di <- darken > 0
  if (sum(di) > 0) { # at least one color needs darkening
    values[di] <- colorspace::darken(values[di], amount = darken[di])
  }

  li <- darken < 0
  if (sum(li) > 0) { # at least one color needs lightening
    values[li] <- colorspace::lighten(values[li], amount = -1*darken[li])
  }

  ai <- !is.na(alpha)
  if (sum(ai) > 0) { # at least one color needs alpha
    values[ai] <- scales::alpha(values[ai], alpha[ai])
  }

  ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = values, ...)
}

#' @rdname scale_OkabeIto
#' @export
#' @usage NULL
scale_colour_OkabeIto <- function(aesthetics = "colour", ...) {
  scale_OkabeIto(aesthetics, ...)
}

#' @rdname scale_OkabeIto
#' @export
#' @usage NULL
scale_color_OkabeIto <- scale_colour_OkabeIto

#' @rdname scale_OkabeIto
#' @export
#' @usage NULL
scale_colour_OkabeIto_light <- function(aesthetics = "colour", ...) {
  scale_OkabeIto(aesthetics, darken = -0.50, ...)
}

#' @rdname scale_OkabeIto
#' @export
#' @usage NULL
scale_color_OkabeIto_light <- scale_colour_OkabeIto_light

#' @rdname scale_OkabeIto
#' @export
#' @usage NULL
scale_fill_OkabeIto <- function(aesthetics = "fill", ...) {
  scale_OkabeIto(aesthetics, ...)
}

#' @rdname scale_OkabeIto
#' @export
#' @usage NULL
scale_fill_OkabeIto_light <- function(aesthetics = "fill", ...) {
  scale_OkabeIto(aesthetics, darken = -0.50, ...)
}

#' UC color scale
#'
#' Apply the official University of Cincinnati expanded palette to ggplot
#' graphics. The default ordering prioritizes the primary UC colors, followed
#' by expanded brand accents intended for data visualization.
#' @param order Numeric vector listing the order in which the colors should be used.
#' @param darken Relative amount by which the scale should be darkened (for positive values) or lightened (for negative
#'   values).
#' @param alpha Alpha transparency level of the color. Default is no transparency.
#' @param ... common discrete scale parameters: \code{name}, \code{breaks}, \code{labels},
#' \code{na.value}, \code{limits}, \code{guide}, and \code{aesthetics}. see \code{ggplot2::discrete_scale} for more details.
#' @examples
#' library(ggplot2)
#' ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
#'   geom_point() + scale_color_UC()
#' ggplot(iris, aes(Sepal.Length, fill = Species)) +
#'   geom_density(alpha = 0.7) + scale_fill_UC()
#'
#' @return A discrete \code{ggplot2} scale object. The helper aliases return the
#'   same scale with \code{aesthetics} preset for colour or fill mappings.
#'
#' @family palettes
#' @export
#' @usage NULL
scale_UC <- function(aesthetics, order = 1:7, darken = 0, alpha = NA, ...) {

  values <- as.vector(.uc_plot_palette()[order])

  n <- length(values)
  darken <- rep_len(darken, n)
  alpha <- rep_len(alpha, n)

  di <- darken > 0
  if (sum(di) > 0) {
    values[di] <- colorspace::darken(values[di], amount = darken[di])
  }

  li <- darken < 0
  if (sum(li) > 0) {
    values[li] <- colorspace::lighten(values[li], amount = -1 * darken[li])
  }

  ai <- !is.na(alpha)
  if (sum(ai) > 0) {
    values[ai] <- scales::alpha(values[ai], alpha[ai])
  }

  ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = values, ...)
}

#' @rdname scale_UC
#' @export
#' @usage NULL
scale_colour_UC <- function(aesthetics = "colour", ...) {
  scale_UC(aesthetics, ...)
}

#' @rdname scale_UC
#' @export
#' @usage NULL
scale_color_UC <- scale_colour_UC

#' @rdname scale_UC
#' @export
#' @usage NULL
scale_fill_UC <- function(aesthetics = "fill", ...) {
  scale_UC(aesthetics, ...)
}