khroma coverage - 93.59%

Files
Source

# Color scales constructor for ggplot2
#' @include color.R
NULL

#' Color Scale Builder
#'
#' Builds a color scale for \pkg{ggplot2} or \pkg{ggraph}.
#' @param palette A [`character`] string giving the name of the color scheme to
#'  be used (see [info()]).
#' @param ... Extra parameters to be passed to the color scale function.
#' @return A [discrete][ggplot2::discrete_scale] or
#'  [continuous][ggplot2::continuous_scale] scale.
#' @example inst/examples/ex-pick.R
#' @author N. Frerebeau
#' @family ggplot2 scales
#' @name scale_picker
#' @rdname scale_picker
NULL

#' @export
#' @rdname scale_picker
scale_colour_picker <- function(..., palette = "YlOrBr") {
  fun <- sprintf("scale_colour_%s", palette)
  do.call(fun, args = list(...))
}

#' @export
#' @rdname scale_picker
scale_color_picker <- scale_colour_picker

#' @export
#' @rdname scale_picker
scale_fill_picker <- function(..., palette = "YlOrBr") {
  fun <- sprintf("scale_fill_%s", palette)
  do.call(fun, args = list(...))
}

#' @export
#' @rdname scale_picker
scale_edge_colour_picker <- function(..., palette = "YlOrBr") {
  fun <- sprintf("scale_edge_colour_%s", palette)
  do.call(fun, args = list(...))
}

#' @export
#' @rdname scale_picker
scale_edge_color_picker <- scale_edge_colour_picker

#' @export
#' @rdname scale_picker
scale_edge_fill_picker <- function(..., palette = "YlOrBr") {
  fun <- sprintf("scale_edge_fill_%s", palette)
  do.call(fun, args = list(...))
}

#' Color Scale Constructors
#'
#' Builds a discrete or continuous scale for \pkg{ggplot2} according to the
#' color scheme used.
#' @param aesthetics The names of the aesthetics that this scale works with.
#' @param scheme A [`character`] string giving the name of the scheme to be
#'  used (see [color()]).
#' @param guide A [`function`] used to create a guide or its name.
#'  See [ggplot2::guides()] for more information.
#' @param reverse A [`logical`] scalar: should the resulting vector of colors
#'  should be reversed?
#' @param use_names A [`logical`] scalar: should the names of the colors be
#'  preserved?
#' @param lang A [`character`] string specifying the language for the color
#'  names. It must be one of "`en`" (english, the default) or "`fr`" (french).
#' @param type A [`character`] string specifying the scale to be
#'  build. It must be one of "`auto`" (the default), "`discrete`" or
#'  "`continuous`". "`discrete`" allows to use a continuous color scheme with
#'  discrete data. "`continuous`" allows to use a discrete color scheme with
#'  continuous data (forces interpolation; see [color()]).
#' @param midpoint A [`numeric`] value specifying the midpoint (in
#'  data value) of the diverging scale (defaults to \eqn{0}).
#' @param ... Further arguments passed to [ggplot2::discrete_scale()]
#'  or [ggplot2::continuous_scale()], used respectively for qualitative data
#'  and diverging/sequential data.
#' @return A [discrete][ggplot2::discrete_scale()]
#'  or [continuous][ggplot2:continuous_scale()] scale.
#' @author N. Frerebeau
#' @keywords internal
#' @noRd
NULL

scale_discrete <- function(aesthetics, scheme, guide = "legend",
                           reverse = FALSE, use_names = FALSE,
                           lang = "en", ...) {
  # Check if ggplot2 is installed
  assert_package("ggplot2")

  # Get color scheme
  palette <- color(scheme, reverse = reverse, names = use_names, lang = lang)

  # Build scale
  scale_args <- list(...)
  scale_args$guide <- guide
  scale_args$na.value <- scale_args$na.value %||% attr(palette, "missing")

  do.call(
    ggplot2::discrete_scale,
    c(aesthetics = aesthetics, palette = palette, scale_args)
  )
}

scale_continuous <- function(aesthetics, scheme, guide = "colourbar",
                             reverse = FALSE, range = c(0, 1), midpoint = 0,
                             lang = "en", ...) {
  # Validation
  assert_package("ggplot2") # Check if ggplot2 is installed
  if (guide == "edge_colourbar") assert_package("ggraph")

  # Get color scheme
  palette <- color(scheme, reverse = reverse, names = FALSE, lang = lang)
  max <- attr(palette, "max")
  type <- attr(palette, "type")

  # Build scale
  scale_args <- list(...)
  scale_args$guide <- guide
  scale_args$na.value <- scale_args$na.value %||% attr(palette, "missing")

  if (type == "diverging") {
    scale_args$rescaler <- rescale_mid(mid = midpoint)
  }

  palette <- scales::gradient_n_pal(palette(max, range = range))
  do.call(
    ggplot2::continuous_scale,
    c(aesthetics = aesthetics, palette = palette, scale_args)
  )
}

rescale_mid <- function(mid) {
  function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) {
    scale_midpoint(x, to = to, from = from, midpoint = mid)
  }
}

# Okabe & Ito color scheme
#' @include color.R
NULL

# Discrete =====================================================================
#' Okabe and Ito's Discrete Color Scheme for \pkg{ggplot2} and \pkg{ggraph}
#'
#' Provides the qualitative color scale from Okabe and Ito 2008.
#' @param ... Arguments passed to [ggplot2::discrete_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param black_position A [`character`] string giving the position of the black
#'  color. It must be one of "`first`" or "`last`". Any unambiguous substring
#'  can be given.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @details
#'  This qualitative color scheme is used as given (no interpolation):
#'  colors are picked up to the maximum number of supported values (8).
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Okabe, M. & Ito, K. (2008). *Color Universal Design (CUD): How to Make
#'  Figures and Presentations That Are Friendly to Colorblind People*.
#'  URL: \url{https://jfly.uni-koeln.de/color/}.
#' @example inst/examples/ex-okabeito-discrete.R
#' @author N. Frerebeau
#' @family color-blind safe color schemes
#' @family qualitative color schemes
#' @family Okabe and Ito's color scheme
#' @name scale_okabeito_discrete
#' @rdname scale_okabeito_discrete
NULL

#' Get Okabe and Ito's Discrete Color Scheme
#'
#' @param black_position A [`character`] string giving the position of the black
#'  color. It must be one of "`first`" or "`last`". Any unambiguous substring
#'  can be given.
#' @examples
#' get_okabeito_scale("first")
#' get_okabeito_scale("last")
#' @keywords internal
#' @noRd
get_okabeito_scale <- function(black_position = c("first", "last")) {
  black_position <- match.arg(black_position, several.ok = FALSE)
  switch (black_position, first = "okabeito", last = "okabeitoblack")
}

#' @export
#' @rdname scale_okabeito_discrete
scale_colour_okabeito <- function(..., reverse = FALSE,
                                  black_position = c("first", "last"),
                                  aesthetics = "colour") {
  oi_palette <- get_okabeito_scale(black_position)
  scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
}

#' @export
#' @rdname scale_okabeito_discrete
scale_color_okabeito <- scale_colour_okabeito

#' @export
#' @rdname scale_okabeito_discrete
scale_fill_okabeito <- function(..., reverse = FALSE,
                                black_position = c("first", "last"),
                                aesthetics = "fill") {
  oi_palette <- get_okabeito_scale(black_position)
  scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
}

#' @export
#' @rdname scale_okabeito_discrete
scale_edge_colour_okabeito <- function(..., reverse = FALSE,
                                       black_position = c("first", "last"),
                                       aesthetics = "edge_colour") {
  oi_palette <- get_okabeito_scale(black_position)
  scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
}

#' @export
#' @rdname scale_okabeito_discrete
scale_edge_color_okabeito <- scale_edge_colour_okabeito

#' @export
#' @rdname scale_okabeito_discrete
scale_edge_fill_okabeito <- function(..., reverse = FALSE,
                                     black_position = c("first", "last"),
                                     aesthetics = "edge_fill") {
  oi_palette <- get_okabeito_scale(black_position)
  scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
}

#' Simulate Color-Blindness
#'
#' @param x A palette [`function`] that when called with a single
#'  integer argument (the number of levels) returns a vector of colors
#'  (see [color()]).
#' @param mode A [`character`] string giving the colorblind vision
#'  to be used. It must be one of "`deuteranopia`", "`protanopia`",
#'  "`tritanopia`" or "`achromatopsia`". Any unambiguous substring can be given.
#' @return
#'  A palette [`function`] that returns a vector of anomalized
#'  colors. All the attributes of the initial palette function are inherited,
#'  with a supplementary attribute "`mode`" giving the corresponding
#'  color-blind vision.
#' @example inst/examples/ex-change.R
#' @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), p. 2647-2655. \doi{10.1364/JOSAA.14.002647}.
#'
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#'
#'  Viénot, F., Brettel, H. and Mollon, J. D. (1999). Digital Video
#'  Colourmaps for Checking the Legibility of Displays by Dichromats.
#'  *Color Research & Application*, 24(4), p. 243-52.
#'  \doi{10.1002/(SICI)1520-6378(199908)24:4<243::AID-COL5>3.0.CO;2-3}.
#' @author N. Frerebeau
#' @family diagnostic tools
#' @export
change <- function(x, mode) {
  fun <- function(n) { anomalize(x(n), mode = mode) }
  attributes(fun) <- attributes(x)
  attr(fun, "mode") <- mode
  fun
}

#' Anomalize
#'
#' @param x A [`character`] vector of color codes.
#' @param mode A [`character`] string giving the colorblind vision
#'  to be used. It must be one of "`deuteranopia`", "`protanopia`",
#'  "`tritanopia`" or "`achromatopsia`". Any unambiguous substring can be given.
#' @return A [`character`] vector of color codes.
#' @author N. Frerebeau
#' @keywords internal
#' @noRd
anomalize <- function(x, mode = c("deuteranopia", "protanopia", "tritanopia",
                                  "achromatopsia")) {
  # Validation
  mode <- match.arg(mode, several.ok = FALSE)

  # Convert to RGB color code
  RGB1 <- t(grDevices::col2rgb(x, alpha = FALSE))

  # Dichromat
  S <- switch (
    mode,
    # Green-blindness
    deuteranopia = rbind(
      # Red, Green, Blue
      c(1, 0, 0),
      c(0.9513092, 0, 0.04866992),
      c(0, 0, 1)
    ),
    # Red-blindness
    protanopia = rbind(
      # Red, Green, Blue
      c(0, 1.05118294, -0.05116099),
      c(0, 1, 0),
      c(0, 0, 1)
    ),
    # Blue-blindness
    tritanopia = rbind(
      # Red, Green, Blue
      c(1, 0, 0),
      c(0, 1, 0),
      c(-0.86744736, 1.86727089, 0)
    ),
    # Achromatopsia
    achromatopsia = rbind(
      # Red, Green, Blue
      c(0, 0, 1),
      c(0, 0, 1),
      c(0, 0, 1)
    )
  )

  # Convert colors from the RGB color space to the LMS color space
  # RGB_to_LMS <- .XYZ_to_LMS %*% .sRGB_to_XYZ
  # RGB2 <- solve(RGB_to_LMS) %*% S %*% RGB_to_LMS %*% RGB1

  # Conversion
  LMS <- RGB2LMS(RGB1) %*% t(S)
  RGB2 <- LMS2RGB(LMS)

  # RGB constraints
  for (i in 1:nrow(RGB2)) {
    RGB2[i, ] <- pmin(RGB2[i, ], rep(255, 3))
    RGB2[i, ] <- pmax(RGB2[i, ], rep(0, 3))
  }

  # Convert to Hex color code
  grDevices::rgb(RGB2, names = names(x), maxColorValue = 255)
}

# Color Conversion

#' CMYK to/from RGB Color Conversion
#'
#' @param cyan,magenta,yellow,black,red,blue,green A [`numeric`] vector with
#'  values in \eqn{[0, max]}.
#' @param max A [`numeric`] value giving the maximum of the color values range.
#' @return An integer matrix with three or four columns.
#' @author N. Frerebeau
#' @keywords internal
#' @noRd
NULL

CMYK2RGB <- function(cyan, magenta, yellow, black, max = 1) {
  if (missing(magenta) && missing(yellow) && missing(black)) {
    if (is.matrix(cyan) || is.data.frame(cyan)) {
      if (ncol(cyan) < 4L) stop("At least 4 columns needed.", call. = FALSE)
      cyan <- data.matrix(cyan)
      CMY <- cyan[, -4]
      black <- cyan[, 4]
    }
  } else {
    CMY <- cbind(cyan, magenta, yellow)
  }
  CMY <- CMY / max
  K <- black / max

  RGB <- 255 * (1 - CMY) * (1 - K)
  colnames(RGB) <- c("R", "G", "B")
  return(RGB)
}

RGB2CMYB <- function(red, green, blue, max = 255) {
  if (missing(green) && missing(blue)) {
    if (is.matrix(red) || is.data.frame(red)) {
      if (ncol(red) < 3L) stop("At least 3 columns needed.", call. = FALSE)
      RGB <- data.matrix(red)
    }
  } else {
    RGB <- cbind(red, green, blue)
  }
  RGB <- RGB / max
  K <- 1 - apply(X = RGB, MARGIN = 1, FUN = max)
  CMY <- (1 - RGB - K) / (1 - K)
  CMYK <- cbind(CMY, K)
  CMYK[is.na(CMYK)] <- 0 # Fix zero division
  colnames(CMYK) <- c("C", "M", "Y", "K")
  return(CMYK)
}

#' RGB to/from XYZ Color Conversion
#'
#' @param red,blue,green A [`numeric`] vector with values in \eqn{[0, max]}.
#' @param x,y,z A [`numeric`] vector of color coordinates.
#' @param max A [`numeric`] value giving the maximum of the color values range.
#' @return A numeric matrix with three columns.
#' @author N. Frerebeau
#' @keywords internal
#' @noRd
NULL

gamma_expand <- function(RGB) {
  u <- RGB > 0.04045
  sRGB <- RGB / 12.92
  sRGB[u] <- ((200 * RGB[u] + 11) / 211)^(12 / 5)
  return(sRGB)
}
gamma_compress <- function(sRGB) {
  u <- sRGB > 0.0031308
  RGB <- sRGB * 12.92
  RGB[u] <- (211 * sRGB[u]^(5 / 12) - 11) / 200
  return(RGB)
}

XYZ2RGB <- function(x, y, z, max_rgb = 255) {
  if (missing(y) && missing(z)) {
    if (is.matrix(x) || is.data.frame(x)) {
      if (ncol(x) < 3L) stop("At least 3 columns needed.", call. = FALSE)
      XYZ <- data.matrix(x)
    }
  } else {
    XYZ <- cbind(x, y, z)
  }
  sRGB <- XYZ %*% t(.XYZ_to_sRGB)
  colnames(sRGB) <- c("R", "G", "B")

  # gamma-compressed values
  RGB <- gamma_compress(sRGB)

  return(RGB * max_rgb)
}

RGB2XYZ <- function(red, green, blue, max_rgb = 255) {
  if (missing(green) && missing(blue)) {
    if (is.matrix(red) || is.data.frame(red)) {
      if (ncol(red) < 3L) stop("At least 3 columns needed.", call. = FALSE)
      RGB <- data.matrix(red)
    }
  } else {
    RGB <- cbind(red, green, blue)
  }
  RGB <- RGB / max_rgb

  # gamma-expanded values
  sRGB <- gamma_expand(RGB)

  XYZ <- sRGB %*% t(.sRGB_to_XYZ)
  colnames(XYZ) <- c("X", "Y", "Z")
  return(XYZ)
}

#' RGB to/from LMS Lab Color Conversion
#'
#' @param red,blue,green A [`numeric`] vector with values in \eqn{[0, max]}.
#' @param max A [`numeric`] value giving the maximum of the color values range.
#' @return A numeric matrix with three rows.
#' @author N. Frerebeau
#' @keywords internal
#' @noRd
NULL

RGB2LMS <- function(red, green, blue, max = 255) {
  if (missing(green) && missing(blue)) {
    if (is.matrix(red) || is.data.frame(red)) {
      if (ncol(red) < 3L) stop("At least 3 columns needed.", call. = FALSE)
      RGB <- data.matrix(red)
    }
  } else {
    RGB <- cbind(red, green, blue)
  }
  RGB <- RGB / max

  # gamma-expanded values
  sRGB <- gamma_expand(RGB)

  LMS <- sRGB %*% t(.XYZ_to_LMS %*% .sRGB_to_XYZ)
  colnames(LMS) <- c("L", "M", "S")
  return(LMS)
}

LMS2RGB <- function(long, medium, short, max = 255) {
  if (missing(medium) && missing(short)) {
    if (is.matrix(long) || is.data.frame(long)) {
      if (ncol(long) < 3L) stop("At least 3 columns needed.", call. = FALSE)
      LMS <- data.matrix(long)
    }
  } else {
    LMS <- cbind(long, medium, short)
  }

  sRGB <- LMS %*% t(solve(.XYZ_to_LMS %*% .sRGB_to_XYZ))
  colnames(sRGB) <- c("R", "G", "B")

  # gamma-compressed values
  RGB <- gamma_compress(sRGB)

  return(RGB * max)
}

#' XYZ to CIE Lab Color Conversion
#'
#' @param x,y,z A [`numeric`] vector of color coordinates.
#' @param white A length-three [`numeric`] vector giving a reference white
#'  coordinates (default to D65).
#' @return A numeric matrix with three columns.
#' @author N. Frerebeau
#' @keywords internal
#' @noRd
NULL

XYZ2Lab <- function(x, y, z, white = c(x = 0.95047, y = 1.00000, z = 1.08883)) {
  if (missing(y) && missing(z)) {
    if (is.matrix(x) || is.data.frame(x)) {
      if (ncol(x) < 3L) stop("At least 3 columns needed.", call. = FALSE)
      XYZ <- data.matrix(x)
      x <- XYZ[, 1]
      y <- XYZ[, 2]
      z <- XYZ[, 3]
    }
  }

  # Actual CIE standards
  f <- function(a, e = 0.008856, k = 903.3) {
    a_e <- a <= e
    b <- a^(1/3)
    b[a_e] <- (k * a[a_e] + 16) / 116
    b
  }

  x <- x / white[[1L]]
  y <- y / white[[2L]]
  z <- z / white[[3L]]

  Lab <- cbind(
    L = 116 * f(y) - 16,
    a = 500 * (f(x) - f(y)),
    b = 200 * (f(y) - f(z))
  )
  return(Lab)
}

# Fabio Crameri's color schemes
#' @include color.R
NULL

# Diverging ====================================================================
## broc ------------------------------------------------------------------------
#' Fabio Crameri's *broc* Diverging Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::continuous_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param range A length-two [`numeric`] vector specifying the
#' fraction of the scheme's color domain to keep.
#' @param midpoint A length-one [`numeric`] vector giving the midpoint
#'  (in data value) of the diverging scale. Defaults to `0`.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @param discrete A [`logical`] scalar: should the color scheme be
#'  used as a discrete scale?
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_broc
#' @rdname scale_crameri_broc
NULL

#' @export
#' @rdname scale_crameri_broc
scale_colour_broc <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "broc", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "broc", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_broc
scale_color_broc <- scale_colour_broc

#' @export
#' @rdname scale_crameri_broc
scale_fill_broc <- function(..., reverse = FALSE, range = c(0, 1),
                            midpoint = 0, discrete = FALSE,
                            aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "broc", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "broc", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_broc
scale_edge_colour_broc <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "broc", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "broc", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_broc
scale_edge_color_broc <- scale_edge_colour_broc

#' @export
#' @rdname scale_crameri_broc
scale_edge_fill_broc <- function(..., reverse = FALSE, range = c(0, 1),
                                 midpoint = 0, discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "broc", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "broc", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## cork ------------------------------------------------------------------------
#' Fabio Crameri's *cork* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_cork
#' @rdname scale_crameri_cork
NULL

#' @export
#' @rdname scale_crameri_cork
scale_colour_cork <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "cork", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "cork", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_cork
scale_color_cork <- scale_colour_cork

#' @export
#' @rdname scale_crameri_cork
scale_fill_cork <- function(..., reverse = FALSE, range = c(0, 1),
                            midpoint = 0, discrete = FALSE,
                            aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "cork", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "cork", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_cork
scale_edge_colour_cork <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "cork", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "cork", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_cork
scale_edge_color_cork <- scale_edge_colour_cork

#' @export
#' @rdname scale_crameri_cork
scale_edge_fill_cork <- function(..., reverse = FALSE, range = c(0, 1),
                                 midpoint = 0, discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "cork", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "cork", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## vik -------------------------------------------------------------------------
#' Fabio Crameri's *vik* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_vik
#' @rdname scale_crameri_vik
NULL

#' @export
#' @rdname scale_crameri_vik
scale_colour_vik <- function(..., reverse = FALSE, range = c(0, 1),
                             midpoint = 0, discrete = FALSE,
                             aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "vik", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vik", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_vik
scale_color_vik <- scale_colour_vik

#' @export
#' @rdname scale_crameri_vik
scale_fill_vik <- function(..., reverse = FALSE, range = c(0, 1),
                           midpoint = 0, discrete = FALSE,
                           aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "vik", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vik", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_vik
scale_edge_colour_vik <- function(..., reverse = FALSE, range = c(0, 1),
                                  midpoint = 0, discrete = FALSE,
                                  aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "vik", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vik", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_vik
scale_edge_color_vik <- scale_edge_colour_vik

#' @export
#' @rdname scale_crameri_vik
scale_edge_fill_vik <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "vik", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vik", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## lisbon ----------------------------------------------------------------------
#' Fabio Crameri's *lisbon* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_lisbon
#' @rdname scale_crameri_lisbon
NULL

#' @export
#' @rdname scale_crameri_lisbon
scale_colour_lisbon <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "lisbon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lisbon", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_lisbon
scale_color_lisbon <- scale_colour_lisbon

#' @export
#' @rdname scale_crameri_lisbon
scale_fill_lisbon <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "lisbon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lisbon", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_lisbon
scale_edge_colour_lisbon <- function(..., reverse = FALSE, range = c(0, 1),
                                     midpoint = 0, discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "lisbon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lisbon", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_lisbon
scale_edge_color_lisbon <- scale_edge_colour_lisbon

#' @export
#' @rdname scale_crameri_lisbon
scale_edge_fill_lisbon <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "lisbon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lisbon", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## tofino ----------------------------------------------------------------------
#' Fabio Crameri's *tofino* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_tofino
#' @rdname scale_crameri_tofino
NULL

#' @export
#' @rdname scale_crameri_tofino
scale_colour_tofino <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "tofino", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tofino", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_tofino
scale_color_tofino <- scale_colour_tofino

#' @export
#' @rdname scale_crameri_tofino
scale_fill_tofino <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "tofino", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tofino", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_tofino
scale_edge_colour_tofino <- function(..., reverse = FALSE, range = c(0, 1),
                                     midpoint = 0, discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "tofino", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tofino", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_tofino
scale_edge_color_tofino <- scale_edge_colour_tofino

#' @export
#' @rdname scale_crameri_tofino
scale_edge_fill_tofino <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "tofino", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tofino", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## berlin ----------------------------------------------------------------------
#' Fabio Crameri's *berlin* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_berlin
#' @rdname scale_crameri_berlin
NULL

#' @export
#' @rdname scale_crameri_berlin
scale_colour_berlin <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "berlin", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "berlin", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_berlin
scale_color_berlin <- scale_colour_berlin

#' @export
#' @rdname scale_crameri_berlin
scale_fill_berlin <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "berlin", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "berlin", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_berlin
scale_edge_colour_berlin <- function(..., reverse = FALSE, range = c(0, 1),
                                     midpoint = 0, discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "berlin", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "berlin", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_berlin
scale_edge_color_berlin <- scale_edge_colour_berlin

#' @export
#' @rdname scale_crameri_berlin
scale_edge_fill_berlin <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "berlin", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "berlin", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## roma ------------------------------------------------------------------------
#' Fabio Crameri's *roma* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_roma
#' @rdname scale_crameri_roma
NULL

#' @export
#' @rdname scale_crameri_roma
scale_colour_roma <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "roma", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "roma", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_roma
scale_color_roma <- scale_colour_roma

#' @export
#' @rdname scale_crameri_roma
scale_fill_roma <- function(..., reverse = FALSE, range = c(0, 1),
                            midpoint = 0, discrete = FALSE,
                            aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "roma", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "roma", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_roma
scale_edge_colour_roma <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "roma", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "roma", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_roma
scale_edge_color_roma <- scale_edge_colour_roma

#' @export
#' @rdname scale_crameri_roma
scale_edge_fill_roma <- function(..., reverse = FALSE, range = c(0, 1),
                                 midpoint = 0, discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "roma", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "roma", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## bam -------------------------------------------------------------------------
#' Fabio Crameri's *bam* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_bam
#' @rdname scale_crameri_bam
NULL

#' @export
#' @rdname scale_crameri_bam
scale_colour_bam <- function(..., reverse = FALSE, range = c(0, 1),
                             midpoint = 0, discrete = FALSE,
                             aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bam", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bam", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_bam
scale_color_bam <- scale_colour_bam

#' @export
#' @rdname scale_crameri_bam
scale_fill_bam <- function(..., reverse = FALSE, range = c(0, 1),
                           midpoint = 0, discrete = FALSE,
                           aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bam", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bam", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_bam
scale_edge_colour_bam <- function(..., reverse = FALSE, range = c(0, 1),
                                  midpoint = 0, discrete = FALSE,
                                  aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bam", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bam", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_bam
scale_edge_color_bam <- scale_edge_colour_bam

#' @export
#' @rdname scale_crameri_bam
scale_edge_fill_bam <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bam", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bam", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## vanimo ----------------------------------------------------------------------
#' Fabio Crameri's *vanimo* Diverging Color Scheme
#'
#' @inheritParams scale_crameri_broc
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_vanimo
#' @rdname scale_crameri_vanimo
NULL

#' @export
#' @rdname scale_crameri_vanimo
scale_colour_vanimo <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "vanimo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vanimo", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_vanimo
scale_color_vanimo <- scale_colour_vanimo

#' @export
#' @rdname scale_crameri_vanimo
scale_fill_vanimo <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "vanimo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vanimo", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_vanimo
scale_edge_colour_vanimo <- function(..., reverse = FALSE, range = c(0, 1),
                                     midpoint = 0, discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "vanimo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vanimo", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_crameri_vanimo
scale_edge_color_vanimo <- scale_edge_colour_vanimo

#' @export
#' @rdname scale_crameri_vanimo
scale_edge_fill_vanimo <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "vanimo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vanimo", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

# Sequential ===================================================================
## batlow ----------------------------------------------------------------------
#' Fabio Crameri's *batlow* Sequential Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::continuous_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param range A length-two [`numeric`] vector specifying the
#' fraction of the scheme's color domain to keep.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @param discrete A [`logical`] scalar: should the color scheme be
#'  used as a discrete scale?
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_batlow
#' @rdname scale_crameri_batlow
NULL

#' @export
#' @rdname scale_crameri_batlow
scale_colour_batlow <- function(..., reverse = FALSE, range = c(0, 1),
                                discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "batlow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlow", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlow
scale_color_batlow <- scale_colour_batlow

#' @export
#' @rdname scale_crameri_batlow
scale_fill_batlow <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "batlow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlow", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlow
scale_edge_colour_batlow <- function(..., reverse = FALSE, range = c(0, 1),
                                     discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "batlow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlow", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlow
scale_edge_color_batlow <- scale_edge_colour_batlow

#' @export
#' @rdname scale_crameri_batlow
scale_edge_fill_batlow <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "batlow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlow", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## batlowW ---------------------------------------------------------------------
#' Fabio Crameri's *batlowW* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_batlowW
#' @rdname scale_crameri_batlowW
NULL

#' @export
#' @rdname scale_crameri_batlowW
scale_colour_batlowW <- function(..., reverse = FALSE, range = c(0, 1),
                                 discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowW", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowW", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlowW
scale_color_batlowW <- scale_colour_batlowW

#' @export
#' @rdname scale_crameri_batlowW
scale_fill_batlowW <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowW", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowW", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlowW
scale_edge_colour_batlowW <- function(..., reverse = FALSE, range = c(0, 1),
                                      discrete = FALSE,
                                      aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowW", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowW", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlowW
scale_edge_color_batlowW <- scale_edge_colour_batlowW

#' @export
#' @rdname scale_crameri_batlowW
scale_edge_fill_batlowW <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowW", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowW", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## batlowK ---------------------------------------------------------------------
#' Fabio Crameri's *batlowK* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_batlowK
#' @rdname scale_crameri_batlowK
NULL

#' @export
#' @rdname scale_crameri_batlowK
scale_colour_batlowK <- function(..., reverse = FALSE, range = c(0, 1),
                                 discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowK", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowK", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlowK
scale_color_batlowK <- scale_colour_batlowK

#' @export
#' @rdname scale_crameri_batlowK
scale_fill_batlowK <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowK", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowK", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlowK
scale_edge_colour_batlowK <- function(..., reverse = FALSE, range = c(0, 1),
                                      discrete = FALSE,
                                      aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowK", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowK", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_batlowK
scale_edge_color_batlowK <- scale_edge_colour_batlowK

#' @export
#' @rdname scale_crameri_batlowK
scale_edge_fill_batlowK <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "batlowK", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "batlowK", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## devon -----------------------------------------------------------------------
#' Fabio Crameri's *devon* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_devon
#' @rdname scale_crameri_devon
NULL

#' @export
#' @rdname scale_crameri_devon
scale_colour_devon <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "devon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "devon", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_devon
scale_color_devon <- scale_colour_devon

#' @export
#' @rdname scale_crameri_devon
scale_fill_devon <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "devon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "devon", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_devon
scale_edge_colour_devon <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "devon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "devon", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_devon
scale_edge_color_devon <- scale_edge_colour_devon

#' @export
#' @rdname scale_crameri_devon
scale_edge_fill_devon <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "devon", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "devon", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## lajolla ---------------------------------------------------------------------
#' Fabio Crameri's *lajolla* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_lajolla
#' @rdname scale_crameri_lajolla
NULL

#' @export
#' @rdname scale_crameri_lajolla
scale_colour_lajolla <- function(..., reverse = FALSE, range = c(0, 1),
                                 discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "lajolla", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lajolla", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_lajolla
scale_color_lajolla <- scale_colour_lajolla

#' @export
#' @rdname scale_crameri_lajolla
scale_fill_lajolla <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "lajolla", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lajolla", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_lajolla
scale_edge_colour_lajolla <- function(..., reverse = FALSE, range = c(0, 1),
                                      discrete = FALSE,
                                      aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "lajolla", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lajolla", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_lajolla
scale_edge_color_lajolla <- scale_edge_colour_lajolla

#' @export
#' @rdname scale_crameri_lajolla
scale_edge_fill_lajolla <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "lajolla", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lajolla", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## bamako ----------------------------------------------------------------------
#' Fabio Crameri's *bamako* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_bamako
#' @rdname scale_crameri_bamako
NULL

#' @export
#' @rdname scale_crameri_bamako
scale_colour_bamako <- function(..., reverse = FALSE, range = c(0, 1),
                                discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bamako", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bamako", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bamako
scale_color_bamako <- scale_colour_bamako

#' @export
#' @rdname scale_crameri_bamako
scale_fill_bamako <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bamako", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bamako", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bamako
scale_edge_colour_bamako <- function(..., reverse = FALSE, range = c(0, 1),
                                     discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bamako", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bamako", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bamako
scale_edge_color_bamako <- scale_edge_colour_bamako

#' @export
#' @rdname scale_crameri_bamako
scale_edge_fill_bamako <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bamako", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bamako", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## davos -----------------------------------------------------------------------
#' Fabio Crameri's *davos* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_davos
#' @rdname scale_crameri_davos
NULL

#' @export
#' @rdname scale_crameri_davos
scale_colour_davos <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "davos", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "davos", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_davos
scale_color_davos <- scale_colour_davos

#' @export
#' @rdname scale_crameri_davos
scale_fill_davos <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "davos", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "davos", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_davos
scale_edge_colour_davos <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "davos", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "davos", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_davos
scale_edge_color_davos <- scale_edge_colour_davos

#' @export
#' @rdname scale_crameri_davos
scale_edge_fill_davos <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "davos", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "davos", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## bilbao ----------------------------------------------------------------------
#' Fabio Crameri's *bilbao* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_bilbao
#' @rdname scale_crameri_bilbao
NULL

#' @export
#' @rdname scale_crameri_bilbao
scale_colour_bilbao <- function(..., reverse = FALSE, range = c(0, 1),
                                discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bilbao", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bilbao", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bilbao
scale_color_bilbao <- scale_colour_bilbao

#' @export
#' @rdname scale_crameri_bilbao
scale_fill_bilbao <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bilbao", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bilbao", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bilbao
scale_edge_colour_bilbao <- function(..., reverse = FALSE, range = c(0, 1),
                                     discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bilbao", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bilbao", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bilbao
scale_edge_color_bilbao <- scale_edge_colour_bilbao

#' @export
#' @rdname scale_crameri_bilbao
scale_edge_fill_bilbao <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bilbao", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bilbao", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## nuuk ------------------------------------------------------------------------
#' Fabio Crameri's *nuuk* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_nuuk
#' @rdname scale_crameri_nuuk
NULL

#' @export
#' @rdname scale_crameri_nuuk
scale_colour_nuuk <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "nuuk", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nuuk", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_nuuk
scale_color_nuuk <- scale_colour_nuuk

#' @export
#' @rdname scale_crameri_nuuk
scale_fill_nuuk <- function(..., reverse = FALSE, range = c(0, 1),
                            discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "nuuk", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nuuk", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_nuuk
scale_edge_colour_nuuk <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "nuuk", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nuuk", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_nuuk
scale_edge_color_nuuk <- scale_edge_colour_nuuk

#' @export
#' @rdname scale_crameri_nuuk
scale_edge_fill_nuuk <- function(..., reverse = FALSE, range = c(0, 1),
                                 discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "nuuk", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nuuk", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## oslo ------------------------------------------------------------------------
#' Fabio Crameri's *oslo* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_oslo
#' @rdname scale_crameri_oslo
NULL

#' @export
#' @rdname scale_crameri_oslo
scale_colour_oslo <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "oslo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "oslo", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_oslo
scale_color_oslo <- scale_colour_oslo

#' @export
#' @rdname scale_crameri_oslo
scale_fill_oslo <- function(..., reverse = FALSE, range = c(0, 1),
                            discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "oslo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "oslo", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_oslo
scale_edge_colour_oslo <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "oslo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "oslo", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_oslo
scale_edge_color_oslo <- scale_edge_colour_oslo

#' @export
#' @rdname scale_crameri_oslo
scale_edge_fill_oslo <- function(..., reverse = FALSE, range = c(0, 1),
                                 discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "oslo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "oslo", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## grayC -----------------------------------------------------------------------
#' Fabio Crameri's *grayC* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_grayC
#' @rdname scale_crameri_grayC
NULL

#' @export
#' @rdname scale_crameri_grayC
scale_colour_grayC <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "grayC", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "grayC", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_grayC
scale_color_grayC <- scale_colour_grayC

#' @export
#' @rdname scale_crameri_grayC
scale_fill_grayC <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "grayC", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "grayC", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_grayC
scale_edge_colour_grayC <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "grayC", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "grayC", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_grayC
scale_edge_color_grayC <- scale_edge_colour_grayC

#' @export
#' @rdname scale_crameri_grayC
scale_edge_fill_grayC <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "grayC", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "grayC", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## hawaii ----------------------------------------------------------------------
#' Fabio Crameri's *hawaii* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_hawaii
#' @rdname scale_crameri_hawaii
NULL

#' @export
#' @rdname scale_crameri_hawaii
scale_colour_hawaii <- function(..., reverse = FALSE, range = c(0, 1),
                                discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "hawaii", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "hawaii", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_hawaii
scale_color_hawaii <- scale_colour_hawaii

#' @export
#' @rdname scale_crameri_hawaii
scale_fill_hawaii <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "hawaii", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "hawaii", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_hawaii
scale_edge_colour_hawaii <- function(..., reverse = FALSE, range = c(0, 1),
                                     discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "hawaii", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "hawaii", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_hawaii
scale_edge_color_hawaii <- scale_edge_colour_hawaii

#' @export
#' @rdname scale_crameri_hawaii
scale_edge_fill_hawaii <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "hawaii", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "hawaii", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## lapaz -----------------------------------------------------------------------
#' Fabio Crameri's *lapaz* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_lapaz
#' @rdname scale_crameri_lapaz
NULL

#' @export
#' @rdname scale_crameri_lapaz
scale_colour_lapaz <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "lapaz", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lapaz", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_lapaz
scale_color_lapaz <- scale_colour_lapaz

#' @export
#' @rdname scale_crameri_lapaz
scale_fill_lapaz <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "lapaz", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lapaz", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_lapaz
scale_edge_colour_lapaz <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "lapaz", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lapaz", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_lapaz
scale_edge_color_lapaz <- scale_edge_colour_lapaz

#' @export
#' @rdname scale_crameri_lapaz
scale_edge_fill_lapaz <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "lapaz", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "lapaz", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## tokyo -----------------------------------------------------------------------
#' Fabio Crameri's *tokyo* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_tokyo
#' @rdname scale_crameri_tokyo
NULL

#' @export
#' @rdname scale_crameri_tokyo
scale_colour_tokyo <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "tokyo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tokyo", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_tokyo
scale_color_tokyo <- scale_colour_tokyo

#' @export
#' @rdname scale_crameri_tokyo
scale_fill_tokyo <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "tokyo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tokyo", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_tokyo
scale_edge_colour_tokyo <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "tokyo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tokyo", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_tokyo
scale_edge_color_tokyo <- scale_edge_colour_tokyo

#' @export
#' @rdname scale_crameri_tokyo
scale_edge_fill_tokyo <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "tokyo", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "tokyo", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## buda ------------------------------------------------------------------------
#' Fabio Crameri's *buda* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_buda
#' @rdname scale_crameri_buda
NULL

#' @export
#' @rdname scale_crameri_buda
scale_colour_buda <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "buda", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "buda", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_buda
scale_color_buda <- scale_colour_buda

#' @export
#' @rdname scale_crameri_buda
scale_fill_buda <- function(..., reverse = FALSE, range = c(0, 1),
                            discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "buda", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "buda", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_buda
scale_edge_colour_buda <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "buda", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "buda", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_buda
scale_edge_color_buda <- scale_edge_colour_buda

#' @export
#' @rdname scale_crameri_buda
scale_edge_fill_buda <- function(..., reverse = FALSE, range = c(0, 1),
                                 discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "buda", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "buda", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## acton -----------------------------------------------------------------------
#' Fabio Crameri's *acton* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_acton
#' @rdname scale_crameri_acton
NULL

#' @export
#' @rdname scale_crameri_acton
scale_colour_acton <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "acton", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "acton", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_acton
scale_color_acton <- scale_colour_acton

#' @export
#' @rdname scale_crameri_acton
scale_fill_acton <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "acton", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "acton", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_acton
scale_edge_colour_acton <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "acton", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "acton", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_acton
scale_edge_color_acton <- scale_edge_colour_acton

#' @export
#' @rdname scale_crameri_acton
scale_edge_fill_acton <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "acton", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "acton", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## turku -----------------------------------------------------------------------
#' Fabio Crameri's *turku* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_turku
#' @rdname scale_crameri_turku
NULL

#' @export
#' @rdname scale_crameri_turku
scale_colour_turku <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "turku", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "turku", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_turku
scale_color_turku <- scale_colour_turku

#' @export
#' @rdname scale_crameri_turku
scale_fill_turku <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "turku", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "turku", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_turku
scale_edge_colour_turku <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "turku", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "turku", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_turku
scale_edge_color_turku <- scale_edge_colour_turku

#' @export
#' @rdname scale_crameri_turku
scale_edge_fill_turku <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "turku", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "turku", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## imola -----------------------------------------------------------------------
#' Fabio Crameri's *imola* Sequential Color Scheme
#'
#' @inheritParams scale_crameri_batlow
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_imola
#' @rdname scale_crameri_imola
NULL

#' @export
#' @rdname scale_crameri_imola
scale_colour_imola <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "imola", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "imola", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_imola
scale_color_imola <- scale_colour_imola

#' @export
#' @rdname scale_crameri_imola
scale_fill_imola <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "imola", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "imola", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_imola
scale_edge_colour_imola <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE,
                                    aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "imola", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "imola", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_imola
scale_edge_color_imola <- scale_edge_colour_imola

#' @export
#' @rdname scale_crameri_imola
scale_edge_fill_imola <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE,
                                  aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "imola", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "imola", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

# Multi Sequential =============================================================
## oleron ----------------------------------------------------------------------
#' Fabio Crameri's *oleron* Multi-Sequential Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::continuous_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param range A length-two [`numeric`] vector specifying the
#' fraction of the scheme's color domain to keep.
#' @param midpoint A length-one [`numeric`] vector giving the midpoint
#'  (in data value) of the diverging scale. Defaults to `0`.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-multisequential.R
#' @author N. Frerebeau
#' @family multi sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_oleron
#' @rdname scale_crameri_oleron
NULL

#' @export
#' @rdname scale_crameri_oleron
scale_colour_oleron <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, aesthetics = "colour") {
  scale_continuous(aesthetics, "oleron", reverse = reverse, range = range,
                   midpoint = midpoint, ...)
}

#' @export
#' @rdname scale_crameri_oleron
scale_color_oleron <- scale_colour_oleron

#' @export
#' @rdname scale_crameri_oleron
scale_fill_oleron <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, aesthetics = "fill") {
  scale_continuous(aesthetics, "oleron", reverse = reverse, range = range,
                   midpoint = midpoint, ...)
}

## bukavu ----------------------------------------------------------------------
#' Fabio Crameri's *bukavu* Multi-Sequential Color Scheme
#'
#' @inheritParams scale_crameri_oleron
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-multisequential.R
#' @author N. Frerebeau
#' @family multi sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_bukavu
#' @rdname scale_crameri_bukavu
NULL

#' @export
#' @rdname scale_crameri_bukavu
scale_colour_bukavu <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, aesthetics = "colour") {
  scale_continuous(aesthetics, "bukavu", reverse = reverse, range = range,
                   midpoint = midpoint, ...)
}

#' @export
#' @rdname scale_crameri_bukavu
scale_color_bukavu <- scale_colour_bukavu

#' @export
#' @rdname scale_crameri_bukavu
scale_fill_bukavu <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, aesthetics = "fill") {
  scale_continuous(aesthetics, "bukavu", reverse = reverse, range = range,
                   midpoint = midpoint, ...)
}

## fes -------------------------------------------------------------------------
#' Fabio Crameri's *fes* Multi-Sequential Color Scheme
#'
#' @inheritParams scale_crameri_oleron
#' @inheritSection crameri Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-multisequential.R
#' @author N. Frerebeau
#' @family multi sequential color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_fes
#' @rdname scale_crameri_fes
NULL

#' @export
#' @rdname scale_crameri_fes
scale_colour_fes <- function(..., reverse = FALSE, range = c(0, 1),
                             midpoint = 0, aesthetics = "colour") {
  scale_continuous(aesthetics, "fes", reverse = reverse, range = range,
                   midpoint = midpoint, ...)
}

#' @export
#' @rdname scale_crameri_fes
scale_color_fes <- scale_colour_fes

#' @export
#' @rdname scale_crameri_fes
scale_fill_fes <- function(..., reverse = FALSE, range = c(0, 1),
                           midpoint = 0, aesthetics = "fill") {
  scale_continuous(aesthetics, "fes", reverse = reverse, range = range,
                   midpoint = midpoint, ...)
}

# Cyclic =======================================================================
## brocO -----------------------------------------------------------------------
#' Fabio Crameri's *brocO* Cyclic Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::continuous_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param range A length-two [`numeric`] vector specifying the
#' fraction of the scheme's color domain to keep.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @param discrete A [`logical`] scalar: should the color scheme be
#'  used as a discrete scale?
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family cyclic color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_brocO
#' @rdname scale_crameri_brocO
NULL

#' @export
#' @rdname scale_crameri_brocO
scale_colour_brocO <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "brocO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "brocO", reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_brocO
scale_color_brocO <- scale_colour_brocO

#' @export
#' @rdname scale_crameri_brocO
scale_fill_brocO <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "brocO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "brocO", reverse = reverse, range = range, ...)
  }
}

## corkO -----------------------------------------------------------------------
#' Fabio Crameri's *corkO* Cyclic Color Scheme
#'
#' @inheritParams scale_crameri_brocO
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family cyclic color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_corkO
#' @rdname scale_crameri_corkO
NULL

#' @export
#' @rdname scale_crameri_corkO
scale_colour_corkO <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "corkO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "corkO", reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_corkO
scale_color_corkO <- scale_colour_corkO

#' @export
#' @rdname scale_crameri_corkO
scale_fill_corkO <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "corkO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "corkO", reverse = reverse, range = range, ...)
  }
}

## vikO ------------------------------------------------------------------------
#' Fabio Crameri's *vikO* Cyclic Color Scheme
#'
#' @inheritParams scale_crameri_brocO
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family cyclic color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_vikO
#' @rdname scale_crameri_vikO
NULL

#' @export
#' @rdname scale_crameri_vikO
scale_colour_vikO <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "vikO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vikO", reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_vikO
scale_color_vikO <- scale_colour_vikO

#' @export
#' @rdname scale_crameri_vikO
scale_fill_vikO <- function(..., reverse = FALSE, range = c(0, 1),
                            discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "vikO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "vikO", reverse = reverse, range = range, ...)
  }
}

## romaO -----------------------------------------------------------------------
#' Fabio Crameri's *romaO* Cyclic Color Scheme
#'
#' @inheritParams scale_crameri_brocO
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family cyclic color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_romaO
#' @rdname scale_crameri_romaO
NULL

#' @export
#' @rdname scale_crameri_romaO
scale_colour_romaO <- function(..., reverse = FALSE, range = c(0, 1),
                               discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "romaO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "romaO", reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_romaO
scale_color_romaO <- scale_colour_romaO

#' @export
#' @rdname scale_crameri_romaO
scale_fill_romaO <- function(..., reverse = FALSE, range = c(0, 1),
                             discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "romaO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "romaO", reverse = reverse, range = range, ...)
  }
}

## bamO ------------------------------------------------------------------------
#' Fabio Crameri's *bamO* Cyclic Color Scheme
#'
#' @inheritParams scale_crameri_brocO
#' @inheritSection crameri Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @example inst/examples/ex-crameri-diverging.R
#' @author N. Frerebeau
#' @family cyclic color schemes
#' @family Fabio Crameri's color schemes
#' @name scale_crameri_bamO
#' @rdname scale_crameri_bamO
NULL

#' @export
#' @rdname scale_crameri_bamO
scale_colour_bamO <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "bamO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bamO", reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_crameri_bamO
scale_color_bamO <- scale_colour_bamO

#' @export
#' @rdname scale_crameri_bamO
scale_fill_bamO <- function(..., reverse = FALSE, range = c(0, 1),
                            discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "bamO", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "bamO", reverse = reverse, range = range, ...)
  }
}

# PALETTES

# Palettes =====================================================================
## Color -----------------------------------------------------------------------
#' Color Mapping
#'
#' Maps values to colors.
#' @param scheme A [`character`] string giving the name of the scheme to be
#'  used (see [color()]).
#' @param domain A [`numeric`] range or a vector of categorical data specifying
#'  the possible values that can be mapped.
#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
#'  input range.
#' @param ordered A [`logical`] scalar: should the levels be treated as already
#'  in the correct order?
#' @param missing The color to return for `NA` values.
#' @param ... Further parameters to be passed to [color()].
#' @details
#'  A wrapper around `palette_color_continuous()` and
#'  `palette_color_discrete()`.
#' @return
#'  A palette [`function`] that when called with a single argument returns
#'  a [`character`] vector of colors.
#' @example inst/examples/ex-palette-color.R
#' @family palettes
#' @export
palette_color_picker <- function(scheme, domain = NULL, midpoint = NULL,
                                 ordered = FALSE, missing = NULL, ...) {

  scheme <- color(scheme, ...)
  col <- scheme()
  miss <- missing %||% attr(scheme, "missing")
  if (is.na(miss)) miss <- "#DDDDDD"

  quali <- attr(scheme, "type") == "qualitative"
  if (quali) {
    fun <- palette_color_discrete(
      colors = col,
      domain = domain,
      ordered = ordered,
      missing = miss
    )
  } else {
    fun <- palette_color_continuous(
      colors = col,
      domain = domain,
      midpoint = midpoint,
      missing = miss
    )
  }

  fun
}

#' @export
#' @rdname palette_color_picker
palette_colour_picker <- palette_color_picker

#' Color Mapping (continuous)
#'
#' Maps continuous values to an interpolated colors gradient.
#' @param colors A vector of colors or a [`function`] that when called with a
#'  single argument (an integer specifying the number of colors) returns a
#'  vector of colors. If `NULL` (the default), uses *YlOrRd*.
#' @param domain A [`numeric`] range specifying the possible values that can be
#'  mapped.
#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
#'  input range.
#' @param missing The color to return for `NA` values.
#' @return
#'  A palette [`function`] that when called with a single argument
#'  (a [`numeric`] vector of continuous values) returns a [`character`] vector
#'  of colors.
#' @seealso [grDevices::colorRamp()]
#' @example inst/examples/ex-palette-continuous.R
#' @family palettes
#' @export
palette_color_continuous <- function(colors = NULL, domain = NULL,
                                     midpoint = NULL, missing = "#DDDDDD") {

  force(colors)
  force(domain)
  force(midpoint)
  force(missing)

  function(x, ...) {
    need_continuous(x)

    rng <- if (!is.null(domain)) range(domain, finite = TRUE) else range(x, finite = TRUE)
    if (!is.null(midpoint) && is.numeric(midpoint)) {
      x <- scale_midpoint(x, to = c(0, 1), from = rng, midpoint = midpoint)
    } else {
      x <- scale_range(x, to = c(0, 1), from = rng)
    }

    out <- x < 0 | x > 1
    if (any(out, na.rm = TRUE)) {
      x[out] <- NA
      warning(tr_("Some values were outside the color scale."), call. = FALSE)
    }

    OK <- !is.na(x)
    if (is.null(colors)) {
      colors <- color(palette = "YlOrBr")(9)
    }
    if (is.function(colors)) {
      colors <- colors(9)
    }
    colors <- grDevices::colorRamp(colors)(x[OK], ...)

    col <- rep(missing, length(x))
    col[OK] <- grDevices::rgb(colors, maxColorValue = 255)
    col
  }
}

#' @export
#' @rdname palette_color_continuous
palette_colour_continuous <- palette_color_continuous

#' Color Mapping (discrete)
#'
#' Maps categorical values to colors.
#' @param colors A vector of colors or a [`function`] that when called with a
#'  single argument (an integer specifying the number of colors) returns a
#'  vector of colors. If `NULL` (the default), uses *discrete rainbow*.
#' @param domain A vector of categorical data specifying the possible values
#'  that can be mapped.
#' @param ordered A [`logical`] scalar: should the levels be treated as already
#'  in the correct order?
#' @param missing The color to return for `NA` values.
#' @return
#'  A palette [`function`] that when called with a single argument
#'  (a vector of categorical values) returns a [`character`] vector of colors.
#' @example inst/examples/ex-palette-discrete.R
#' @family palettes
#' @export
palette_color_discrete <- function(colors = NULL, domain = NULL,
                                   ordered = FALSE, missing = "#DDDDDD") {

  force(colors)
  force(domain)
  force(ordered)
  force(missing)

  ## If named colors, override user settings
  if (!is.null(names(colors))) {
    domain <- names(colors)
    ordered <- TRUE
  }

  function(x, ...) {
    need_discrete(x)

    domain <- make_levels(x, levels = domain, ordered = ordered)
    n <- length(domain)
    x <- match(as.character(x), domain)

    OK <- !is.na(x)
    if (is.null(colors)) {
      colors <- color(palette = "discreterainbow")(n)
    }
    if (is.function(colors)) {
      colors <- colors(n)
    }

    if (length(colors) < n) {
      msg <- tr_("Only %d colors were specified (%d are required).")
      warning(sprintf(msg, length(colors), n), call. = FALSE)
    }
    col <- colors[x]
    col[!OK] <- missing
    col
  }
}

#' @export
#' @rdname palette_color_discrete
palette_colour_discrete <- palette_color_discrete

## Symbol ----------------------------------------------------------------------
#' Symbol Mapping
#'
#' @param symbols,types A vector of symbols or line types.
#' @param domain A vector of categorical data specifying the possible values
#'  that can be mapped.
#' @param ordered A [`logical`] scalar: should the levels be treated as already
#'  in the correct order?
#' @param ... Currently not used.
#' @return
#'  A palette [`function`] that when called with a single argument
#'  (a [`character`] vector of categorical values) returns a vector of symbols.
#' @example inst/examples/ex-palette-discrete.R
#' @family palettes
#' @export
palette_shape <- function(symbols = NULL, domain = NULL, ordered = FALSE, ...) {

  force(symbols)
  force(domain)
  force(ordered)

  ## If named symbol, override user settings
  if (!is.null(names(symbols))) {
    domain <- names(symbols)
    ordered <- TRUE
  }

  function(x) {
    need_discrete(x)

    domain <- make_levels(x, levels = domain, ordered = ordered)
    x <- match(as.character(x), domain)

    if (is.null(symbols)) {
      n <- length(domain)
      if (n > 6) {
        warning(tr_("Consider specifying symbols manually: "),
                tr_("more than 6 becomes difficult to discriminate."),
                call. = FALSE)
      }
      symbols <- c(16, 17, 15, 3, 7, 8)[seq_len(n)]
    }
    symbols[x]
  }
}

#' @export
#' @rdname palette_shape
palette_line <- function(types = NULL, domain = NULL, ordered = FALSE, ...) {
  if (is.null(types)) {
    types <- c("solid", "22", "42", "44", "13", "1343", "73", "2262",
               "12223242", "F282", "F4448444", "224282F2", "F1")
  }
  palette_shape(symbols = types, domain = domain, ordered = ordered, ...)
}

## Size ------------------------------------------------------------------------
#' Symbol Size Mapping
#'
#' @param range A length-two [`numeric`] vector giving range of possible sizes
#'  (greater than 0).
#' @param midpoint A length-one [`numeric`] vector specifying the data mid-point.
#' @param ... Currently not used.
#' @return
#'  A palette [`function`] that when called with a single argument
#'  (a [`numeric`] vector of continuous values) returns a [`numeric`] vector
#'  giving the amount by which plotting text and symbols should be magnified
#'  relative to the default.
#' @example inst/examples/ex-palette-continuous.R
#' @family palettes
#' @name palette_size
#' @rdname palette_size
NULL

#' @export
#' @rdname palette_size
palette_size_sequential <- function(range = c(1, 6), ...) {

  force(range)

  function(x) {
    need_continuous(x)
    x <- scale_range(x)
    scale_range(sqrt(x), to = range(range, na.rm = TRUE))
  }
}

#' @export
#' @rdname palette_size
palette_size_diverging <- function(range = c(1, 6), midpoint = 0, ...) {

  force(range)
  force(midpoint)

  function(x) {
    need_continuous(x)
    x <- scale_midpoint(abs(x), midpoint = midpoint)
    scale_range(sqrt(x), to = range(range, na.rm = TRUE))
  }
}

# Scales =======================================================================
#' Rescale Continuous Vector (minimum, maximum)
#'
#' Rescales continuous vector to have specified minimum and maximum.
#' @param x A [`numeric`] vector.
#' @param to A length-two [`numeric`] vector specifying the output range.
#' @param from A length-two [`numeric`] vector specifying the input range.
#' @return A [`numeric`] vector.
#' @family scales
#' @keywords internal
#' @noRd
scale_range <- function(x, to = c(0, 1), from = range(x, finite = TRUE)) {
  if (is_zero(to) || is_zero(from)) return(ifelse(is.na(x), NA, mean(to)))
  (x - from[1L]) / diff(from) * diff(to) + to[1L]
}

#' Rescale Continuous Vector (minimum, midpoint, maximum)
#'
#' Rescales continuous vector to have specified minimum, midpoint and maximum.
#' @param x A [`numeric`] vector.
#' @param to A length-two [`numeric`] vector specifying the output range.
#' @param from A length-two [`numeric`] vector specifying the input range.
#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
#'  input range.
#' @return A [`numeric`] vector.
#' @family scales
#' @keywords internal
#' @noRd
scale_midpoint <- function(x, to = c(0, 1), from = range(x, finite = TRUE),
                           midpoint = 0) {
  if (is_zero(to) || is_zero(from)) return(ifelse(is.na(x), NA, mean(to)))
  extent <- 2 * max(abs(from - midpoint))
  (x - midpoint) / extent * diff(to) + mean(to)
}

# Helpers ======================================================================
need_continuous <- function(x) {
  if (!is.numeric(x)) {
    stop(tr_("Discrete value supplied to continuous scale."), call. = FALSE)
  }
  invisible(x)
}

need_discrete <- function(x) {
  if (is.double(x)) {
    warning(tr_("Continuous value supplied to discrete scale."), call. = FALSE)
  }
  invisible(x)
}

is_zero <- function(x, tolerance = sqrt(.Machine$double.eps)) {
  diff(range(x)) <= tolerance
}

make_levels <- function(x, levels = NULL, ordered = FALSE) {
  if (!is.null(levels)) return(make_levels(x = levels, ordered = ordered))

  if (is.null(x)) levels <- NULL
  else if (is.factor(x)) levels <- levels(x)
  else if (ordered) levels <- unique(x)
  else levels <- sort(unique(x))
  levels
}

# Paul Tol's color schemes
#' @include color.R
NULL

# Discrete =====================================================================
## Bright ----------------------------------------------------------------------
#' Paul Tol's *bright* Discrete Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::discrete_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_bright
#' @rdname scale_tol_bright
NULL

#' @export
#' @rdname scale_tol_bright
scale_colour_bright <- function(..., reverse = FALSE, aesthetics = "colour") {
  scale_discrete(aesthetics, "bright", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_bright
scale_color_bright <- scale_colour_bright

#' @export
#' @rdname scale_tol_bright
scale_fill_bright <- function(..., reverse = FALSE, aesthetics = "fill") {
  scale_discrete(aesthetics, "bright", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_bright
scale_edge_colour_bright <- function(..., reverse = FALSE,
                                     aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "bright", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_bright
scale_edge_color_bright <- scale_edge_colour_bright

#' @export
#' @rdname scale_tol_bright
scale_edge_fill_bright <- function(..., reverse = FALSE,
                                   aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "bright", reverse = reverse, ...)
}

## High contrast ---------------------------------------------------------------
#' Paul Tol's *high contrast* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_highcontrast
#' @rdname scale_tol_highcontrast
NULL

#' @export
#' @rdname scale_tol_highcontrast
scale_colour_highcontrast <- function(..., reverse = FALSE,
                                      aesthetics = "colour") {
  scale_discrete(aesthetics, "highcontrast", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_highcontrast
scale_color_highcontrast <- scale_colour_highcontrast

#' @export
#' @rdname scale_tol_highcontrast
scale_fill_highcontrast <- function(..., reverse = FALSE,
                                    aesthetics = "fill") {
  scale_discrete(aesthetics, "highcontrast", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_highcontrast
scale_edge_colour_highcontrast <- function(..., reverse = FALSE,
                                           aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "highcontrast", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_highcontrast
scale_edge_color_highcontrast <- scale_edge_colour_highcontrast

#' @export
#' @rdname scale_tol_highcontrast
scale_edge_fill_highcontrast <- function(..., reverse = FALSE,
                                         aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "highcontrast", reverse = reverse, ...)
}

## Vibrant ---------------------------------------------------------------------
#' Paul Tol's *vibrant* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_vibrant
#' @rdname scale_tol_vibrant
NULL

#' @export
#' @rdname scale_tol_vibrant
scale_colour_vibrant <- function(..., reverse = FALSE, aesthetics = "colour") {
  scale_discrete(aesthetics, "vibrant", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_vibrant
scale_color_vibrant <- scale_colour_vibrant

#' @export
#' @rdname scale_tol_vibrant
scale_fill_vibrant <- function(..., reverse = FALSE, aesthetics = "fill") {
  scale_discrete(aesthetics, "vibrant", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_vibrant
scale_edge_colour_vibrant <- function(..., reverse = FALSE,
                                      aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "vibrant", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_vibrant
scale_edge_color_vibrant <- scale_edge_colour_vibrant

#' @export
#' @rdname scale_tol_vibrant
scale_edge_fill_vibrant <- function(..., reverse = FALSE,
                                    aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "vibrant", reverse = reverse, ...)
}

## Muted -----------------------------------------------------------------------
#' Paul Tol's *muted* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_muted
#' @rdname scale_tol_muted
NULL

#' @export
#' @rdname scale_tol_muted
scale_colour_muted <- function(..., reverse = FALSE, aesthetics = "colour") {
  scale_discrete(aesthetics, "muted", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_muted
scale_color_muted <- scale_colour_muted

#' @export
#' @rdname scale_tol_muted
scale_fill_muted <- function(..., reverse = FALSE, aesthetics = "fill") {
  scale_discrete(aesthetics, "muted", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_muted
scale_edge_colour_muted <- function(..., reverse = FALSE,
                                    aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "muted", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_muted
scale_edge_color_muted <- scale_edge_colour_muted

#' @export
#' @rdname scale_tol_muted
scale_edge_fill_muted <- function(..., reverse = FALSE,
                                  aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "muted", reverse = reverse, ...)
}

## Medium contrast -------------------------------------------------------------
#' Paul Tol's *medium contrast* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_mediumcontrast
#' @rdname scale_tol_mediumcontrast
NULL

#' @export
#' @rdname scale_tol_mediumcontrast
scale_colour_mediumcontrast <- function(..., reverse = FALSE,
                                        aesthetics = "colour") {
  scale_discrete(aesthetics, "mediumcontrast", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_mediumcontrast
scale_color_mediumcontrast <- scale_colour_mediumcontrast

#' @export
#' @rdname scale_tol_mediumcontrast
scale_fill_mediumcontrast <- function(..., reverse = FALSE,
                                      aesthetics = "fill") {
  scale_discrete(aesthetics, "mediumcontrast", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_mediumcontrast
scale_edge_colour_mediumcontrast <- function(..., reverse = FALSE,
                                             aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "mediumcontrast", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_mediumcontrast
scale_edge_color_mediumcontrast <- scale_edge_colour_mediumcontrast

#' @export
#' @rdname scale_tol_mediumcontrast
scale_edge_fill_mediumcontrast <- function(..., reverse = FALSE,
                                           aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "mediumcontrast", reverse = reverse, ...)
}

## Pale ------------------------------------------------------------------------
#' Paul Tol's *pale* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_pale
#' @rdname scale_tol_pale
NULL

#' @export
#' @rdname scale_tol_pale
scale_colour_pale <- function(..., reverse = FALSE, aesthetics = "colour") {
  scale_discrete(aesthetics, "pale", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_pale
scale_color_pale <- scale_colour_pale

#' @export
#' @rdname scale_tol_pale
scale_fill_pale <- function(..., reverse = FALSE, aesthetics = "fill") {
  scale_discrete(aesthetics, "pale", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_pale
scale_edge_colour_pale <- function(..., reverse = FALSE,
                                   aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "pale", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_pale
scale_edge_color_pale <- scale_edge_colour_pale

#' @export
#' @rdname scale_tol_pale
scale_edge_fill_pale <- function(..., reverse = FALSE,
                                 aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "pale", reverse = reverse, ...)
}

## Dark ------------------------------------------------------------------------
#' Paul Tol's *dark* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_dark
#' @rdname scale_tol_dark
NULL

#' @export
#' @rdname scale_tol_dark
scale_colour_dark <- function(..., reverse = FALSE, aesthetics = "colour") {
  scale_discrete(aesthetics, "dark", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_dark
scale_color_dark <- scale_colour_dark

#' @export
#' @rdname scale_tol_dark
scale_fill_dark <- function(..., reverse = FALSE, aesthetics = "fill") {
  scale_discrete(aesthetics, "dark", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_dark
scale_edge_colour_dark <- function(..., reverse = FALSE,
                                   aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "dark", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_dark
scale_edge_color_dark <- scale_edge_colour_dark

#' @export
#' @rdname scale_tol_dark
scale_edge_fill_dark <- function(..., reverse = FALSE,
                                 aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "dark", reverse = reverse, ...)
}

## Light -----------------------------------------------------------------------
#' Paul Tol's *light* Discrete Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Qualitative Color Schemes
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_light
#' @rdname scale_tol_light
NULL

#' @export
#' @rdname scale_tol_light
scale_colour_light <- function(..., reverse = FALSE, aesthetics = "colour") {
  scale_discrete(aesthetics, "light", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_light
scale_color_light <- scale_colour_light

#' @export
#' @rdname scale_tol_light
scale_fill_light <- function(..., reverse = FALSE, aesthetics = "fill") {
  scale_discrete(aesthetics, "light", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_light
scale_edge_colour_light <- function(..., reverse = FALSE,
                                    aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "light", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_light
scale_edge_color_light <- scale_edge_colour_light

#' @export
#' @rdname scale_tol_light
scale_edge_fill_light <- function(..., reverse = FALSE,
                                  aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "light", reverse = reverse, ...)
}

## Discrete Rainbow ------------------------------------------------------------
#' Paul Tol's *discrete rainbow* Sequential Color Scheme
#'
#' @inheritParams scale_tol_bright
#' @inheritSection tol Sequential Color Schemes
#' @inheritSection tol Rainbow Color Scheme
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-discrete.R
#' @author N. Frerebeau
#' @family qualitative color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_discreterainbow
#' @rdname scale_tol_discreterainbow
NULL

#' @export
#' @rdname scale_tol_discreterainbow
scale_colour_discreterainbow <- function(..., reverse = FALSE,
                                         aesthetics = "colour") {
  scale_discrete(aesthetics, "discreterainbow", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_discreterainbow
scale_color_discreterainbow <- scale_colour_discreterainbow

#' @export
#' @rdname scale_tol_discreterainbow
scale_fill_discreterainbow <- function(..., reverse = FALSE,
                                       aesthetics = "fill") {
  scale_discrete(aesthetics, "discreterainbow", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_discreterainbow
scale_edge_colour_discreterainbow <- function(..., reverse = FALSE,
                                              aesthetics = "edge_colour") {
  scale_discrete(aesthetics, "discreterainbow", reverse = reverse, ...)
}

#' @export
#' @rdname scale_tol_discreterainbow
scale_edge_color_discreterainbow <- scale_edge_colour_discreterainbow

#' @export
#' @rdname scale_tol_discreterainbow
scale_edge_fill_discreterainbow <- function(..., reverse = FALSE,
                                            aesthetics = "edge_fill") {
  scale_discrete(aesthetics, "discreterainbow", reverse = reverse, ...)
}

# Diverging ====================================================================
## Sunset ----------------------------------------------------------------------
#' Paul Tol's *sunset* Diverging Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::continuous_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param range A length-two [`numeric`] vector specifying the
#' fraction of the scheme's color domain to keep.
#' @param midpoint A length-one [`numeric`] vector giving the midpoint
#'  (in data value) of the diverging scale. Defaults to `0`.
#' @param discrete A [`logical`] scalar: should the color scheme be
#'  used as a discrete scale? If `TRUE`, it is a departure from Paul Tol's
#'  recommendations and likely a very poor use of color.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @inheritSection tol Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_sunset
#' @rdname scale_tol_sunset
NULL

#' @export
#' @rdname scale_tol_sunset
scale_colour_sunset <- function(..., reverse = FALSE, range = c(0, 1),
                                midpoint = 0, discrete = FALSE,
                                aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "sunset", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "sunset", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_sunset
scale_color_sunset <- scale_colour_sunset

#' @export
#' @rdname scale_tol_sunset
scale_fill_sunset <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "sunset", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "sunset", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_sunset
scale_edge_colour_sunset <- function(..., reverse = FALSE, range = c(0, 1),
                                     midpoint = 0, discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "sunset", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "sunset", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_sunset
scale_edge_color_sunset <- scale_edge_colour_sunset

#' @export
#' @rdname scale_tol_sunset
scale_edge_fill_sunset <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "sunset", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "sunset", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## Nightfall ----------------------------------------------------------------------
#' Paul Tol's *nightfall* Diverging Color Scheme
#'
#' @inheritParams scale_tol_sunset
#' @inheritSection tol Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_nightfall
#' @rdname scale_tol_nightfall
NULL

#' @export
#' @rdname scale_tol_nightfall
scale_colour_nightfall <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "nightfall", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nightfall", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_nightfall
scale_color_nightfall <- scale_colour_nightfall

#' @export
#' @rdname scale_tol_nightfall
scale_fill_nightfall <- function(..., reverse = FALSE, range = c(0, 1),
                                 midpoint = 0, discrete = FALSE,
                                 aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "nightfall", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nightfall", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_nightfall
scale_edge_colour_nightfall <- function(..., reverse = FALSE, range = c(0, 1),
                                        midpoint = 0, discrete = FALSE,
                                        aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "nightfall", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nightfall", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_nightfall
scale_edge_color_nightfall <- scale_edge_colour_nightfall

#' @export
#' @rdname scale_tol_nightfall
scale_edge_fill_nightfall <- function(..., reverse = FALSE, range = c(0, 1),
                                      midpoint = 0, discrete = FALSE,
                                      aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "nightfall", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "nightfall", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## BuRd ------------------------------------------------------------------------
#' Paul Tol's *BuRd* Diverging Color Scheme
#'
#' @inheritParams scale_tol_sunset
#' @inheritSection tol Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_BuRd
#' @rdname scale_tol_BuRd
NULL

#' @export
#' @rdname scale_tol_BuRd
scale_colour_BuRd <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "BuRd", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "BuRd", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_BuRd
scale_color_BuRd <- scale_colour_BuRd

#' @export
#' @rdname scale_tol_BuRd
scale_fill_BuRd <- function(..., reverse = FALSE, range = c(0, 1),
                            midpoint = 0, discrete = FALSE,
                            aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "BuRd", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "BuRd", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_BuRd
scale_edge_colour_BuRd <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "BuRd", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "BuRd", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_BuRd
scale_edge_color_BuRd <- scale_edge_colour_BuRd

#' @export
#' @rdname scale_tol_BuRd
scale_edge_fill_BuRd <- function(..., reverse = FALSE, range = c(0, 1),
                                 midpoint = 0, discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "BuRd", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "BuRd", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

## PRGn ------------------------------------------------------------------------
#' Paul Tol's *PRGn* Diverging Color Scheme
#'
#' @inheritParams scale_tol_sunset
#' @inheritSection tol Diverging Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-diverging.R
#' @author N. Frerebeau
#' @family diverging color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_PRGn
#' @rdname scale_tol_PRGn
NULL

#' @export
#' @rdname scale_tol_PRGn
scale_colour_PRGn <- function(..., reverse = FALSE, range = c(0, 1),
                              midpoint = 0, discrete = FALSE,
                              aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "PRGn", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "PRGn", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_PRGn
scale_color_PRGn <- scale_colour_PRGn

#' @export
#' @rdname scale_tol_PRGn
scale_fill_PRGn <- function(..., reverse = FALSE, range = c(0, 1),
                            midpoint = 0, discrete = FALSE,
                            aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "PRGn", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "PRGn", reverse = reverse, range = range,
                     midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_PRGn
scale_edge_colour_PRGn <- function(..., reverse = FALSE, range = c(0, 1),
                                   midpoint = 0, discrete = FALSE,
                                   aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "PRGn", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "PRGn", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

#' @export
#' @rdname scale_tol_PRGn
scale_edge_color_PRGn <- scale_edge_colour_PRGn

#' @export
#' @rdname scale_tol_PRGn
scale_edge_fill_PRGn <- function(..., reverse = FALSE, range = c(0, 1),
                                 midpoint = 0, discrete = FALSE,
                                 aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "PRGn", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "PRGn", guide = "edge_colourbar",
                     reverse = reverse, range = range, midpoint = midpoint, ...)
  }
}

# Sequential ===================================================================
## YlOrBr ----------------------------------------------------------------------
#' Paul Tol's *YlOrBr* Sequential Color Scheme
#'
#' @param ... Arguments passed to [ggplot2::continuous_scale()].
#' @param reverse A [`logical`] scalar. Should the resulting
#'  vector of colors be reversed?
#' @param range A length-two [`numeric`] vector specifying the
#' fraction of the scheme's color domain to keep.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @param discrete A [`logical`] scalar: should the color scheme be
#'  used as a discrete scale? If `TRUE`, it is a departure from Paul Tol's
#'  recommendations and likely a very poor use of color.
#' @inheritSection tol Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_YlOrBr
#' @rdname scale_tol_YlOrBr
NULL

#' @export
#' @rdname scale_tol_YlOrBr
scale_colour_YlOrBr <- function(..., reverse = FALSE, range = c(0, 1),
                                discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "YlOrBr", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "YlOrBr", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_YlOrBr
scale_color_YlOrBr <- scale_colour_YlOrBr

#' @export
#' @rdname scale_tol_YlOrBr
scale_fill_YlOrBr <- function(..., reverse = FALSE, range = c(0, 1),
                              discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "YlOrBr", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "YlOrBr", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_YlOrBr
scale_edge_colour_YlOrBr <- function(..., reverse = FALSE, range = c(0, 1),
                                     discrete = FALSE,
                                     aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "YlOrBr", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "YlOrBr", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_YlOrBr
scale_edge_color_YlOrBr <- scale_edge_colour_YlOrBr

#' @export
#' @rdname scale_tol_YlOrBr
scale_edge_fill_YlOrBr <- function(..., reverse = FALSE, range = c(0, 1),
                                   discrete = FALSE,
                                   aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "YlOrBr", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "YlOrBr", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## Iridescent ------------------------------------------------------------------
#' Paul Tol's *iridescent* Sequential Color Scheme
#'
#' @inheritParams scale_colour_YlOrBr
#' @inheritSection tol Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_iridescent
#' @rdname scale_tol_iridescent
NULL

#' @export
#' @rdname scale_tol_iridescent
scale_colour_iridescent <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "iridescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "iridescent", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_iridescent
scale_color_iridescent <- scale_colour_iridescent

#' @export
#' @rdname scale_tol_iridescent
scale_fill_iridescent <- function(..., reverse = FALSE, range = c(0, 1),
                                  discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "iridescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "iridescent", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_iridescent
scale_edge_colour_iridescent <- function(..., reverse = FALSE, range = c(0, 1),
                                         discrete = FALSE,
                                         aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "iridescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "iridescent", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_iridescent
scale_edge_color_iridescent <- scale_edge_colour_iridescent

#' @export
#' @rdname scale_tol_iridescent
scale_edge_fill_iridescent <- function(..., reverse = FALSE, range = c(0, 1),
                                       discrete = FALSE,
                                       aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "iridescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "iridescent", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## Incandescent ------------------------------------------------------------------
#' Paul Tol's *incandescent* Sequential Color Scheme
#'
#' @inheritParams scale_colour_YlOrBr
#' @inheritSection tol Sequential Color Schemes
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_incandescent
#' @rdname scale_tol_incandescent
NULL

#' @export
#' @rdname scale_tol_incandescent
scale_colour_incandescent <- function(..., reverse = FALSE, range = c(0, 1),
                                      discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "incandescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "incandescent", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_incandescent
scale_color_incandescent <- scale_colour_incandescent

#' @export
#' @rdname scale_tol_incandescent
scale_fill_incandescent <- function(..., reverse = FALSE, range = c(0, 1),
                                    discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "incandescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "incandescent", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_incandescent
scale_edge_colour_incandescent <- function(..., reverse = FALSE, range = c(0, 1),
                                           discrete = FALSE,
                                           aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "incandescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "incandescent", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_incandescent
scale_edge_color_incandescent <- scale_edge_colour_incandescent

#' @export
#' @rdname scale_tol_incandescent
scale_edge_fill_incandescent <- function(..., reverse = FALSE, range = c(0, 1),
                                         discrete = FALSE,
                                         aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "incandescent", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "incandescent", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

## Smooth Rainbow --------------------------------------------------------------
#' Paul Tol's *smooth rainbow* Sequential Color Scheme
#'
#' @inheritParams scale_colour_YlOrBr
#' @inheritSection tol Sequential Color Schemes
#' @inheritSection tol Rainbow Color Scheme
#' @return A [continuous][ggplot2::continuous_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-tol-sequential.R
#' @author N. Frerebeau
#' @family sequential color schemes
#' @family Paul Tol's color schemes
#' @name scale_tol_smoothrainbow
#' @rdname scale_tol_smoothrainbow
NULL

#' @export
#' @rdname scale_tol_smoothrainbow
scale_colour_smoothrainbow <- function(..., reverse = FALSE, range = c(0, 1),
                                       discrete = FALSE, aesthetics = "colour") {
  if (discrete) {
    scale_discrete(aesthetics, "smoothrainbow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "smoothrainbow", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_smoothrainbow
scale_color_smoothrainbow <- scale_colour_smoothrainbow

#' @export
#' @rdname scale_tol_smoothrainbow
scale_fill_smoothrainbow <- function(..., reverse = FALSE, range = c(0, 1),
                                     discrete = FALSE, aesthetics = "fill") {
  if (discrete) {
    scale_discrete(aesthetics, "smooth rainbow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "smooth rainbow", reverse = reverse,
                     range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_smoothrainbow
scale_edge_colour_smoothrainbow <- function(..., reverse = FALSE, range = c(0, 1),
                                            discrete = FALSE,
                                            aesthetics = "edge_colour") {
  if (discrete) {
    scale_discrete(aesthetics, "smoothrainbow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "smoothrainbow", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @export
#' @rdname scale_tol_smoothrainbow
scale_edge_color_smoothrainbow <- scale_edge_colour_smoothrainbow

#' @export
#' @rdname scale_tol_smoothrainbow
scale_edge_fill_smoothrainbow <- function(..., reverse = FALSE, range = c(0, 1),
                                          discrete = FALSE,
                                          aesthetics = "edge_fill") {
  if (discrete) {
    scale_discrete(aesthetics, "smoothrainbow", reverse = reverse, ...)
  } else {
    scale_continuous(aesthetics, "smoothrainbow", guide = "edge_colourbar",
                     reverse = reverse, range = range, ...)
  }
}

#' @include color.R
NULL

# Geologic Timescale ===========================================================
#' Geologic Timescale Color Scheme for \pkg{ggplot2} and \pkg{ggraph}
#'
#' Provides the geologic timescale color scheme.
#' @param ... Arguments passed on to [ggplot2::discrete_scale()].
#' @param lang A [`character`] string specifying the language for the
#'  color names (see details). It must be one of "`en`" (english, the
#'  default), "`fr`" (french) or `NULL`. If not `NULL`, the values will be
#'  matched based on the color names.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @details Values will be matched based on the geological unit names.
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  \href{https://ccgm.org/}{Commission for the Geological Map of the World}.
#' @example inst/examples/ex-science-stratigraphy.R
#' @author N. Frerebeau
#' @family themed color schemes
#' @family qualitative color schemes
#' @export
#' @rdname scale_stratigraphy
scale_colour_stratigraphy <- function(..., lang = "en", aesthetics = "colour") {
  # Get palette
  color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
  # Build scale
  ggplot2::scale_color_manual(..., values = color_palette(175),
                              aesthetics = aesthetics)
}

#' @export
#' @rdname scale_stratigraphy
scale_color_stratigraphy <- scale_colour_stratigraphy

#' @export
#' @rdname scale_stratigraphy
scale_fill_stratigraphy <- function(..., lang = "en", aesthetics = "fill") {
  # Get palette
  color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
  # Build scale
  ggplot2::scale_fill_manual(..., values = color_palette(175),
                             aesthetics = aesthetics)
}

#' @export
#' @rdname scale_stratigraphy
scale_edge_colour_stratigraphy <- function(..., lang = "en") {
  # Get palette
  color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
  # Build scale
  ggraph::scale_edge_colour_manual(..., values = color_palette(175))
}

#' @export
#' @rdname scale_stratigraphy
scale_edge_color_stratigraphy <- scale_edge_colour_stratigraphy

#' @export
#' @rdname scale_stratigraphy
scale_edge_fill_stratigraphy <- function(..., lang = "en") {
  # Get palette
  color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
  # Build scale
  ggraph::scale_edge_fill_manual(..., values = color_palette(175))
}

# Land =========================================================================
#' AVHRR Global Land Cover Classification Color Scheme for \pkg{ggplot2}
#'  and \pkg{ggraph}
#'
#' Provides the AVHRR Global Land Cover classification as modified by
#' Paul Tol (colorblind safe).
#' @param ... Arguments passed on to [ggplot2::discrete_scale()].
#' @param lang A [`character`] string specifying the language for the
#'  color names (see details). It must be one of "`en`" (english, the
#'  default), "`fr`" (french) or `NULL`. If not `NULL`, the values will be
#'  matched based on the color names.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @details Values will be matched based on the land classification names.
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @references
#'  Tol, P. (2018). *Colour Schemes.* SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.1.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @example inst/examples/ex-science-land.R
#' @author N. Frerebeau
#' @family themed color schemes
#' @family qualitative color schemes
#' @export
#' @rdname scale_land
scale_colour_land <- function(..., lang = "en", aesthetics = "colour") {
  # Get palette
  color_palette <- color("land", names = !is.null(lang), lang = lang)
  # Build scale
  ggplot2::scale_color_manual(..., values = color_palette(14),
                              aesthetics = aesthetics)
}

#' @export
#' @rdname scale_land
scale_color_land <- scale_colour_land

#' @export
#' @rdname scale_land
scale_fill_land <- function(..., lang = "en", aesthetics = "fill") {
  # Get palette
  color_palette <- color("land", names = !is.null(lang), lang = lang)
  # Build scale
  ggplot2::scale_fill_manual(..., values = color_palette(14),
                             aesthetics = aesthetics)
}

#' @export
#' @rdname scale_land
scale_edge_colour_land <- function(..., lang = "en") {
  # Get palette
  color_palette <- color("land", names = !is.null(lang), lang = lang)
  # Build scale
  ggraph::scale_edge_colour_manual(..., values = color_palette(14))
}

#' @export
#' @rdname scale_land
scale_edge_color_land <- scale_edge_colour_land

#' @export
#' @rdname scale_land
scale_edge_fill_land <- function(..., lang = "en") {
  # Get palette
  color_palette <- color("land", names = !is.null(lang), lang = lang)
  # Build scale
  ggraph::scale_edge_fill_manual(..., values = color_palette(14))
}

# Soil =========================================================================
#' FAO Soil Reference Groups Color Scheme for \pkg{ggplot2} and \pkg{ggraph}
#'
#' Provides the FAO Soil Reference Groups color scheme.
#' @param ... Arguments passed on to [ggplot2::discrete_scale()].
#' @param lang A [`character`] string specifying the language for the
#'  color names (see details). It must be one of "`en`" (english, the
#'  default), "`fr`" (french) or `NULL`. If not `NULL`, the values will be
#'  matched based on the color names.
#' @param aesthetics A [`character`] string or vector of character
#'  strings listing the name(s) of the aesthetic(s) that this scale works with.
#' @details Values will be matched based on the soil names.
#' @references
#'  Jones, A., Montanarella, L. & Jones, R. (Ed.) (2005). *Soil atlas of
#'  Europe*. Luxembourg: European Commission, Office for Official Publications
#'  of the European Communities. 128 pp. ISBN: 92-894-8120-X.
#' @return A [discrete][ggplot2::discrete_scale] scale.
#' @example inst/examples/ex-science-soil.R
#' @author N. Frerebeau
#' @family themed color schemes
#' @family qualitative color schemes
#' @export
#' @rdname scale_soil
scale_colour_soil <- function(..., lang = "en", aesthetics = "colour") {
  # Get palette
  color_palette <- color("soil", names = !is.null(lang), lang = lang)
  # Build scale
  ggplot2::scale_color_manual(..., values = color_palette(24),
                              aesthetics = aesthetics)
}

#' @export
#' @rdname scale_soil
scale_color_soil <- scale_colour_soil

#' @export
#' @rdname scale_soil
scale_fill_soil <- function(..., lang = "en", aesthetics = "fill") {
  # Get palette
  color_palette <- color("soil", names = !is.null(lang), lang = lang)
  # Build scale
  ggplot2::scale_fill_manual(..., values = color_palette(24),
                             aesthetics = aesthetics)
}

#' @export
#' @rdname scale_soil
scale_edge_colour_soil <- function(..., lang = "en") {
  # Get palette
  color_palette <- color("soil", names = !is.null(lang), lang = lang)
  # Build scale
  ggraph::scale_edge_colour_manual(..., values = color_palette(24))
}

#' @export
#' @rdname scale_soil
scale_edge_color_soil <- scale_edge_colour_soil

#' @export
#' @rdname scale_soil
scale_edge_fill_soil <- function(..., lang = "en") {
  # Get palette
  color_palette <- color("soil", names = !is.null(lang), lang = lang)
  # Build scale
  ggraph::scale_edge_fill_manual(..., values = color_palette(24))
}

#' Plot Color Scheme
#'
#' Shows colors in a plot.
#' @param x A [`character`] vector of colors.
#' @param colours A [`logical`] scalar: should the hexadecimal representation of
#'  the colors be displayed?
#' @param names A [`logical`] scalar: should the name of the colors be
#'  displayed?
#' @param size A [`numeric`] value giving the amount by which plotting text
#'  should be magnified relative to the default. Works the same as `cex`
#'  parameter of [graphics::par()].
#' @return
#'  `plot_scheme()` is called for its side-effects: it results in a graphic
#'   being displayed (invisibly returns `x`).
#' @example inst/examples/ex-plot.R
#' @author N. Frerebeau
#' @family diagnostic tools
#' @export
plot_scheme <- function(x, colours = FALSE, names = FALSE, size = 1) {
  # Validation
  assert_color(x)

  # Save and restore graphical parameters
  old_par <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(old_par))

  info <- colours && names
  missing <- attr(x, "missing")
  bad_data <- !is.null(missing) && !is.na(missing)
  if (bad_data) x <- c(x, missing)

  n <- length(x) # Number of colors
  p <- seq(from = 1, by = 0.75, length.out = n)
  q <- 1 - 0.43 * rep(c(0, 1), length.out = n)

  graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
  graphics::plot(
    x = NULL, y = NULL,
    xlim = c(0.5, max(p) + 0.5 + bad_data / 2), ylim = c(0, 1.5),
    xlab = "", ylab = "", axes = FALSE, asp = 1
  )

  for (i in seq_len(n - bad_data)) {
    #even <- i %% 2 == 0
    draw_hexagon(x = p[[i]], y = q[[i]], r = 0.5, border = NULL, fill = x[[i]])
  }
  if (bad_data) {
    draw_circle(x = p[[n]] + 0.5, y = q[[n]], r = 0.5, n = 200,
                border = NULL, fill = missing)
  }
  delta <- ifelse(colours && names && !is.null(names(x)), 0.1, 0)
  if (colours) {
    if (bad_data) {
      graphics::text(x = p[[n]] + 0.5, y = q[[n]], labels = missing, cex = size)
      x <- utils::head(x, -1)
      p <- utils::head(p, -1)
      q <- utils::head(q, -1)
    }
    graphics::text(x = p, y = q - delta * info, labels = x, cex = size)
  }
  if (names && !is.null(names(x))) {
    graphics::text(x = p, y = q + delta * info, labels = names(x), cex = size)
  }

  invisible(x)
}

draw_hexagon <- function(x = 0, y = 0, r = 0.5, border = NULL, fill = NA) {
  vertices <- seq_len(6)
  graphics::polygon(
    x = x + r * cos(vertices * 2 * pi / 6),
    y = y + r * sin(vertices * 2 * pi / 6),
    border = border,
    col = fill
  )
}
draw_circle <- function(x = 0, y = 0, r = 0.5, n = 200,
                        border = NULL, fill = NA) {
  theta <- seq(0, 2 * pi, length.out = n)
  graphics::polygon(
    x = r * cos(theta) + x,
    y = r * sin(theta) + y,
    border = border,
    col = fill
  )
}

#' Color Schemes
#'
#' Provides qualitative, diverging and sequential color schemes.
#' @param palette A [`character`] string giving the name of the scheme to be
#'  used (see [info()]).
#' @param reverse A [`logical`] scalar: should the resulting vector of colors
#'  should be reversed?
#' @param names A [`logical`] scalar: should the names of the colors should be
#'  kept in the resulting vector?
#' @param lang A [`character`] string specifying the language for the color
#'  names. It must be one of "`en`" (English, the default) or "`fr`" (French).
#' @param force A [`logical`] scalar. If `TRUE`, forces the color scheme to be
#'  interpolated. It should not be used routinely with qualitative color
#'  schemes, as they are designed to be used as is to remain color-blind safe.
#' @param ... Further arguments passed to
#'  [colorRampPalette][grDevices::colorRamp].
#' @return
#'  A [`function`] function with the following attributes, that when called
#'  with a single argument (an [`integer`] specifying the number of colors)
#'  returns a (named) vector of colors.
#'
#'  \describe{
#'   \item{palette}{A [`character`] string giving the name of the
#'   color scheme.}
#'   \item{type}{A [`character`] string giving the corresponding
#'   data type. One of "`qualitative`", "`diverging`" or "`sequential`".}
#'   \item{interpolate}{A [`logical`] scalar: can the color palette be
#'   interpolated?}
#'   \item{missing}{A [`character`] string giving the the hexadecimal
#'   representation of the color that should be used for `NA` values.}
#'   \item{max}{An [`integer`] giving the maximum number of color values.
#'   Only relevant for non-interpolated color schemes.}
#'  }
#'
#'  For color schemes that can be interpolated (diverging and sequential data),
#'  the color range can be limited with an additional argument. `range` allows
#'  to remove a fraction of the color domain (before being interpolated; see
#'  examples).
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#'
#'  Jones, A., Montanarella, L. & Jones, R. (Ed.) (2005). *Soil atlas of
#'  Europe*. Luxembourg: European Commission, Office for Official Publications
#'  of the European Communities. 128 pp. ISBN: 92-894-8120-X.
#'
#'  Okabe, M. & Ito, K. (2008). *Color Universal Design (CUD): How to Make
#'  Figures and Presentations That Are Friendly to Colorblind People*.
#'  URL: \url{https://jfly.uni-koeln.de/color/}.
#'
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#'
#'  \href{https://ccgm.org/}{Commission for the Geological Map of the World}
#' @example inst/examples/ex-palettes.R
#' @author N. Frerebeau
#' @family color schemes
#' @keywords color
#' @export
colour <- function(palette, reverse = FALSE, names = FALSE, lang = "en",
                   force = FALSE, ...) {
  ## Validation
  palette <- gsub(pattern = "[[:blank:]]", replacement = "", x = palette)
  palette <- match.arg(palette, names(.schemes), several.ok = FALSE)
  lang <- match.arg(lang, c("en", "fr"), several.ok = FALSE)

  ## Get colors
  col_palette <- .schemes[[palette]]
  col_colors <- col_palette[["colours"]]
  col_names <- col_palette[["names"]][[lang]]
  col_type <- col_palette[["type"]]
  col_interpolate <- col_palette[["interpolate"]]
  col_missing <- col_palette[["missing"]]
  col_scheme <- col_palette[["scheme"]]
  k <- col_palette[["max"]]

  ## Reverse color order
  if (reverse) col_colors <- rev(col_colors)

  if (col_interpolate || force) {

    ## For color schemes that can be linearly interpolated
    fun <- function(n, range = c(0, 1)) {
      if (missing(n)) n <- k
      # Validate
      if (any(range > 1) || any(range < 0)) {
        msg <- tr_("%s values must be in [0,1].")
        stop(sprintf(msg, sQuote("range")), call. = FALSE)
      }
      # Remove starting colors
      col_colors <- utils::tail(col_colors, k * (1 - range[[1]]))
      # Remove ending colors
      col_colors <- utils::head(col_colors, k * range[[2]])
      # Interpolate
      col <- grDevices::colorRampPalette(col_colors)(n)
      # Set attributes
      col <- structure(
        col,
        missing = col_missing,
        class = c("color_scheme", "color_continuous")
      )
      return(col)
    }

  } else {

    ## No interpolation
    ## FIXME: add 'range = c(0, 1)' to prevent "multiple local function
    ## definitions" note in R CMD check
    fun <- function(n, range = c(0, 1)) {
      if (missing(n)) n <- k
      # Validate
      if (n > k) {
        msg <- tr_("%s color scheme supports up to %d values.")
        stop(sprintf(msg, sQuote(palette), k), call. = FALSE)
      }
      # Arrange color schemes
      if (!is.null(col_scheme)) {
        m <- col_scheme[[n]]
        if (reverse) {
          m <- rev(m)
          col_colors <- rev(col_colors)
        }
        col <- col_colors[m]
      } else if (col_type == "qualitative") {
        m <- seq_len(n)
        col <- col_colors[m]
      } else {
        m <- seq(from = 1, to = k, length.out = n)
        col <- col_colors[m]
      }
      # Keep names?
      if (names) names(col) <- col_names[m] else col <- unname(col)
      # Set attributes
      col <- structure(
        col,
        missing = col_missing,
        class = c("color_scheme", "color_discrete")
      )
      return(col)
    }

  }
  ## Set attributes
  fun <- structure(
    fun,
    palette = palette,
    type = col_type,
    missing = col_missing,
    interpolate = col_interpolate || force,
    max = as.integer(k)
  )
  return(fun)
}

#' @export
#' @rdname colour
color <- colour

#' Diagnostic Map
#'
#' Produces a diagnostic map for a given color scheme.
#' @param x A [`character`] vector of colors.
#' @return
#'  `plot_map()` is called for its side-effects: it results in a graphic
#'   being displayed (invisibly returns `x`).
#' @example inst/examples/ex-plot.R
#' @author N. Frerebeau, V. Arel-Bundock
#' @family diagnostic tools
#' @export
plot_map <- function(x) {
  # Validation
  assert_color(x)

  # Save and restore graphical parameters
  old_par <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(old_par))

  n <- length(x) # Number of colors
  q <- floor(100 / (n + 1))

  graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
  graphics::plot(
    x = NULL, y = NULL,
    xlim = c(0, (q * (n + 1) / 2) + 1), ylim = c(0, 10.5),
    xlab = "", ylab = "", axes = FALSE, asp = 1
  )

  random_colors <- sample(x, size = 19 * q, replace = TRUE)
  draw_mosaic(columns = q, border = "black", fill = random_colors)

  for (h in seq_len(n)) {
    random_positions <- sample(seq_len(19 * q), size = n, replace = FALSE)
    unique_color <- rep(x[[h]], length.out = 19 * q)
    unique_color[random_positions] <- x

    draw_mosaic(columns = q, border = "black", fill = unique_color, offset = h)
  }

  invisible(x)
}

#' Mosaic
#'
#' Draws a mosaic of diamonds.
#' @param rows An [`integer`] giving the number of lines.
#' @param columns An [`integer`] giving the number of columns.
#' @param border A [`character`] string giving the color to draw the
#' border (see \code{\link[graphics]{polygon}}).
#' @param fill A [`character`] string giving the color for filling
#' the polygon (see \code{\link[graphics]{polygon}}).
#' @param offset An [`numeric`] value giving the \code{x} offset from
#' zero of the mosaic.
#' @keywords internal
#' @noRd
draw_mosaic <- function(rows = 19, columns = 10, border = NULL, fill = NA,
                        offset = 0) {
  fill <- rep(fill, length.out = rows * columns)
  k <- 1
  for (i in seq_len(rows)) { # Loop over lines
    even <- i %% 2 == 0
    for (j in seq_len(columns)) { # Loop over columns
      graphics::polygon(
        x = c(0, 0.25, 0.5, 0.25) +
          j * 0.5 + 0.25 * even +
          columns * offset / 2,
        y = c(0.5, 1, 0.5, 0) + i * 0.5,
        border = border,
        col = fill[[k]]
      )
      k <- k + 1
    }
  }
}

# draw_diamond <- function(x = 0, y = 0, width = 0.5, height = 1,
#                          border = NULL, fill = NA) {
#   half_width <- width / 2
#   half_height <- height / 2
#   graphics::polygon(
#     x = c(x - half_width, x, x + half_width, x),
#     y = c(y, y + half_height, y, y - half_height),
#     border = border,
#     col = fill
#   )
# }

# HELPERS

## https://michaelchirico.github.io/potools/articles/developers.html
tr_ <- function(...) {
  enc2utf8(gettext(paste0(...), domain = "R-khroma"))
}

`%||%` <- function(x, y) {
  if (!is.null(x)) x else y
}

assert_package <- function(x) {
  if (!requireNamespace(x, quietly = TRUE)) {
    msg <- tr_("Package %s needed for this function to work. Please install it.")
    stop(sprintf(msg, sQuote(x)), call. = FALSE)
  }
  invisible(NULL)
}

assert_color <- function(x) {
  if (!is.atomic(x) || !is.character(x)) {
    msg <- tr_("%s must be a character vector of colors.")
    stop(sprintf(msg, sQuote("x")), call. = FALSE)
  }
  invisible(NULL)
}

#' Color Difference
#'
#' Computes CIELAB distance metric.
#' @param x A [`character`] vector of colors.
#' @param metric An [`integer`] value giving the year the metric was
#'  recommended by the CIE. It must be one of "`1976`", "`1994`", or
#'  "`2000`" (default; see [spacesXYZ::DeltaE()]).
#' @param diag A [`logical`] scalar: should the diagonal of the distance matrix
#'  be printed?
#' @param upper	A [`logical`] scalar: should the upper triangle of the distance
#'  matrix should be printed?
#' @return A [distance matrix][stats::dist].
#' @example inst/examples/ex-compare.R
#' @author N. Frerebeau
#' @family diagnostic tools
#' @export
compare <- function(x, metric = 2000, diag = FALSE, upper = FALSE) {
  # Validation
  assert_package("spacesXYZ")
  assert_color(x)

  # Hex to RGB
  RGB <- t(grDevices::col2rgb(x, alpha = FALSE))
  # RGB to Lab
  Lab <- XYZ2Lab(RGB2XYZ(RGB))

  # Color comparisons
  delta_E <- apply(
    X = Lab,
    MARGIN = 1,
    FUN = spacesXYZ::DeltaE,
    Lab2 = Lab,
    metric = metric[[1L]]
  )

  stats::as.dist(delta_E, diag = diag, upper = upper)
}

#' Available Schemes
#'
#' Returns information about the available schemes.
#' @return
#'  A [`data.frame`] with the following columns:
#'  \describe{
#'   \item{`palette`}{Names of palette.}
#'   \item{`type`}{Types of schemes: sequential, diverging or qualitative.}
#'   \item{`max`}{Maximum number of colors that are contained in each
#'   palette. Only relevant for qualitative schemes.}
#'   \item{`missing`}{The hexadecimal color value for mapping missing values.}
#'  }
#' @example inst/examples/ex-info.R
#' @author N. Frerebeau
#' @family color schemes
#' @export
info <- function() {
  meta <- lapply(
    X = .schemes,
    FUN = function(x) {
      list(type = x$type, max = x$max, missing = x$missing)
    }
  )
  meta <- do.call(rbind.data.frame, meta)
  rownames(meta) <- NULL
  colnames(meta) <- c("type", "max", "missing")
  meta$palette <- names(.schemes)
  meta[, c(4, 1, 2, 3)]
}

# Paul Tol =====================================================================
#' Paul Tol's Color Schemes
#'
#' @details
#'  The maximum number of supported colors is only relevant for the qualitative
#'  color schemes (divergent and sequential schemes are linearly interpolated).
#'
#'  \describe{
#'   \item{Qualitative data}{`bright` (7), `high contrast` (3), `vibrant` (7),
#'   `muted` (9), `medium contrast` (6), `pale` (6), `dark` (6), `light` (9).}
#'   \item{Diverging data}{`sunset` (11), `nightfall` (17), `BuRd` (9),
#'   `PRGn` (9).}
#'   \item{Sequential data}{`YlOrBr` (9), `iridescent` (23), `incandescent`
#'   (11), `discrete rainbow` (23), `smooth rainbow` (34).}
#'  }
#' @section Qualitative Color Schemes:
#'  The qualitative color schemes are used as given (no interpolation):
#'  colors are picked up to the maximum number of supported values.
#'
#'  \tabular{ll}{
#'   **Palette**      \tab **Max.** \cr
#'   `bright`         \tab 7        \cr
#'   `highcontrast`   \tab 3        \cr
#'   `vibrant`        \tab 7        \cr
#'   `muted`          \tab 9        \cr
#'   `mediumcontrast` \tab 6        \cr
#'   `pale`           \tab 6        \cr
#'   `dark`           \tab 6        \cr
#'   `light`          \tab 9        \cr
#'  }
#'
#'  According to Paul Tol's technical note, the `bright`, `highcontrast`,
#'  `vibrant` and `muted` color schemes are color-blind safe. The
#'  `mediumcontrast` color scheme is designed for situations needing color
#'  pairs.
#'
#'  The `light` color scheme is reasonably distinct for both normal or
#'  colorblind vision and is intended to fill labeled cells.
#'
#'  The `pale` and `dark` schemes are not very distinct in either normal or
#'  colorblind vision and should be used as a text background or to highlight
#'  a cell in a table.
#'
#'  Refer to the original document for details about the recommended uses (see
#'  references)
#' @section Diverging Color Schemes:
#'  If more colors than defined are needed from a given scheme, the color
#'  coordinates are linearly interpolated to provide a continuous version of the
#'  scheme.
#'
#'  \tabular{lll}{
#'   **Palette** \tab **Max.** \tab **NA value** \cr
#'   `sunset`    \tab 11       \tab #FFFFFF      \cr
#'   `nightfall` \tab 17       \tab #FFFFFF      \cr
#'   `BuRd`      \tab 9        \tab #FFEE99      \cr
#'   `PRGn`      \tab 9        \tab #FFEE99      \cr
#'  }
#'
#' @section Sequential Color Schemes:
#'  If more colors than defined are needed from a given scheme, the color
#'  coordinates are linearly interpolated to provide a continuous version of the
#'  scheme.
#'
#'  \tabular{lll}{
#'   **Palette**       \tab **Max.** \tab **NA value** \cr
#'   `YlOrBr`          \tab 9        \tab #888888      \cr
#'   `iridescent`      \tab 23       \tab #999999      \cr
#'   `discreterainbow` \tab 23       \tab #777777      \cr
#'   `smoothrainbow`   \tab 34       \tab #666666      \cr
#'  }
#' @section Rainbow Color Scheme:
#'  As a general rule, ordered data should not be represented using a rainbow
#'  scheme. There are three main arguments against such use (Tol 2018):
#'  \itemize{
#'   \item{The spectral order of visible light carries no inherent magnitude
#'   message.}
#'   \item{Some bands of almost constant hue with sharp transitions between
#'   them, can be perceived as jumps in the data.}
#'   \item{Color-blind people have difficulty distinguishing some colors of
#'   the rainbow.}
#'  }
#'  If such use cannot be avoided, Paul Tol's technical note provides two color
#'  schemes that are reasonably clear in color-blind vision. To remain
#'  color-blind safe, these two schemes must comply with the following
#'  conditions:
#'  \describe{
#'   \item{`discreterainbow`}{This scheme must not be interpolated.}
#'   \item{`smoothrainbow`}{This scheme does not have to be used over the full
#'   range.}
#'  }
#' @references
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#' @keywords internal
#' @rdname tol
#' @name tol
NULL

# Fabio Crameri ================================================================
#' Fabio Crameri's Color Schemes
#'
#' @section Diverging Color Schemes:
#'  If more colors than defined are needed from a given scheme, the color
#'  coordinates are linearly interpolated to provide a continuous version of the
#'  scheme.
#'
#'  \tabular{ll}{
#'   **Palette** \tab **Max.** \cr
#'   `broc`      \tab 256      \cr
#'   `cork`      \tab 256      \cr
#'   `vik`       \tab 256      \cr
#'   `lisbon`    \tab 256      \cr
#'   `tofino`    \tab 256      \cr
#'   `berlin`    \tab 256      \cr
#'   `roma`      \tab 256      \cr
#'   `bam`       \tab 256      \cr
#'   `vanimo`    \tab 256      \cr
#'   `brocO`*    \tab 256      \cr
#'   `corkO`*    \tab 256      \cr
#'   `vikO`*     \tab 256      \cr
#'   `romaO`*    \tab 256      \cr
#'   `bamO`*     \tab 256      \cr
#'  }
#'  *: cyclic color schemes.
#' @section Sequential Color Schemes:
#'  If more colors than defined are needed from a given scheme, the color
#'  coordinates are linearly interpolated to provide a continuous version of the
#'  scheme.
#'
#'  \tabular{ll}{
#'   **Palette** \tab **Max.** \cr
#'   `batlow`    \tab 256      \cr
#'   `batlowW`   \tab 256      \cr
#'   `batlowK`   \tab 256      \cr
#'   `devon`     \tab 256      \cr
#'   `lajolla`   \tab 256      \cr
#'   `bamako`    \tab 256      \cr
#'   `davos`     \tab 256      \cr
#'   `bilbao`    \tab 256      \cr
#'   `nuuk`      \tab 256      \cr
#'   `oslo`      \tab 256      \cr
#'   `grayC`     \tab 256      \cr
#'   `hawaii`    \tab 256      \cr
#'   `lapaz`     \tab 256      \cr
#'   `tokyo`     \tab 256      \cr
#'   `buda`      \tab 256      \cr
#'   `acton`     \tab 256      \cr
#'   `turku`     \tab 256      \cr
#'   `imola`     \tab 256      \cr
#'   `oleron`*   \tab 256      \cr
#'   `bukavu`*   \tab 256      \cr
#'   `fes`*      \tab 256      \cr
#'  }
#'  *: multisequential color schemes.
#' @references
#'  Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
#'  StagLab 3.0. *Geosci. Model Dev.*, 11, 2541-2562.
#'  \doi{10.5194/gmd-11-2541-2018}
#'
#'  Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
#'  science communication. *Nature Communications*, 11, 5444.
#'  \doi{10.1038/s41467-020-19160-7}
#' @source
#'  Crameri, F. (2021). Scientific colour maps. *Zenodo*, v7.0.
#'  \doi{10.5281/zenodo.4491293}
#' @keywords internal
#' @rdname crameri
#' @name crameri
NULL

# Science ======================================================================
#' Scientific Color Schemes
#'
#' @details
#'  The following (qualitative) color schemes are available:
#'  \describe{
#'   \item{`stratigraphy`}{International Chronostratigraphic Chart (175 colors).}
#'   \item{`land`}{AVHRR Global Land Cover Classification (14 colors).}
#'   \item{`soil`}{FAO Reference Soil Groups (24 colors).}
#'  }
#' @references
#'  Jones, A., Montanarella, L. & Jones, R. (Ed.) (2005). *Soil atlas of
#'  Europe*. Luxembourg: European Commission, Office for Official Publications
#'  of the European Communities. 128 pp. ISBN: 92-894-8120-X.
#'
#'  Tol, P. (2021). *Colour Schemes*. SRON. Technical Note No.
#'  SRON/EPS/TN/09-002, issue 3.2.
#'  URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
#'
#'  \href{https://ccgm.org/}{Commission for the Geological Map of the World}
#' @keywords internal
#' @rdname science
#' @name science
NULL

#' Diagnostic Map
#'
#' Produces a diagnostic map for a given color scheme.
#' @param x A [`character`] vector of colors.
#' @param n An [`integer`] specifying the size of the grid (defaults to
#'  \eqn{512}).
#' @return
#'  `plot_tiles()` is called for its side-effects: it results in a graphic
#'   being displayed (invisibly returns `x`).
#' @example inst/examples/ex-plot.R
#' @author N. Frerebeau
#' @family diagnostic tools
#' @export
plot_tiles <- function(x, n = 512) {
  # Validation
  assert_color(x)

  # Save and restore graphical parameters
  old_par <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(old_par))

  g <- expand.grid(
    x = seq_len(n),
    y = seq_len(n)
  )
  noise <- sin(g$x / 16) + cos(g$y / 16) +
    stats::dnorm(sqrt((g$x - 0.75 * n)^2 + (g$y - 0.33 * n)^2) / n * 20)
  z <- matrix(data = noise, nrow = n, ncol = n)

  graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
  graphics::image(x = seq_len(n), y = seq_len(n), z = z, col = x,
                  axes = FALSE, asp = 1)

  invisible(x)
}

#' Plot Simulated Color Blindness
#'
#' Shows colors in a plot with different types of simulated color blindness.
#' @param x A [`character`] vector of colors.
#' @return
#'  `plot_scheme_colourblind()` is called for its side-effects: it results in a
#'  graphic being displayed (invisibly returns `x`).
#' @example inst/examples/ex-change.R
#' @author N. Frerebeau, V. Arel-Bundock
#' @family diagnostic tools
#' @export
plot_scheme_colourblind <- function(x) {
  # Validation
  assert_color(x)

  n <- length(x)
  col <- c(x, anomalize(x, 'deuteranopia'), anomalize(x, 'protanopia'),
           anomalize(x, 'tritanopia'), anomalize(x, 'achromatopsia'))
  xcoord <- seq(0, 1, length.out = n + 1)
  ycoord <- rep(c(.8, .6, .4, .2, 0), each = n)
  grid::grid.newpage()
  grid::grid.rect(
    x = grid::unit(utils::head(xcoord, -1), "npc"),
    y = grid::unit(ycoord, "npc"),
    width = grid::unit(1 / n, "npc"),
    height = grid::unit(0.7 / 5, "npc"),
    hjust = 0,
    vjust = 0,
    gp = grid::gpar(fill = col, col = col)
  )
  grid::grid.text(
    label = c("Palette", "Deuteranopia", "Protanopia", "Tritanopia",
              "Achromatopsia"),
    x = grid::unit(0, 'npc'),
    y = grid::unit(c(0.97, 0.77, 0.57, 0.37, 0.17), "npc"),
    hjust = 0
  )

  invisible(x)
}

#' @rdname plot_scheme_colourblind
#' @export
plot_scheme_colorblind <- plot_scheme_colourblind

#' Plot Color Scheme
#'
#' Quickly displays a color scheme returned by [color()].
#' @param x A [`character`] vector of colors.
#' @param ... Currently not used.
#' @return
#'  `plot()` is called for its side-effects: it results in a graphic
#'   being displayed (invisibly returns `x`).
#' @example inst/examples/ex-plot.R
#' @author N. Frerebeau
#' @family diagnostic tools
#' @export
plot.color_scheme <- function(x, ...) {
  # Save and restore graphical parameters
  old_par <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(old_par))

  n <- length(x)
  graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
  graphics::plot(
    x = NULL, y = NULL,
    xlim = c(0, n), ylim = c(0, 1),
    xlab = "", ylab = "", axes = FALSE
  )
  graphics::rect(xleft = seq(0, n - 1), xright = seq(1, n),
                 ybottom = 0.25, ytop = 0.75, col = x, border = NA)
  if (n < 25) graphics::abline(v = seq(1, n), col = "#D3D3D3", lwd = 0.25)

  invisible(x)
}

1		# Print
2
3		#' @export
4		print.color_scheme <- function(x, ...) {
5	!	print(unclass(x))
6		}

1		# Color scales constructor for ggplot2
2		#' @include color.R
3		NULL
4
5		#' Color Scale Builder
6		#'
7		#' Builds a color scale for \pkg{ggplot2} or \pkg{ggraph}.
8		#' @param palette A [`character`] string giving the name of the color scheme to
9		#' be used (see [info()]).
10		#' @param ... Extra parameters to be passed to the color scale function.
11		#' @return A [discrete][ggplot2::discrete_scale] or
12		#' [continuous][ggplot2::continuous_scale] scale.
13		#' @example inst/examples/ex-pick.R
14		#' @author N. Frerebeau
15		#' @family ggplot2 scales
16		#' @name scale_picker
17		#' @rdname scale_picker
18		NULL
19
20		#' @export
21		#' @rdname scale_picker
22		scale_colour_picker <- function(..., palette = "YlOrBr") {
23	4x	fun <- sprintf("scale_colour_%s", palette)
24	4x	do.call(fun, args = list(...))
25		}
26
27		#' @export
28		#' @rdname scale_picker
29		scale_color_picker <- scale_colour_picker
30
31		#' @export
32		#' @rdname scale_picker
33		scale_fill_picker <- function(..., palette = "YlOrBr") {
34	1x	fun <- sprintf("scale_fill_%s", palette)
35	1x	do.call(fun, args = list(...))
36		}
37
38		#' @export
39		#' @rdname scale_picker
40		scale_edge_colour_picker <- function(..., palette = "YlOrBr") {
41	1x	fun <- sprintf("scale_edge_colour_%s", palette)
42	1x	do.call(fun, args = list(...))
43		}
44
45		#' @export
46		#' @rdname scale_picker
47		scale_edge_color_picker <- scale_edge_colour_picker
48
49		#' @export
50		#' @rdname scale_picker
51		scale_edge_fill_picker <- function(..., palette = "YlOrBr") {
52	1x	fun <- sprintf("scale_edge_fill_%s", palette)
53	1x	do.call(fun, args = list(...))
54		}
55
56		#' Color Scale Constructors
57		#'
58		#' Builds a discrete or continuous scale for \pkg{ggplot2} according to the
59		#' color scheme used.
60		#' @param aesthetics The names of the aesthetics that this scale works with.
61		#' @param scheme A [`character`] string giving the name of the scheme to be
62		#' used (see [color()]).
63		#' @param guide A [`function`] used to create a guide or its name.
64		#' See [ggplot2::guides()] for more information.
65		#' @param reverse A [`logical`] scalar: should the resulting vector of colors
66		#' should be reversed?
67		#' @param use_names A [`logical`] scalar: should the names of the colors be
68		#' preserved?
69		#' @param lang A [`character`] string specifying the language for the color
70		#' names. It must be one of "`en`" (english, the default) or "`fr`" (french).
71		#' @param type A [`character`] string specifying the scale to be
72		#' build. It must be one of "`auto`" (the default), "`discrete`" or
73		#' "`continuous`". "`discrete`" allows to use a continuous color scheme with
74		#' discrete data. "`continuous`" allows to use a discrete color scheme with
75		#' continuous data (forces interpolation; see [color()]).
76		#' @param midpoint A [`numeric`] value specifying the midpoint (in
77		#' data value) of the diverging scale (defaults to \eqn{0}).
78		#' @param ... Further arguments passed to [ggplot2::discrete_scale()]
79		#' or [ggplot2::continuous_scale()], used respectively for qualitative data
80		#' and diverging/sequential data.
81		#' @return A [discrete][ggplot2::discrete_scale()]
82		#' or [continuous][ggplot2:continuous_scale()] scale.
83		#' @author N. Frerebeau
84		#' @keywords internal
85		#' @noRd
86		NULL
87
88		scale_discrete <- function(aesthetics, scheme, guide = "legend",
89		reverse = FALSE, use_names = FALSE,
90		lang = "en", ...) {
91		# Check if ggplot2 is installed
92	280x	assert_package("ggplot2")
93
94		# Get color scheme
95	280x	palette <- color(scheme, reverse = reverse, names = use_names, lang = lang)
96
97		# Build scale
98	280x	scale_args <- list(...)
99	280x	scale_args$guide <- guide
100	280x	scale_args$na.value <- scale_args$na.value %\|\|% attr(palette, "missing")
101
102	280x	do.call(
103	280x	ggplot2::discrete_scale,
104	280x	c(aesthetics = aesthetics, palette = palette, scale_args)
105		)
106		}
107
108		scale_continuous <- function(aesthetics, scheme, guide = "colourbar",
109		reverse = FALSE, range = c(0, 1), midpoint = 0,
110		lang = "en", ...) {
111		# Validation
112	632x	assert_package("ggplot2") # Check if ggplot2 is installed
113	286x	if (guide == "edge_colourbar") assert_package("ggraph")
114
115		# Get color scheme
116	632x	palette <- color(scheme, reverse = reverse, names = FALSE, lang = lang)
117	632x	max <- attr(palette, "max")
118	632x	type <- attr(palette, "type")
119
120		# Build scale
121	632x	scale_args <- list(...)
122	632x	scale_args$guide <- guide
123	632x	scale_args$na.value <- scale_args$na.value %\|\|% attr(palette, "missing")
124
125	632x	if (type == "diverging") {
126	310x	scale_args$rescaler <- rescale_mid(mid = midpoint)
127		}
128
129	632x	palette <- scales::gradient_n_pal(palette(max, range = range))
130	632x	do.call(
131	632x	ggplot2::continuous_scale,
132	632x	c(aesthetics = aesthetics, palette = palette, scale_args)
133		)
134		}
135
136		rescale_mid <- function(mid) {
137	310x	function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) {
138	!	scale_midpoint(x, to = to, from = from, midpoint = mid)
139		}
140		}

1		# Okabe & Ito color scheme
2		#' @include color.R
3		NULL
4
5		# Discrete =====================================================================
6		#' Okabe and Ito's Discrete Color Scheme for \pkg{ggplot2} and \pkg{ggraph}
7		#'
8		#' Provides the qualitative color scale from Okabe and Ito 2008.
9		#' @param ... Arguments passed to [ggplot2::discrete_scale()].
10		#' @param reverse A [`logical`] scalar. Should the resulting
11		#' vector of colors be reversed?
12		#' @param black_position A [`character`] string giving the position of the black
13		#' color. It must be one of "`first`" or "`last`". Any unambiguous substring
14		#' can be given.
15		#' @param aesthetics A [`character`] string or vector of character
16		#' strings listing the name(s) of the aesthetic(s) that this scale works with.
17		#' @details
18		#' This qualitative color scheme is used as given (no interpolation):
19		#' colors are picked up to the maximum number of supported values (8).
20		#' @return A [discrete][ggplot2::discrete_scale] scale.
21		#' @references
22		#' Okabe, M. & Ito, K. (2008). *Color Universal Design (CUD): How to Make
23		#' Figures and Presentations That Are Friendly to Colorblind People*.
24		#' URL: \url{https://jfly.uni-koeln.de/color/}.
25		#' @example inst/examples/ex-okabeito-discrete.R
26		#' @author N. Frerebeau
27		#' @family color-blind safe color schemes
28		#' @family qualitative color schemes
29		#' @family Okabe and Ito's color scheme
30		#' @name scale_okabeito_discrete
31		#' @rdname scale_okabeito_discrete
32		NULL
33
34		#' Get Okabe and Ito's Discrete Color Scheme
35		#'
36		#' @param black_position A [`character`] string giving the position of the black
37		#' color. It must be one of "`first`" or "`last`". Any unambiguous substring
38		#' can be given.
39		#' @examples
40		#' get_okabeito_scale("first")
41		#' get_okabeito_scale("last")
42		#' @keywords internal
43		#' @noRd
44		get_okabeito_scale <- function(black_position = c("first", "last")) {
45	28x	black_position <- match.arg(black_position, several.ok = FALSE)
46	6x	switch (black_position, first = "okabeito", last = "okabeitoblack")
47		}
48
49		#' @export
50		#' @rdname scale_okabeito_discrete
51		scale_colour_okabeito <- function(..., reverse = FALSE,
52		black_position = c("first", "last"),
53		aesthetics = "colour") {
54	14x	oi_palette <- get_okabeito_scale(black_position)
55	14x	scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
56		}
57
58		#' @export
59		#' @rdname scale_okabeito_discrete
60		scale_color_okabeito <- scale_colour_okabeito
61
62		#' @export
63		#' @rdname scale_okabeito_discrete
64		scale_fill_okabeito <- function(..., reverse = FALSE,
65		black_position = c("first", "last"),
66		aesthetics = "fill") {
67	3x	oi_palette <- get_okabeito_scale(black_position)
68	3x	scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
69		}
70
71		#' @export
72		#' @rdname scale_okabeito_discrete
73		scale_edge_colour_okabeito <- function(..., reverse = FALSE,
74		black_position = c("first", "last"),
75		aesthetics = "edge_colour") {
76	8x	oi_palette <- get_okabeito_scale(black_position)
77	8x	scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
78		}
79
80		#' @export
81		#' @rdname scale_okabeito_discrete
82		scale_edge_color_okabeito <- scale_edge_colour_okabeito
83
84		#' @export
85		#' @rdname scale_okabeito_discrete
86		scale_edge_fill_okabeito <- function(..., reverse = FALSE,
87		black_position = c("first", "last"),
88		aesthetics = "edge_fill") {
89	3x	oi_palette <- get_okabeito_scale(black_position)
90	3x	scale_discrete(aesthetics, oi_palette, reverse = reverse, ...)
91		}

1		#' Simulate Color-Blindness
2		#'
3		#' @param x A palette [`function`] that when called with a single
4		#' integer argument (the number of levels) returns a vector of colors
5		#' (see [color()]).
6		#' @param mode A [`character`] string giving the colorblind vision
7		#' to be used. It must be one of "`deuteranopia`", "`protanopia`",
8		#' "`tritanopia`" or "`achromatopsia`". Any unambiguous substring can be given.
9		#' @return
10		#' A palette [`function`] that returns a vector of anomalized
11		#' colors. All the attributes of the initial palette function are inherited,
12		#' with a supplementary attribute "`mode`" giving the corresponding
13		#' color-blind vision.
14		#' @example inst/examples/ex-change.R
15		#' @references
16		#' Brettel, H., Viénot, F. and Mollon, J. D. (1997). Computerized Simulation of
17		#' Color Appearance for Dichromats. *Journal of the Optical Society of America
18		#' A*, 14(10), p. 2647-2655. \doi{10.1364/JOSAA.14.002647}.
19		#'
20		#' Tol, P. (2018). Colour Schemes. SRON. Technical Note No.
21		#' SRON/EPS/TN/09-002, issue 3.1.
22		#' URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
23		#'
24		#' Viénot, F., Brettel, H. and Mollon, J. D. (1999). Digital Video
25		#' Colourmaps for Checking the Legibility of Displays by Dichromats.
26		#' Color Research & Application, 24(4), p. 243-52.
27		#' \doi{10.1002/(SICI)1520-6378(199908)24:4<243::AID-COL5>3.0.CO;2-3}.
28		#' @author N. Frerebeau
29		#' @family diagnostic tools
30		#' @export
31		change <- function(x, mode) {
32	4x	fun <- function(n) { anomalize(x(n), mode = mode) }
33	4x	attributes(fun) <- attributes(x)
34	4x	attr(fun, "mode") <- mode
35	4x	fun
36		}
37
38		#' Anomalize
39		#'
40		#' @param x A [`character`] vector of color codes.
41		#' @param mode A [`character`] string giving the colorblind vision
42		#' to be used. It must be one of "`deuteranopia`", "`protanopia`",
43		#' "`tritanopia`" or "`achromatopsia`". Any unambiguous substring can be given.
44		#' @return A [`character`] vector of color codes.
45		#' @author N. Frerebeau
46		#' @keywords internal
47		#' @noRd
48		anomalize <- function(x, mode = c("deuteranopia", "protanopia", "tritanopia",
49		"achromatopsia")) {
50		# Validation
51	8x	mode <- match.arg(mode, several.ok = FALSE)
52
53		# Convert to RGB color code
54	8x	RGB1 <- t(grDevices::col2rgb(x, alpha = FALSE))
55
56		# Dichromat
57	8x	S <- switch (
58	8x	mode,
59		# Green-blindness
60	8x	deuteranopia = rbind(
61		# Red, Green, Blue
62	8x	c(1, 0, 0),
63	8x	c(0.9513092, 0, 0.04866992),
64	8x	c(0, 0, 1)
65		),
66		# Red-blindness
67	8x	protanopia = rbind(
68		# Red, Green, Blue
69	8x	c(0, 1.05118294, -0.05116099),
70	8x	c(0, 1, 0),
71	8x	c(0, 0, 1)
72		),
73		# Blue-blindness
74	8x	tritanopia = rbind(
75		# Red, Green, Blue
76	8x	c(1, 0, 0),
77	8x	c(0, 1, 0),
78	8x	c(-0.86744736, 1.86727089, 0)
79		),
80		# Achromatopsia
81	8x	achromatopsia = rbind(
82		# Red, Green, Blue
83	8x	c(0, 0, 1),
84	8x	c(0, 0, 1),
85	8x	c(0, 0, 1)
86		)
87		)
88
89		# Convert colors from the RGB color space to the LMS color space
90		# RGB_to_LMS <- .XYZ_to_LMS %*% .sRGB_to_XYZ
91		# RGB2 <- solve(RGB_to_LMS) %% S %% RGB_to_LMS %*% RGB1
92
93		# Conversion
94	8x	LMS <- RGB2LMS(RGB1) %*% t(S)
95	8x	RGB2 <- LMS2RGB(LMS)
96
97		# RGB constraints
98	8x	for (i in 1:nrow(RGB2)) {
99	56x	RGB2[i, ] <- pmin(RGB2[i, ], rep(255, 3))
100	56x	RGB2[i, ] <- pmax(RGB2[i, ], rep(0, 3))
101		}
102
103		# Convert to Hex color code
104	8x	grDevices::rgb(RGB2, names = names(x), maxColorValue = 255)
105		}
106
107		# Color Conversion
108
109		#' CMYK to/from RGB Color Conversion
110		#'
111		#' @param cyan,magenta,yellow,black,red,blue,green A [`numeric`] vector with
112		#' values in \eqn{[0, max]}.
113		#' @param max A [`numeric`] value giving the maximum of the color values range.
114		#' @return An integer matrix with three or four columns.
115		#' @author N. Frerebeau
116		#' @keywords internal
117		#' @noRd
118		NULL
119
120		CMYK2RGB <- function(cyan, magenta, yellow, black, max = 1) {
121	4x	if (missing(magenta) && missing(yellow) && missing(black)) {
122	1x	if (is.matrix(cyan) \|\| is.data.frame(cyan)) {
123	!	if (ncol(cyan) < 4L) stop("At least 4 columns needed.", call. = FALSE)
124	1x	cyan <- data.matrix(cyan)
125	1x	CMY <- cyan[, -4]
126	1x	black <- cyan[, 4]
127		}
128		} else {
129	3x	CMY <- cbind(cyan, magenta, yellow)
130		}
131	4x	CMY <- CMY / max
132	4x	K <- black / max
133
134	4x	RGB <- 255 * (1 - CMY) * (1 - K)
135	4x	colnames(RGB) <- c("R", "G", "B")
136	4x	return(RGB)
137		}
138
139		RGB2CMYB <- function(red, green, blue, max = 255) {
140	4x	if (missing(green) && missing(blue)) {
141	1x	if (is.matrix(red) \|\| is.data.frame(red)) {
142	!	if (ncol(red) < 3L) stop("At least 3 columns needed.", call. = FALSE)
143	1x	RGB <- data.matrix(red)
144		}
145		} else {
146	3x	RGB <- cbind(red, green, blue)
147		}
148	4x	RGB <- RGB / max
149	4x	K <- 1 - apply(X = RGB, MARGIN = 1, FUN = max)
150	4x	CMY <- (1 - RGB - K) / (1 - K)
151	4x	CMYK <- cbind(CMY, K)
152	4x	CMYK[is.na(CMYK)] <- 0 # Fix zero division
153	4x	colnames(CMYK) <- c("C", "M", "Y", "K")
154	4x	return(CMYK)
155		}
156
157		#' RGB to/from XYZ Color Conversion
158		#'
159		#' @param red,blue,green A [`numeric`] vector with values in \eqn{[0, max]}.
160		#' @param x,y,z A [`numeric`] vector of color coordinates.
161		#' @param max A [`numeric`] value giving the maximum of the color values range.
162		#' @return A numeric matrix with three columns.
163		#' @author N. Frerebeau
164		#' @keywords internal
165		#' @noRd
166		NULL
167
168		gamma_expand <- function(RGB) {
169	13x	u <- RGB > 0.04045
170	13x	sRGB <- RGB / 12.92
171	13x	sRGB[u] <- ((200 * RGB[u] + 11) / 211)^(12 / 5)
172	13x	return(sRGB)
173		}
174		gamma_compress <- function(sRGB) {
175	12x	u <- sRGB > 0.0031308
176	12x	RGB <- sRGB * 12.92
177	12x	RGB[u] <- (211 * sRGB[u]^(5 / 12) - 11) / 200
178	12x	return(RGB)
179		}
180
181		XYZ2RGB <- function(x, y, z, max_rgb = 255) {
182	4x	if (missing(y) && missing(z)) {
183	1x	if (is.matrix(x) \|\| is.data.frame(x)) {
184	!	if (ncol(x) < 3L) stop("At least 3 columns needed.", call. = FALSE)
185	1x	XYZ <- data.matrix(x)
186		}
187		} else {
188	3x	XYZ <- cbind(x, y, z)
189		}
190	4x	sRGB <- XYZ %*% t(.XYZ_to_sRGB)
191	4x	colnames(sRGB) <- c("R", "G", "B")
192
193		# gamma-compressed values
194	4x	RGB <- gamma_compress(sRGB)
195
196	4x	return(RGB * max_rgb)
197		}
198
199		RGB2XYZ <- function(red, green, blue, max_rgb = 255) {
200	5x	if (missing(green) && missing(blue)) {
201	2x	if (is.matrix(red) \|\| is.data.frame(red)) {
202	!	if (ncol(red) < 3L) stop("At least 3 columns needed.", call. = FALSE)
203	2x	RGB <- data.matrix(red)
204		}
205		} else {
206	3x	RGB <- cbind(red, green, blue)
207		}
208	5x	RGB <- RGB / max_rgb
209
210		# gamma-expanded values
211	5x	sRGB <- gamma_expand(RGB)
212
213	5x	XYZ <- sRGB %*% t(.sRGB_to_XYZ)
214	5x	colnames(XYZ) <- c("X", "Y", "Z")
215	5x	return(XYZ)
216		}
217
218		#' RGB to/from LMS Lab Color Conversion
219		#'
220		#' @param red,blue,green A [`numeric`] vector with values in \eqn{[0, max]}.
221		#' @param max A [`numeric`] value giving the maximum of the color values range.
222		#' @return A numeric matrix with three rows.
223		#' @author N. Frerebeau
224		#' @keywords internal
225		#' @noRd
226		NULL
227
228		RGB2LMS <- function(red, green, blue, max = 255) {
229	8x	if (missing(green) && missing(blue)) {
230	8x	if (is.matrix(red) \|\| is.data.frame(red)) {
231	!	if (ncol(red) < 3L) stop("At least 3 columns needed.", call. = FALSE)
232	8x	RGB <- data.matrix(red)
233		}
234		} else {
235	!	RGB <- cbind(red, green, blue)
236		}
237	8x	RGB <- RGB / max
238
239		# gamma-expanded values
240	8x	sRGB <- gamma_expand(RGB)
241
242	8x	LMS <- sRGB %% t(.XYZ_to_LMS %% .sRGB_to_XYZ)
243	8x	colnames(LMS) <- c("L", "M", "S")
244	8x	return(LMS)
245		}
246
247		LMS2RGB <- function(long, medium, short, max = 255) {
248	8x	if (missing(medium) && missing(short)) {
249	8x	if (is.matrix(long) \|\| is.data.frame(long)) {
250	!	if (ncol(long) < 3L) stop("At least 3 columns needed.", call. = FALSE)
251	8x	LMS <- data.matrix(long)
252		}
253		} else {
254	!	LMS <- cbind(long, medium, short)
255		}
256
257	8x	sRGB <- LMS %% t(solve(.XYZ_to_LMS %% .sRGB_to_XYZ))
258	8x	colnames(sRGB) <- c("R", "G", "B")
259
260		# gamma-compressed values
261	8x	RGB <- gamma_compress(sRGB)
262
263	8x	return(RGB * max)
264		}
265
266		#' XYZ to CIE Lab Color Conversion
267		#'
268		#' @param x,y,z A [`numeric`] vector of color coordinates.
269		#' @param white A length-three [`numeric`] vector giving a reference white
270		#' coordinates (default to D65).
271		#' @return A numeric matrix with three columns.
272		#' @author N. Frerebeau
273		#' @keywords internal
274		#' @noRd
275		NULL
276
277		XYZ2Lab <- function(x, y, z, white = c(x = 0.95047, y = 1.00000, z = 1.08883)) {
278	1x	if (missing(y) && missing(z)) {
279	1x	if (is.matrix(x) \|\| is.data.frame(x)) {
280	!	if (ncol(x) < 3L) stop("At least 3 columns needed.", call. = FALSE)
281	1x	XYZ <- data.matrix(x)
282	1x	x <- XYZ[, 1]
283	1x	y <- XYZ[, 2]
284	1x	z <- XYZ[, 3]
285		}
286		}
287
288		# Actual CIE standards
289	1x	f <- function(a, e = 0.008856, k = 903.3) {
290	5x	a_e <- a <= e
291	5x	b <- a^(1/3)
292	5x	b[a_e] <- (k * a[a_e] + 16) / 116
293	5x	b
294		}
295
296	1x	x <- x / white[[1L]]
297	1x	y <- y / white[[2L]]
298	1x	z <- z / white[[3L]]
299
300	1x	Lab <- cbind(
301	1x	L = 116 * f(y) - 16,
302	1x	a = 500 * (f(x) - f(y)),
303	1x	b = 200 * (f(y) - f(z))
304		)
305	1x	return(Lab)
306		}

1		# PALETTES
2
3		# Palettes =====================================================================
4		## Color -----------------------------------------------------------------------
5		#' Color Mapping
6		#'
7		#' Maps values to colors.
8		#' @param scheme A [`character`] string giving the name of the scheme to be
9		#' used (see [color()]).
10		#' @param domain A [`numeric`] range or a vector of categorical data specifying
11		#' the possible values that can be mapped.
12		#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
13		#' input range.
14		#' @param ordered A [`logical`] scalar: should the levels be treated as already
15		#' in the correct order?
16		#' @param missing The color to return for `NA` values.
17		#' @param ... Further parameters to be passed to [color()].
18		#' @details
19		#' A wrapper around `palette_color_continuous()` and
20		#' `palette_color_discrete()`.
21		#' @return
22		#' A palette [`function`] that when called with a single argument returns
23		#' a [`character`] vector of colors.
24		#' @example inst/examples/ex-palette-color.R
25		#' @family palettes
26		#' @export
27		palette_color_picker <- function(scheme, domain = NULL, midpoint = NULL,
28		ordered = FALSE, missing = NULL, ...) {
29
30	6x	scheme <- color(scheme, ...)
31	6x	col <- scheme()
32	6x	miss <- missing %\|\|% attr(scheme, "missing")
33	3x	if (is.na(miss)) miss <- "#DDDDDD"
34
35	6x	quali <- attr(scheme, "type") == "qualitative"
36	6x	if (quali) {
37	3x	fun <- palette_color_discrete(
38	3x	colors = col,
39	3x	domain = domain,
40	3x	ordered = ordered,
41	3x	missing = miss
42		)
43		} else {
44	3x	fun <- palette_color_continuous(
45	3x	colors = col,
46	3x	domain = domain,
47	3x	midpoint = midpoint,
48	3x	missing = miss
49		)
50		}
51
52	6x	fun
53		}
54
55		#' @export
56		#' @rdname palette_color_picker
57		palette_colour_picker <- palette_color_picker
58
59		#' Color Mapping (continuous)
60		#'
61		#' Maps continuous values to an interpolated colors gradient.
62		#' @param colors A vector of colors or a [`function`] that when called with a
63		#' single argument (an integer specifying the number of colors) returns a
64		#' vector of colors. If `NULL` (the default), uses YlOrRd.
65		#' @param domain A [`numeric`] range specifying the possible values that can be
66		#' mapped.
67		#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
68		#' input range.
69		#' @param missing The color to return for `NA` values.
70		#' @return
71		#' A palette [`function`] that when called with a single argument
72		#' (a [`numeric`] vector of continuous values) returns a [`character`] vector
73		#' of colors.
74		#' @seealso [grDevices::colorRamp()]
75		#' @example inst/examples/ex-palette-continuous.R
76		#' @family palettes
77		#' @export
78		palette_color_continuous <- function(colors = NULL, domain = NULL,
79		midpoint = NULL, missing = "#DDDDDD") {
80
81	14x	force(colors)
82	14x	force(domain)
83	14x	force(midpoint)
84	14x	force(missing)
85
86	14x	function(x, ...) {
87	14x	need_continuous(x)
88
89	12x	rng <- if (!is.null(domain)) range(domain, finite = TRUE) else range(x, finite = TRUE)
90	12x	if (!is.null(midpoint) && is.numeric(midpoint)) {
91	1x	x <- scale_midpoint(x, to = c(0, 1), from = rng, midpoint = midpoint)
92		} else {
93	11x	x <- scale_range(x, to = c(0, 1), from = rng)
94		}
95
96	12x	out <- x < 0 \| x > 1
97	12x	if (any(out, na.rm = TRUE)) {
98	2x	x[out] <- NA
99	2x	warning(tr_("Some values were outside the color scale."), call. = FALSE)
100		}
101
102	12x	OK <- !is.na(x)
103	12x	if (is.null(colors)) {
104	1x	colors <- color(palette = "YlOrBr")(9)
105		}
106	12x	if (is.function(colors)) {
107	1x	colors <- colors(9)
108		}
109	12x	colors <- grDevices::colorRamp(colors)(x[OK], ...)
110
111	12x	col <- rep(missing, length(x))
112	12x	col[OK] <- grDevices::rgb(colors, maxColorValue = 255)
113	12x	col
114		}
115		}
116
117		#' @export
118		#' @rdname palette_color_continuous
119		palette_colour_continuous <- palette_color_continuous
120
121		#' Color Mapping (discrete)
122		#'
123		#' Maps categorical values to colors.
124		#' @param colors A vector of colors or a [`function`] that when called with a
125		#' single argument (an integer specifying the number of colors) returns a
126		#' vector of colors. If `NULL` (the default), uses discrete rainbow.
127		#' @param domain A vector of categorical data specifying the possible values
128		#' that can be mapped.
129		#' @param ordered A [`logical`] scalar: should the levels be treated as already
130		#' in the correct order?
131		#' @param missing The color to return for `NA` values.
132		#' @return
133		#' A palette [`function`] that when called with a single argument
134		#' (a vector of categorical values) returns a [`character`] vector of colors.
135		#' @example inst/examples/ex-palette-discrete.R
136		#' @family palettes
137		#' @export
138		palette_color_discrete <- function(colors = NULL, domain = NULL,
139		ordered = FALSE, missing = "#DDDDDD") {
140
141	15x	force(colors)
142	15x	force(domain)
143	15x	force(ordered)
144	15x	force(missing)
145
146		## If named colors, override user settings
147	15x	if (!is.null(names(colors))) {
148	1x	domain <- names(colors)
149	1x	ordered <- TRUE
150		}
151
152	15x	function(x, ...) {
153	15x	need_discrete(x)
154
155	15x	domain <- make_levels(x, levels = domain, ordered = ordered)
156	15x	n <- length(domain)
157	15x	x <- match(as.character(x), domain)
158
159	15x	OK <- !is.na(x)
160	15x	if (is.null(colors)) {
161	2x	colors <- color(palette = "discreterainbow")(n)
162		}
163	15x	if (is.function(colors)) {
164	1x	colors <- colors(n)
165		}
166
167	15x	if (length(colors) < n) {
168	3x	msg <- tr_("Only %d colors were specified (%d are required).")
169	3x	warning(sprintf(msg, length(colors), n), call. = FALSE)
170		}
171	15x	col <- colors[x]
172	15x	col[!OK] <- missing
173	15x	col
174		}
175		}
176
177		#' @export
178		#' @rdname palette_color_discrete
179		palette_colour_discrete <- palette_color_discrete
180
181		## Symbol ----------------------------------------------------------------------
182		#' Symbol Mapping
183		#'
184		#' @param symbols,types A vector of symbols or line types.
185		#' @param domain A vector of categorical data specifying the possible values
186		#' that can be mapped.
187		#' @param ordered A [`logical`] scalar: should the levels be treated as already
188		#' in the correct order?
189		#' @param ... Currently not used.
190		#' @return
191		#' A palette [`function`] that when called with a single argument
192		#' (a [`character`] vector of categorical values) returns a vector of symbols.
193		#' @example inst/examples/ex-palette-discrete.R
194		#' @family palettes
195		#' @export
196		palette_shape <- function(symbols = NULL, domain = NULL, ordered = FALSE, ...) {
197
198	9x	force(symbols)
199	9x	force(domain)
200	9x	force(ordered)
201
202		## If named symbol, override user settings
203	9x	if (!is.null(names(symbols))) {
204	1x	domain <- names(symbols)
205	1x	ordered <- TRUE
206		}
207
208	9x	function(x) {
209	9x	need_discrete(x)
210
211	9x	domain <- make_levels(x, levels = domain, ordered = ordered)
212	9x	x <- match(as.character(x), domain)
213
214	9x	if (is.null(symbols)) {
215	4x	n <- length(domain)
216	4x	if (n > 6) {
217	1x	warning(tr_("Consider specifying symbols manually: "),
218	1x	tr_("more than 6 becomes difficult to discriminate."),
219	1x	call. = FALSE)
220		}
221	4x	symbols <- c(16, 17, 15, 3, 7, 8)[seq_len(n)]
222		}
223	9x	symbols[x]
224		}
225		}
226
227		#' @export
228		#' @rdname palette_shape
229		palette_line <- function(types = NULL, domain = NULL, ordered = FALSE, ...) {
230	!	if (is.null(types)) {
231	!	types <- c("solid", "22", "42", "44", "13", "1343", "73", "2262",
232	!	"12223242", "F282", "F4448444", "224282F2", "F1")
233		}
234	!	palette_shape(symbols = types, domain = domain, ordered = ordered, ...)
235		}
236
237		## Size ------------------------------------------------------------------------
238		#' Symbol Size Mapping
239		#'
240		#' @param range A length-two [`numeric`] vector giving range of possible sizes
241		#' (greater than 0).
242		#' @param midpoint A length-one [`numeric`] vector specifying the data mid-point.
243		#' @param ... Currently not used.
244		#' @return
245		#' A palette [`function`] that when called with a single argument
246		#' (a [`numeric`] vector of continuous values) returns a [`numeric`] vector
247		#' giving the amount by which plotting text and symbols should be magnified
248		#' relative to the default.
249		#' @example inst/examples/ex-palette-continuous.R
250		#' @family palettes
251		#' @name palette_size
252		#' @rdname palette_size
253		NULL
254
255		#' @export
256		#' @rdname palette_size
257		palette_size_sequential <- function(range = c(1, 6), ...) {
258
259	6x	force(range)
260
261	6x	function(x) {
262	6x	need_continuous(x)
263	5x	x <- scale_range(x)
264	5x	scale_range(sqrt(x), to = range(range, na.rm = TRUE))
265		}
266		}
267
268		#' @export
269		#' @rdname palette_size
270		palette_size_diverging <- function(range = c(1, 6), midpoint = 0, ...) {
271
272	2x	force(range)
273	2x	force(midpoint)
274
275	2x	function(x) {
276	2x	need_continuous(x)
277	1x	x <- scale_midpoint(abs(x), midpoint = midpoint)
278	1x	scale_range(sqrt(x), to = range(range, na.rm = TRUE))
279		}
280		}
281
282		# Scales =======================================================================
283		#' Rescale Continuous Vector (minimum, maximum)
284		#'
285		#' Rescales continuous vector to have specified minimum and maximum.
286		#' @param x A [`numeric`] vector.
287		#' @param to A length-two [`numeric`] vector specifying the output range.
288		#' @param from A length-two [`numeric`] vector specifying the input range.
289		#' @return A [`numeric`] vector.
290		#' @family scales
291		#' @keywords internal
292		#' @noRd
293		scale_range <- function(x, to = c(0, 1), from = range(x, finite = TRUE)) {
294	1x	if (is_zero(to) \|\| is_zero(from)) return(ifelse(is.na(x), NA, mean(to)))
295	25x	(x - from[1L]) / diff(from) * diff(to) + to[1L]
296		}
297
298		#' Rescale Continuous Vector (minimum, midpoint, maximum)
299		#'
300		#' Rescales continuous vector to have specified minimum, midpoint and maximum.
301		#' @param x A [`numeric`] vector.
302		#' @param to A length-two [`numeric`] vector specifying the output range.
303		#' @param from A length-two [`numeric`] vector specifying the input range.
304		#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of
305		#' input range.
306		#' @return A [`numeric`] vector.
307		#' @family scales
308		#' @keywords internal
309		#' @noRd
310		scale_midpoint <- function(x, to = c(0, 1), from = range(x, finite = TRUE),
311		midpoint = 0) {
312	!	if (is_zero(to) \|\| is_zero(from)) return(ifelse(is.na(x), NA, mean(to)))
313	4x	extent <- 2 * max(abs(from - midpoint))
314	4x	(x - midpoint) / extent * diff(to) + mean(to)
315		}
316
317		# Helpers ======================================================================
318		need_continuous <- function(x) {
319	22x	if (!is.numeric(x)) {
320	4x	stop(tr_("Discrete value supplied to continuous scale."), call. = FALSE)
321		}
322	18x	invisible(x)
323		}
324
325		need_discrete <- function(x) {
326	24x	if (is.double(x)) {
327	2x	warning(tr_("Continuous value supplied to discrete scale."), call. = FALSE)
328		}
329	24x	invisible(x)
330		}
331
332		is_zero <- function(x, tolerance = sqrt(.Machine$double.eps)) {
333	59x	diff(range(x)) <= tolerance
334		}
335
336		make_levels <- function(x, levels = NULL, ordered = FALSE) {
337	12x	if (!is.null(levels)) return(make_levels(x = levels, ordered = ordered))
338
339	!	if (is.null(x)) levels <- NULL
340	!	else if (is.factor(x)) levels <- levels(x)
341	4x	else if (ordered) levels <- unique(x)
342	20x	else levels <- sort(unique(x))
343	24x	levels
344		}

1		#' @include color.R
2		NULL
3
4		# Geologic Timescale ===========================================================
5		#' Geologic Timescale Color Scheme for \pkg{ggplot2} and \pkg{ggraph}
6		#'
7		#' Provides the geologic timescale color scheme.
8		#' @param ... Arguments passed on to [ggplot2::discrete_scale()].
9		#' @param lang A [`character`] string specifying the language for the
10		#' color names (see details). It must be one of "`en`" (english, the
11		#' default), "`fr`" (french) or `NULL`. If not `NULL`, the values will be
12		#' matched based on the color names.
13		#' @param aesthetics A [`character`] string or vector of character
14		#' strings listing the name(s) of the aesthetic(s) that this scale works with.
15		#' @details Values will be matched based on the geological unit names.
16		#' @return A [discrete][ggplot2::discrete_scale] scale.
17		#' @references
18		#' \href{https://ccgm.org/}{Commission for the Geological Map of the World}.
19		#' @example inst/examples/ex-science-stratigraphy.R
20		#' @author N. Frerebeau
21		#' @family themed color schemes
22		#' @family qualitative color schemes
23		#' @export
24		#' @rdname scale_stratigraphy
25		scale_colour_stratigraphy <- function(..., lang = "en", aesthetics = "colour") {
26		# Get palette
27	5x	color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
28		# Build scale
29	5x	ggplot2::scale_color_manual(..., values = color_palette(175),
30	5x	aesthetics = aesthetics)
31		}
32
33		#' @export
34		#' @rdname scale_stratigraphy
35		scale_color_stratigraphy <- scale_colour_stratigraphy
36
37		#' @export
38		#' @rdname scale_stratigraphy
39		scale_fill_stratigraphy <- function(..., lang = "en", aesthetics = "fill") {
40		# Get palette
41	3x	color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
42		# Build scale
43	3x	ggplot2::scale_fill_manual(..., values = color_palette(175),
44	3x	aesthetics = aesthetics)
45		}
46
47		#' @export
48		#' @rdname scale_stratigraphy
49		scale_edge_colour_stratigraphy <- function(..., lang = "en") {
50		# Get palette
51	5x	color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
52		# Build scale
53	5x	ggraph::scale_edge_colour_manual(..., values = color_palette(175))
54		}
55
56		#' @export
57		#' @rdname scale_stratigraphy
58		scale_edge_color_stratigraphy <- scale_edge_colour_stratigraphy
59
60		#' @export
61		#' @rdname scale_stratigraphy
62		scale_edge_fill_stratigraphy <- function(..., lang = "en") {
63		# Get palette
64	3x	color_palette <- color("stratigraphy", names = !is.null(lang), lang = lang)
65		# Build scale
66	3x	ggraph::scale_edge_fill_manual(..., values = color_palette(175))
67		}
68
69		# Land =========================================================================
70		#' AVHRR Global Land Cover Classification Color Scheme for \pkg{ggplot2}
71		#' and \pkg{ggraph}
72		#'
73		#' Provides the AVHRR Global Land Cover classification as modified by
74		#' Paul Tol (colorblind safe).
75		#' @param ... Arguments passed on to [ggplot2::discrete_scale()].
76		#' @param lang A [`character`] string specifying the language for the
77		#' color names (see details). It must be one of "`en`" (english, the
78		#' default), "`fr`" (french) or `NULL`. If not `NULL`, the values will be
79		#' matched based on the color names.
80		#' @param aesthetics A [`character`] string or vector of character
81		#' strings listing the name(s) of the aesthetic(s) that this scale works with.
82		#' @details Values will be matched based on the land classification names.
83		#' @return A [discrete][ggplot2::discrete_scale] scale.
84		#' @references
85		#' Tol, P. (2018). Colour Schemes. SRON. Technical Note No.
86		#' SRON/EPS/TN/09-002, issue 3.1.
87		#' URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
88		#' @example inst/examples/ex-science-land.R
89		#' @author N. Frerebeau
90		#' @family themed color schemes
91		#' @family qualitative color schemes
92		#' @export
93		#' @rdname scale_land
94		scale_colour_land <- function(..., lang = "en", aesthetics = "colour") {
95		# Get palette
96	5x	color_palette <- color("land", names = !is.null(lang), lang = lang)
97		# Build scale
98	5x	ggplot2::scale_color_manual(..., values = color_palette(14),
99	5x	aesthetics = aesthetics)
100		}
101
102		#' @export
103		#' @rdname scale_land
104		scale_color_land <- scale_colour_land
105
106		#' @export
107		#' @rdname scale_land
108		scale_fill_land <- function(..., lang = "en", aesthetics = "fill") {
109		# Get palette
110	3x	color_palette <- color("land", names = !is.null(lang), lang = lang)
111		# Build scale
112	3x	ggplot2::scale_fill_manual(..., values = color_palette(14),
113	3x	aesthetics = aesthetics)
114		}
115
116		#' @export
117		#' @rdname scale_land
118		scale_edge_colour_land <- function(..., lang = "en") {
119		# Get palette
120	5x	color_palette <- color("land", names = !is.null(lang), lang = lang)
121		# Build scale
122	5x	ggraph::scale_edge_colour_manual(..., values = color_palette(14))
123		}
124
125		#' @export
126		#' @rdname scale_land
127		scale_edge_color_land <- scale_edge_colour_land
128
129		#' @export
130		#' @rdname scale_land
131		scale_edge_fill_land <- function(..., lang = "en") {
132		# Get palette
133	3x	color_palette <- color("land", names = !is.null(lang), lang = lang)
134		# Build scale
135	3x	ggraph::scale_edge_fill_manual(..., values = color_palette(14))
136		}
137
138		# Soil =========================================================================
139		#' FAO Soil Reference Groups Color Scheme for \pkg{ggplot2} and \pkg{ggraph}
140		#'
141		#' Provides the FAO Soil Reference Groups color scheme.
142		#' @param ... Arguments passed on to [ggplot2::discrete_scale()].
143		#' @param lang A [`character`] string specifying the language for the
144		#' color names (see details). It must be one of "`en`" (english, the
145		#' default), "`fr`" (french) or `NULL`. If not `NULL`, the values will be
146		#' matched based on the color names.
147		#' @param aesthetics A [`character`] string or vector of character
148		#' strings listing the name(s) of the aesthetic(s) that this scale works with.
149		#' @details Values will be matched based on the soil names.
150		#' @references
151		#' Jones, A., Montanarella, L. & Jones, R. (Ed.) (2005). *Soil atlas of
152		#' Europe*. Luxembourg: European Commission, Office for Official Publications
153		#' of the European Communities. 128 pp. ISBN: 92-894-8120-X.
154		#' @return A [discrete][ggplot2::discrete_scale] scale.
155		#' @example inst/examples/ex-science-soil.R
156		#' @author N. Frerebeau
157		#' @family themed color schemes
158		#' @family qualitative color schemes
159		#' @export
160		#' @rdname scale_soil
161		scale_colour_soil <- function(..., lang = "en", aesthetics = "colour") {
162		# Get palette
163	5x	color_palette <- color("soil", names = !is.null(lang), lang = lang)
164		# Build scale
165	5x	ggplot2::scale_color_manual(..., values = color_palette(24),
166	5x	aesthetics = aesthetics)
167		}
168
169		#' @export
170		#' @rdname scale_soil
171		scale_color_soil <- scale_colour_soil
172
173		#' @export
174		#' @rdname scale_soil
175		scale_fill_soil <- function(..., lang = "en", aesthetics = "fill") {
176		# Get palette
177	3x	color_palette <- color("soil", names = !is.null(lang), lang = lang)
178		# Build scale
179	3x	ggplot2::scale_fill_manual(..., values = color_palette(24),
180	3x	aesthetics = aesthetics)
181		}
182
183		#' @export
184		#' @rdname scale_soil
185		scale_edge_colour_soil <- function(..., lang = "en") {
186		# Get palette
187	5x	color_palette <- color("soil", names = !is.null(lang), lang = lang)
188		# Build scale
189	5x	ggraph::scale_edge_colour_manual(..., values = color_palette(24))
190		}
191
192		#' @export
193		#' @rdname scale_soil
194		scale_edge_color_soil <- scale_edge_colour_soil
195
196		#' @export
197		#' @rdname scale_soil
198		scale_edge_fill_soil <- function(..., lang = "en") {
199		# Get palette
200	3x	color_palette <- color("soil", names = !is.null(lang), lang = lang)
201		# Build scale
202	3x	ggraph::scale_edge_fill_manual(..., values = color_palette(24))
203		}

1		#' Plot Color Scheme
2		#'
3		#' Shows colors in a plot.
4		#' @param x A [`character`] vector of colors.
5		#' @param colours A [`logical`] scalar: should the hexadecimal representation of
6		#' the colors be displayed?
7		#' @param names A [`logical`] scalar: should the name of the colors be
8		#' displayed?
9		#' @param size A [`numeric`] value giving the amount by which plotting text
10		#' should be magnified relative to the default. Works the same as `cex`
11		#' parameter of [graphics::par()].
12		#' @return
13		#' `plot_scheme()` is called for its side-effects: it results in a graphic
14		#' being displayed (invisibly returns `x`).
15		#' @example inst/examples/ex-plot.R
16		#' @author N. Frerebeau
17		#' @family diagnostic tools
18		#' @export
19		plot_scheme <- function(x, colours = FALSE, names = FALSE, size = 1) {
20		# Validation
21	5x	assert_color(x)
22
23		# Save and restore graphical parameters
24	4x	old_par <- graphics::par(no.readonly = TRUE)
25	4x	on.exit(graphics::par(old_par))
26
27	4x	info <- colours && names
28	4x	missing <- attr(x, "missing")
29	4x	bad_data <- !is.null(missing) && !is.na(missing)
30	4x	if (bad_data) x <- c(x, missing)
31
32	4x	n <- length(x) # Number of colors
33	4x	p <- seq(from = 1, by = 0.75, length.out = n)
34	4x	q <- 1 - 0.43 * rep(c(0, 1), length.out = n)
35
36	4x	graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
37	4x	graphics::plot(
38	4x	x = NULL, y = NULL,
39	4x	xlim = c(0.5, max(p) + 0.5 + bad_data / 2), ylim = c(0, 1.5),
40	4x	xlab = "", ylab = "", axes = FALSE, asp = 1
41		)
42
43	4x	for (i in seq_len(n - bad_data)) {
44		#even <- i %% 2 == 0
45	36x	draw_hexagon(x = p[[i]], y = q[[i]], r = 0.5, border = NULL, fill = x[[i]])
46		}
47	4x	if (bad_data) {
48	4x	draw_circle(x = p[[n]] + 0.5, y = q[[n]], r = 0.5, n = 200,
49	4x	border = NULL, fill = missing)
50		}
51	4x	delta <- ifelse(colours && names && !is.null(names(x)), 0.1, 0)
52	4x	if (colours) {
53	2x	if (bad_data) {
54	2x	graphics::text(x = p[[n]] + 0.5, y = q[[n]], labels = missing, cex = size)
55	2x	x <- utils::head(x, -1)
56	2x	p <- utils::head(p, -1)
57	2x	q <- utils::head(q, -1)
58		}
59	2x	graphics::text(x = p, y = q - delta * info, labels = x, cex = size)
60		}
61	4x	if (names && !is.null(names(x))) {
62	2x	graphics::text(x = p, y = q + delta * info, labels = names(x), cex = size)
63		}
64
65	4x	invisible(x)
66		}
67
68		draw_hexagon <- function(x = 0, y = 0, r = 0.5, border = NULL, fill = NA) {
69	36x	vertices <- seq_len(6)
70	36x	graphics::polygon(
71	36x	x = x + r * cos(vertices * 2 * pi / 6),
72	36x	y = y + r * sin(vertices * 2 * pi / 6),
73	36x	border = border,
74	36x	col = fill
75		)
76		}
77		draw_circle <- function(x = 0, y = 0, r = 0.5, n = 200,
78		border = NULL, fill = NA) {
79	4x	theta <- seq(0, 2 * pi, length.out = n)
80	4x	graphics::polygon(
81	4x	x = r * cos(theta) + x,
82	4x	y = r * sin(theta) + y,
83	4x	border = border,
84	4x	col = fill
85		)
86		}

1		#' Color Schemes
2		#'
3		#' Provides qualitative, diverging and sequential color schemes.
4		#' @param palette A [`character`] string giving the name of the scheme to be
5		#' used (see [info()]).
6		#' @param reverse A [`logical`] scalar: should the resulting vector of colors
7		#' should be reversed?
8		#' @param names A [`logical`] scalar: should the names of the colors should be
9		#' kept in the resulting vector?
10		#' @param lang A [`character`] string specifying the language for the color
11		#' names. It must be one of "`en`" (English, the default) or "`fr`" (French).
12		#' @param force A [`logical`] scalar. If `TRUE`, forces the color scheme to be
13		#' interpolated. It should not be used routinely with qualitative color
14		#' schemes, as they are designed to be used as is to remain color-blind safe.
15		#' @param ... Further arguments passed to
16		#' [colorRampPalette][grDevices::colorRamp].
17		#' @return
18		#' A [`function`] function with the following attributes, that when called
19		#' with a single argument (an [`integer`] specifying the number of colors)
20		#' returns a (named) vector of colors.
21		#'
22		#' \describe{
23		#' \item{palette}{A [`character`] string giving the name of the
24		#' color scheme.}
25		#' \item{type}{A [`character`] string giving the corresponding
26		#' data type. One of "`qualitative`", "`diverging`" or "`sequential`".}
27		#' \item{interpolate}{A [`logical`] scalar: can the color palette be
28		#' interpolated?}
29		#' \item{missing}{A [`character`] string giving the the hexadecimal
30		#' representation of the color that should be used for `NA` values.}
31		#' \item{max}{An [`integer`] giving the maximum number of color values.
32		#' Only relevant for non-interpolated color schemes.}
33		#' }
34		#'
35		#' For color schemes that can be interpolated (diverging and sequential data),
36		#' the color range can be limited with an additional argument. `range` allows
37		#' to remove a fraction of the color domain (before being interpolated; see
38		#' examples).
39		#' @references
40		#' Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
41		#' StagLab 3.0. Geosci. Model Dev., 11, 2541-2562.
42		#' \doi{10.5194/gmd-11-2541-2018}
43		#'
44		#' Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
45		#' science communication. Nature Communications, 11, 5444.
46		#' \doi{10.1038/s41467-020-19160-7}
47		#'
48		#' Jones, A., Montanarella, L. & Jones, R. (Ed.) (2005). *Soil atlas of
49		#' Europe*. Luxembourg: European Commission, Office for Official Publications
50		#' of the European Communities. 128 pp. ISBN: 92-894-8120-X.
51		#'
52		#' Okabe, M. & Ito, K. (2008). *Color Universal Design (CUD): How to Make
53		#' Figures and Presentations That Are Friendly to Colorblind People*.
54		#' URL: \url{https://jfly.uni-koeln.de/color/}.
55		#'
56		#' Tol, P. (2021). Colour Schemes. SRON. Technical Note No.
57		#' SRON/EPS/TN/09-002, issue 3.2.
58		#' URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
59		#'
60		#' \href{https://ccgm.org/}{Commission for the Geological Map of the World}
61		#' @example inst/examples/ex-palettes.R
62		#' @author N. Frerebeau
63		#' @family color schemes
64		#' @keywords color
65		#' @export
66		colour <- function(palette, reverse = FALSE, names = FALSE, lang = "en",
67		force = FALSE, ...) {
68		## Validation
69	1771x	palette <- gsub(pattern = "[[:blank:]]", replacement = "", x = palette)
70	1771x	palette <- match.arg(palette, names(.schemes), several.ok = FALSE)
71	1771x	lang <- match.arg(lang, c("en", "fr"), several.ok = FALSE)
72
73		## Get colors
74	1771x	col_palette <- .schemes[[palette]]
75	1771x	col_colors <- col_palette[["colours"]]
76	1771x	col_names <- col_palette[["names"]][[lang]]
77	1771x	col_type <- col_palette[["type"]]
78	1771x	col_interpolate <- col_palette[["interpolate"]]
79	1771x	col_missing <- col_palette[["missing"]]
80	1771x	col_scheme <- col_palette[["scheme"]]
81	1771x	k <- col_palette[["max"]]
82
83		## Reverse color order
84	52x	if (reverse) col_colors <- rev(col_colors)
85
86	1771x	if (col_interpolate \|\| force) {
87
88		## For color schemes that can be linearly interpolated
89	1253x	fun <- function(n, range = c(0, 1)) {
90	46x	if (missing(n)) n <- k
91		# Validate
92	897x	if (any(range > 1) \|\| any(range < 0)) {
93	!	msg <- tr_("%s values must be in [0,1].")
94	!	stop(sprintf(msg, sQuote("range")), call. = FALSE)
95		}
96		# Remove starting colors
97	897x	col_colors <- utils::tail(col_colors, k * (1 - range[[1]]))
98		# Remove ending colors
99	897x	col_colors <- utils::head(col_colors, k * range[[2]])
100		# Interpolate
101	897x	col <- grDevices::colorRampPalette(col_colors)(n)
102		# Set attributes
103	897x	col <- structure(
104	897x	col,
105	897x	missing = col_missing,
106	897x	class = c("color_scheme", "color_continuous")
107		)
108	897x	return(col)
109		}
110
111		} else {
112
113		## No interpolation
114		## FIXME: add 'range = c(0, 1)' to prevent "multiple local function
115		## definitions" note in R CMD check
116	518x	fun <- function(n, range = c(0, 1)) {
117	17x	if (missing(n)) n <- k
118		# Validate
119	295x	if (n > k) {
120	15x	msg <- tr_("%s color scheme supports up to %d values.")
121	15x	stop(sprintf(msg, sQuote(palette), k), call. = FALSE)
122		}
123		# Arrange color schemes
124	280x	if (!is.null(col_scheme)) {
125	12x	m <- col_scheme[[n]]
126	12x	if (reverse) {
127	1x	m <- rev(m)
128	1x	col_colors <- rev(col_colors)
129		}
130	12x	col <- col_colors[m]
131	268x	} else if (col_type == "qualitative") {
132	268x	m <- seq_len(n)
133	268x	col <- col_colors[m]
134		} else {
135	!	m <- seq(from = 1, to = k, length.out = n)
136	!	col <- col_colors[m]
137		}
138		# Keep names?
139	196x	if (names) names(col) <- col_names[m] else col <- unname(col)
140		# Set attributes
141	280x	col <- structure(
142	280x	col,
143	280x	missing = col_missing,
144	280x	class = c("color_scheme", "color_discrete")
145		)
146	280x	return(col)
147		}
148
149		}
150		## Set attributes
151	1771x	fun <- structure(
152	1771x	fun,
153	1771x	palette = palette,
154	1771x	type = col_type,
155	1771x	missing = col_missing,
156	1771x	interpolate = col_interpolate \|\| force,
157	1771x	max = as.integer(k)
158		)
159	1771x	return(fun)
160		}
161
162		#' @export
163		#' @rdname colour
164		color <- colour

1		#' Diagnostic Map
2		#'
3		#' Produces a diagnostic map for a given color scheme.
4		#' @param x A [`character`] vector of colors.
5		#' @return
6		#' `plot_map()` is called for its side-effects: it results in a graphic
7		#' being displayed (invisibly returns `x`).
8		#' @example inst/examples/ex-plot.R
9		#' @author N. Frerebeau, V. Arel-Bundock
10		#' @family diagnostic tools
11		#' @export
12		plot_map <- function(x) {
13		# Validation
14	2x	assert_color(x)
15
16		# Save and restore graphical parameters
17	1x	old_par <- graphics::par(no.readonly = TRUE)
18	1x	on.exit(graphics::par(old_par))
19
20	1x	n <- length(x) # Number of colors
21	1x	q <- floor(100 / (n + 1))
22
23	1x	graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
24	1x	graphics::plot(
25	1x	x = NULL, y = NULL,
26	1x	xlim = c(0, (q * (n + 1) / 2) + 1), ylim = c(0, 10.5),
27	1x	xlab = "", ylab = "", axes = FALSE, asp = 1
28		)
29
30	1x	random_colors <- sample(x, size = 19 * q, replace = TRUE)
31	1x	draw_mosaic(columns = q, border = "black", fill = random_colors)
32
33	1x	for (h in seq_len(n)) {
34	7x	random_positions <- sample(seq_len(19 * q), size = n, replace = FALSE)
35	7x	unique_color <- rep(x[[h]], length.out = 19 * q)
36	7x	unique_color[random_positions] <- x
37
38	7x	draw_mosaic(columns = q, border = "black", fill = unique_color, offset = h)
39		}
40
41	1x	invisible(x)
42		}
43
44		#' Mosaic
45		#'
46		#' Draws a mosaic of diamonds.
47		#' @param rows An [`integer`] giving the number of lines.
48		#' @param columns An [`integer`] giving the number of columns.
49		#' @param border A [`character`] string giving the color to draw the
50		#' border (see \code{\link[graphics]{polygon}}).
51		#' @param fill A [`character`] string giving the color for filling
52		#' the polygon (see \code{\link[graphics]{polygon}}).
53		#' @param offset An [`numeric`] value giving the \code{x} offset from
54		#' zero of the mosaic.
55		#' @keywords internal
56		#' @noRd
57		draw_mosaic <- function(rows = 19, columns = 10, border = NULL, fill = NA,
58		offset = 0) {
59	8x	fill <- rep(fill, length.out = rows * columns)
60	8x	k <- 1
61	8x	for (i in seq_len(rows)) { # Loop over lines
62	152x	even <- i %% 2 == 0
63	152x	for (j in seq_len(columns)) { # Loop over columns
64	1824x	graphics::polygon(
65	1824x	x = c(0, 0.25, 0.5, 0.25) +
66	1824x	j * 0.5 + 0.25 * even +
67	1824x	columns * offset / 2,
68	1824x	y = c(0.5, 1, 0.5, 0) + i * 0.5,
69	1824x	border = border,
70	1824x	col = fill[[k]]
71		)
72	1824x	k <- k + 1
73		}
74		}
75		}
76
77		# draw_diamond <- function(x = 0, y = 0, width = 0.5, height = 1,
78		# border = NULL, fill = NA) {
79		# half_width <- width / 2
80		# half_height <- height / 2
81		# graphics::polygon(
82		# x = c(x - half_width, x, x + half_width, x),
83		# y = c(y, y + half_height, y, y - half_height),
84		# border = border,
85		# col = fill
86		# )
87		# }

1		# HELPERS
2
3		## https://michaelchirico.github.io/potools/articles/developers.html
4		tr_ <- function(...) {
5	31x	enc2utf8(gettext(paste0(...), domain = "R-khroma"))
6		}
7
8		`%\|\|%` <- function(x, y) {
9	2x	if (!is.null(x)) x else y
10		}
11
12		assert_package <- function(x) {
13	1199x	if (!requireNamespace(x, quietly = TRUE)) {
14	!	msg <- tr_("Package %s needed for this function to work. Please install it.")
15	!	stop(sprintf(msg, sQuote(x)), call. = FALSE)
16		}
17	1199x	invisible(NULL)
18		}
19
20		assert_color <- function(x) {
21	11x	if (!is.atomic(x) \|\| !is.character(x)) {
22	3x	msg <- tr_("%s must be a character vector of colors.")
23	3x	stop(sprintf(msg, sQuote("x")), call. = FALSE)
24		}
25	8x	invisible(NULL)
26		}

1		#' Color Difference
2		#'
3		#' Computes CIELAB distance metric.
4		#' @param x A [`character`] vector of colors.
5		#' @param metric An [`integer`] value giving the year the metric was
6		#' recommended by the CIE. It must be one of "`1976`", "`1994`", or
7		#' "`2000`" (default; see [spacesXYZ::DeltaE()]).
8		#' @param diag A [`logical`] scalar: should the diagonal of the distance matrix
9		#' be printed?
10		#' @param upper A [`logical`] scalar: should the upper triangle of the distance
11		#' matrix should be printed?
12		#' @return A [distance matrix][stats::dist].
13		#' @example inst/examples/ex-compare.R
14		#' @author N. Frerebeau
15		#' @family diagnostic tools
16		#' @export
17		compare <- function(x, metric = 2000, diag = FALSE, upper = FALSE) {
18		# Validation
19	1x	assert_package("spacesXYZ")
20	1x	assert_color(x)
21
22		# Hex to RGB
23	1x	RGB <- t(grDevices::col2rgb(x, alpha = FALSE))
24		# RGB to Lab
25	1x	Lab <- XYZ2Lab(RGB2XYZ(RGB))
26
27		# Color comparisons
28	1x	delta_E <- apply(
29	1x	X = Lab,
30	1x	MARGIN = 1,
31	1x	FUN = spacesXYZ::DeltaE,
32	1x	Lab2 = Lab,
33	1x	metric = metric[[1L]]
34		)
35
36	1x	stats::as.dist(delta_E, diag = diag, upper = upper)
37		}

1		#' Available Schemes
2		#'
3		#' Returns information about the available schemes.
4		#' @return
5		#' A [`data.frame`] with the following columns:
6		#' \describe{
7		#' \item{`palette`}{Names of palette.}
8		#' \item{`type`}{Types of schemes: sequential, diverging or qualitative.}
9		#' \item{`max`}{Maximum number of colors that are contained in each
10		#' palette. Only relevant for qualitative schemes.}
11		#' \item{`missing`}{The hexadecimal color value for mapping missing values.}
12		#' }
13		#' @example inst/examples/ex-info.R
14		#' @author N. Frerebeau
15		#' @family color schemes
16		#' @export
17		info <- function() {
18	2x	meta <- lapply(
19	2x	X = .schemes,
20	2x	FUN = function(x) {
21	114x	list(type = x$type, max = x$max, missing = x$missing)
22		}
23		)
24	2x	meta <- do.call(rbind.data.frame, meta)
25	2x	rownames(meta) <- NULL
26	2x	colnames(meta) <- c("type", "max", "missing")
27	2x	meta$palette <- names(.schemes)
28	2x	meta[, c(4, 1, 2, 3)]
29		}
30
31		# Paul Tol =====================================================================
32		#' Paul Tol's Color Schemes
33		#'
34		#' @details
35		#' The maximum number of supported colors is only relevant for the qualitative
36		#' color schemes (divergent and sequential schemes are linearly interpolated).
37		#'
38		#' \describe{
39		#' \item{Qualitative data}{`bright` (7), `high contrast` (3), `vibrant` (7),
40		#' `muted` (9), `medium contrast` (6), `pale` (6), `dark` (6), `light` (9).}
41		#' \item{Diverging data}{`sunset` (11), `nightfall` (17), `BuRd` (9),
42		#' `PRGn` (9).}
43		#' \item{Sequential data}{`YlOrBr` (9), `iridescent` (23), `incandescent`
44		#' (11), `discrete rainbow` (23), `smooth rainbow` (34).}
45		#' }
46		#' @section Qualitative Color Schemes:
47		#' The qualitative color schemes are used as given (no interpolation):
48		#' colors are picked up to the maximum number of supported values.
49		#'
50		#' \tabular{ll}{
51		#' Palette \tab Max. \cr
52		#' `bright` \tab 7 \cr
53		#' `highcontrast` \tab 3 \cr
54		#' `vibrant` \tab 7 \cr
55		#' `muted` \tab 9 \cr
56		#' `mediumcontrast` \tab 6 \cr
57		#' `pale` \tab 6 \cr
58		#' `dark` \tab 6 \cr
59		#' `light` \tab 9 \cr
60		#' }
61		#'
62		#' According to Paul Tol's technical note, the `bright`, `highcontrast`,
63		#' `vibrant` and `muted` color schemes are color-blind safe. The
64		#' `mediumcontrast` color scheme is designed for situations needing color
65		#' pairs.
66		#'
67		#' The `light` color scheme is reasonably distinct for both normal or
68		#' colorblind vision and is intended to fill labeled cells.
69		#'
70		#' The `pale` and `dark` schemes are not very distinct in either normal or
71		#' colorblind vision and should be used as a text background or to highlight
72		#' a cell in a table.
73		#'
74		#' Refer to the original document for details about the recommended uses (see
75		#' references)
76		#' @section Diverging Color Schemes:
77		#' If more colors than defined are needed from a given scheme, the color
78		#' coordinates are linearly interpolated to provide a continuous version of the
79		#' scheme.
80		#'
81		#' \tabular{lll}{
82		#' Palette \tab Max. \tab NA value \cr
83		#' `sunset` \tab 11 \tab #FFFFFF \cr
84		#' `nightfall` \tab 17 \tab #FFFFFF \cr
85		#' `BuRd` \tab 9 \tab #FFEE99 \cr
86		#' `PRGn` \tab 9 \tab #FFEE99 \cr
87		#' }
88		#'
89		#' @section Sequential Color Schemes:
90		#' If more colors than defined are needed from a given scheme, the color
91		#' coordinates are linearly interpolated to provide a continuous version of the
92		#' scheme.
93		#'
94		#' \tabular{lll}{
95		#' Palette \tab Max. \tab NA value \cr
96		#' `YlOrBr` \tab 9 \tab #888888 \cr
97		#' `iridescent` \tab 23 \tab #999999 \cr
98		#' `discreterainbow` \tab 23 \tab #777777 \cr
99		#' `smoothrainbow` \tab 34 \tab #666666 \cr
100		#' }
101		#' @section Rainbow Color Scheme:
102		#' As a general rule, ordered data should not be represented using a rainbow
103		#' scheme. There are three main arguments against such use (Tol 2018):
104		#' \itemize{
105		#' \item{The spectral order of visible light carries no inherent magnitude
106		#' message.}
107		#' \item{Some bands of almost constant hue with sharp transitions between
108		#' them, can be perceived as jumps in the data.}
109		#' \item{Color-blind people have difficulty distinguishing some colors of
110		#' the rainbow.}
111		#' }
112		#' If such use cannot be avoided, Paul Tol's technical note provides two color
113		#' schemes that are reasonably clear in color-blind vision. To remain
114		#' color-blind safe, these two schemes must comply with the following
115		#' conditions:
116		#' \describe{
117		#' \item{`discreterainbow`}{This scheme must not be interpolated.}
118		#' \item{`smoothrainbow`}{This scheme does not have to be used over the full
119		#' range.}
120		#' }
121		#' @references
122		#' Tol, P. (2021). Colour Schemes. SRON. Technical Note No.
123		#' SRON/EPS/TN/09-002, issue 3.2.
124		#' URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
125		#' @keywords internal
126		#' @rdname tol
127		#' @name tol
128		NULL
129
130		# Fabio Crameri ================================================================
131		#' Fabio Crameri's Color Schemes
132		#'
133		#' @section Diverging Color Schemes:
134		#' If more colors than defined are needed from a given scheme, the color
135		#' coordinates are linearly interpolated to provide a continuous version of the
136		#' scheme.
137		#'
138		#' \tabular{ll}{
139		#' Palette \tab Max. \cr
140		#' `broc` \tab 256 \cr
141		#' `cork` \tab 256 \cr
142		#' `vik` \tab 256 \cr
143		#' `lisbon` \tab 256 \cr
144		#' `tofino` \tab 256 \cr
145		#' `berlin` \tab 256 \cr
146		#' `roma` \tab 256 \cr
147		#' `bam` \tab 256 \cr
148		#' `vanimo` \tab 256 \cr
149		#' `brocO`* \tab 256 \cr
150		#' `corkO`* \tab 256 \cr
151		#' `vikO`* \tab 256 \cr
152		#' `romaO`* \tab 256 \cr
153		#' `bamO`* \tab 256 \cr
154		#' }
155		#' *: cyclic color schemes.
156		#' @section Sequential Color Schemes:
157		#' If more colors than defined are needed from a given scheme, the color
158		#' coordinates are linearly interpolated to provide a continuous version of the
159		#' scheme.
160		#'
161		#' \tabular{ll}{
162		#' Palette \tab Max. \cr
163		#' `batlow` \tab 256 \cr
164		#' `batlowW` \tab 256 \cr
165		#' `batlowK` \tab 256 \cr
166		#' `devon` \tab 256 \cr
167		#' `lajolla` \tab 256 \cr
168		#' `bamako` \tab 256 \cr
169		#' `davos` \tab 256 \cr
170		#' `bilbao` \tab 256 \cr
171		#' `nuuk` \tab 256 \cr
172		#' `oslo` \tab 256 \cr
173		#' `grayC` \tab 256 \cr
174		#' `hawaii` \tab 256 \cr
175		#' `lapaz` \tab 256 \cr
176		#' `tokyo` \tab 256 \cr
177		#' `buda` \tab 256 \cr
178		#' `acton` \tab 256 \cr
179		#' `turku` \tab 256 \cr
180		#' `imola` \tab 256 \cr
181		#' `oleron`* \tab 256 \cr
182		#' `bukavu`* \tab 256 \cr
183		#' `fes`* \tab 256 \cr
184		#' }
185		#' *: multisequential color schemes.
186		#' @references
187		#' Crameri, F. (2018). Geodynamic diagnostics, scientific visualisation and
188		#' StagLab 3.0. Geosci. Model Dev., 11, 2541-2562.
189		#' \doi{10.5194/gmd-11-2541-2018}
190		#'
191		#' Crameri, F., Shephard, G. E. & Heron, P. J. (2020). The misuse of colour in
192		#' science communication. Nature Communications, 11, 5444.
193		#' \doi{10.1038/s41467-020-19160-7}
194		#' @source
195		#' Crameri, F. (2021). Scientific colour maps. Zenodo, v7.0.
196		#' \doi{10.5281/zenodo.4491293}
197		#' @keywords internal
198		#' @rdname crameri
199		#' @name crameri
200		NULL
201
202		# Science ======================================================================
203		#' Scientific Color Schemes
204		#'
205		#' @details
206		#' The following (qualitative) color schemes are available:
207		#' \describe{
208		#' \item{`stratigraphy`}{International Chronostratigraphic Chart (175 colors).}
209		#' \item{`land`}{AVHRR Global Land Cover Classification (14 colors).}
210		#' \item{`soil`}{FAO Reference Soil Groups (24 colors).}
211		#' }
212		#' @references
213		#' Jones, A., Montanarella, L. & Jones, R. (Ed.) (2005). *Soil atlas of
214		#' Europe*. Luxembourg: European Commission, Office for Official Publications
215		#' of the European Communities. 128 pp. ISBN: 92-894-8120-X.
216		#'
217		#' Tol, P. (2021). Colour Schemes. SRON. Technical Note No.
218		#' SRON/EPS/TN/09-002, issue 3.2.
219		#' URL: \url{https://sronpersonalpages.nl/~pault/data/colourschemes.pdf}
220		#'
221		#' \href{https://ccgm.org/}{Commission for the Geological Map of the World}
222		#' @keywords internal
223		#' @rdname science
224		#' @name science
225		NULL

1		#' Plot Simulated Color Blindness
2		#'
3		#' Shows colors in a plot with different types of simulated color blindness.
4		#' @param x A [`character`] vector of colors.
5		#' @return
6		#' `plot_scheme_colourblind()` is called for its side-effects: it results in a
7		#' graphic being displayed (invisibly returns `x`).
8		#' @example inst/examples/ex-change.R
9		#' @author N. Frerebeau, V. Arel-Bundock
10		#' @family diagnostic tools
11		#' @export
12		plot_scheme_colourblind <- function(x) {
13		# Validation
14	1x	assert_color(x)
15
16	1x	n <- length(x)
17	1x	col <- c(x, anomalize(x, 'deuteranopia'), anomalize(x, 'protanopia'),
18	1x	anomalize(x, 'tritanopia'), anomalize(x, 'achromatopsia'))
19	1x	xcoord <- seq(0, 1, length.out = n + 1)
20	1x	ycoord <- rep(c(.8, .6, .4, .2, 0), each = n)
21	1x	grid::grid.newpage()
22	1x	grid::grid.rect(
23	1x	x = grid::unit(utils::head(xcoord, -1), "npc"),
24	1x	y = grid::unit(ycoord, "npc"),
25	1x	width = grid::unit(1 / n, "npc"),
26	1x	height = grid::unit(0.7 / 5, "npc"),
27	1x	hjust = 0,
28	1x	vjust = 0,
29	1x	gp = grid::gpar(fill = col, col = col)
30		)
31	1x	grid::grid.text(
32	1x	label = c("Palette", "Deuteranopia", "Protanopia", "Tritanopia",
33	1x	"Achromatopsia"),
34	1x	x = grid::unit(0, 'npc'),
35	1x	y = grid::unit(c(0.97, 0.77, 0.57, 0.37, 0.17), "npc"),
36	1x	hjust = 0
37		)
38
39	1x	invisible(x)
40		}
41
42		#' @rdname plot_scheme_colourblind
43		#' @export
44		plot_scheme_colorblind <- plot_scheme_colourblind

1		#' Plot Color Scheme
2		#'
3		#' Quickly displays a color scheme returned by [color()].
4		#' @param x A [`character`] vector of colors.
5		#' @param ... Currently not used.
6		#' @return
7		#' `plot()` is called for its side-effects: it results in a graphic
8		#' being displayed (invisibly returns `x`).
9		#' @example inst/examples/ex-plot.R
10		#' @author N. Frerebeau
11		#' @family diagnostic tools
12		#' @export
13		plot.color_scheme <- function(x, ...) {
14		# Save and restore graphical parameters
15	1x	old_par <- graphics::par(no.readonly = TRUE)
16	1x	on.exit(graphics::par(old_par))
17
18	1x	n <- length(x)
19	1x	graphics::par(mar = c(0, 0, 0, 0) + 0.1, xaxs = "i", yaxs = "i")
20	1x	graphics::plot(
21	1x	x = NULL, y = NULL,
22	1x	xlim = c(0, n), ylim = c(0, 1),
23	1x	xlab = "", ylab = "", axes = FALSE
24		)
25	1x	graphics::rect(xleft = seq(0, n - 1), xright = seq(1, n),
26	1x	ybottom = 0.25, ytop = 0.75, col = x, border = NA)
27	!	if (n < 25) graphics::abline(v = seq(1, n), col = "#D3D3D3", lwd = 0.25)
28
29	1x	invisible(x)
30		}