R/scale_qualitative.R

In colorspace: A Toolbox for Manipulating and Assessing Colors and Palettes

#' HCL-Based Discrete Qualitative Color Scales for ggplot2
#'
#' Discrete ggplot2 color scales using the color palettes generated by \code{\link{qualitative_hcl}}. 
#'
#' 
#' If both a valid palette name and palette parameters are provided then the provided palette parameters overwrite the parameters in the
#' named palette. This enables easy customization of named palettes.
#' 
#' @param c1 Chroma value, used for all colors in the scale.
#' @param l1 Luminance value, used for all colors in the scale.
#' @param h1 Beginning hue value.
#' @param h2 Ending hue value.
#' @param alpha Numeric vector of values in the range \code{[0, 1]} for alpha transparency channel (0 means transparent and 1 means opaque).
#' @param rev If \code{TRUE}, reverses the order of the colors in the color scale.
#' @param palette The name of the palette to be used. Run \code{hcl_palettes(type = "qualitative")} for available options.
#' @param nmax Maximum number of different colors the palette should contain. If not provided, is calculated automatically
#'  from the data.
#' @param order Numeric vector listing the order in which the colors should be used. Default is \code{1:nmax}.
#' @param aesthetics The ggplot2 aesthetics to which this scale should be applied.
#' @param ... common discrete scale parameters: \code{name}, \code{breaks}, \code{labels}, \code{na.value}, \code{limits} and \code{guide}. See
#'  \code{\link[ggplot2]{discrete_scale}} for more details.
#' @examples
#' library("ggplot2")
#' 
#' # default colors
#' ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
#'   geom_point() + theme_minimal() +
#'   scale_color_discrete_qualitative()
#'  
#' # color scale "Harmonic"
#' ggplot(iris, aes(Sepal.Length, fill = Species)) +
#'   geom_density(alpha = 0.7) + scale_fill_discrete_qualitative(palette = "Harmonic")
#' @importFrom stats na.omit
#' @export
scale_colour_discrete_qualitative <- function(palette = NULL, c1 = NULL, l1 = NULL, h1 = NULL, h2 = NULL,
                                   alpha = 1, rev = FALSE, nmax = NULL, order = NULL, aesthetics = "colour",
                                   ...)
{
  # arguments we want to hand off to function qualitative_hcl only if explicitly provided
  hcl_args <- c("palette", "c1", "l1", "h1", "h2")
  
  # match hcl_args to args provided
  args <- as.list(match.call())
  args[[1]] <- NULL # remove the function call
  args <- args[na.omit(match(hcl_args, names(args)))] # remove other args
  for(n in names(args)) args[[n]] <- get(n) # force evaluation of args
  
  pal <- function(n) {
    if (is.null(nmax)) nmax <- n
    if (is.null(order)) order <- 1:n
    
    if (n > nmax) {
      warning("Insufficient values in scale_colour_discrete_qualitative. ", n, " needed but only ",
              nmax, " provided.", call. = FALSE)
    }
    # set the remaining arguments and call qualitative_hcl
    args <- c(args, list(n = nmax, alpha = alpha, rev = rev))
    do.call(qualitative_hcl, args, envir = parent.frame())[order]
  }
  ggplot2::discrete_scale(aesthetics, "manual", pal, ...)
}

#' @rdname scale_colour_discrete_qualitative
#' @export
scale_color_discrete_qualitative <- scale_colour_discrete_qualitative

#' @rdname scale_colour_discrete_qualitative
#' @export
scale_fill_discrete_qualitative <- function(..., aesthetics = "fill")
{
  args <- as.list(match.call())
  args[[1]] <- NULL # remove the function call
  if (is.null(args[["aesthetics"]])) args$aesthetics <- "fill"
  do.call(scale_colour_discrete_qualitative, args, envir = parent.frame())
}

#' HCL-Based Continuous Qualitative Color Scales for ggplot2
#'
#' Continuous ggplot2 color scales using the color palettes generated by \code{\link{qualitative_hcl}}. These scales are provided
#' for completeness. It is not normally a good idea to color a continuous variable using a qualitative scale.
#'
#' If both a valid palette name and palette parameters are provided then the provided palette parameters overwrite the parameters in the
#' named palette. This enables easy customization of named palettes.
#' 
#' @inheritParams scale_colour_discrete_qualitative
#' @param begin Number in the range of \code{[0, 1]} indicating to which point in the color scale the smallest data value should be mapped.
#' @param end Number in the range of \code{[0, 1]} indicating to which point in the color scale the largest data value should be mapped.
#' @param na.value Color to be used for missing data points.
#' @param guide Type of legend. Use \code{"colourbar"} for continuous color bar. 
#' @param n_interp Number of discrete colors that should be used to interpolate the continuous color scale. 11 will work fine in most cases.
#' @param ... common continuous scale parameters: `name`, `breaks`, `labels`, and `limits`. See
#'  \code{\link[ggplot2]{continuous_scale}} for more details.
#' @examples
#' library("ggplot2")
#' 
#' # none of these examples are necessarily good ideas
#' gg <- ggplot(iris, aes(x = Species, y = Sepal.Width, color = Sepal.Length)) + 
#'   geom_jitter(width = 0.3) + theme_minimal()
#'   
#' gg + scale_color_continuous_qualitative(palette = "Warm")
#' gg + scale_color_continuous_qualitative(palette = "Cold", l1 = 60)
#' gg + scale_color_continuous_qualitative(palette = "Harmonic", rev = TRUE)
#'
#' nx = 87
#' ny = 61
#' df <- data.frame(height = c(volcano), x = rep(1:nx, ny), y = rep(1:ny, each = nx))
#' ggplot(df, aes(x, y, fill=height)) + 
#'   geom_raster() + scale_fill_continuous_qualitative(palette = "Dark 3") +
#'   coord_fixed(expand = FALSE)
#' @importFrom stats na.omit
#' @export
scale_colour_continuous_qualitative <- function(palette = NULL, c1 = NULL, l1 = NULL, h1 = NULL, h2 = NULL,
                                                alpha = 1, rev = FALSE, begin = 0, end = 1, na.value = "grey50",
                                                guide = "colourbar", aesthetics = "colour", n_interp = 11, ...)
{
  # arguments we want to hand off to function qualitative_hcl only if explicitly provided
  hcl_args <- c("palette", "c1", "l1", "h1", "h2")
  
  # match hcl_args to args provided
  args <- as.list(match.call())
  args[[1]] <- NULL # remove the function call
  args <- args[na.omit(match(hcl_args, names(args)))] # remove other args
  
  # set the remaining arguments and call qualitative_hcl
  args <- c(args, list(n = n_interp, alpha = alpha, rev = rev))
  colors <- do.call(qualitative_hcl, args, envir = parent.frame())
  
  ggplot2::continuous_scale(aesthetics, "continuous_qualitative",
                            scales::gradient_n_pal(colors, values = NULL),
                            na.value = na.value, guide = guide,
                            rescaler = to_rescaler(begin, end), ...)
}

#' @rdname scale_colour_continuous_qualitative
#' @export
scale_color_continuous_qualitative <- scale_colour_continuous_qualitative

#' @rdname scale_colour_continuous_qualitative
#' @export
scale_fill_continuous_qualitative <- function(..., aesthetics = "fill")
{
  args <- as.list(match.call())
  args[[1]] <- NULL # remove the function call
  if (is.null(args[["aesthetics"]])) args$aesthetics <- "fill"
  do.call(scale_colour_continuous_qualitative, args, envir = parent.frame())
}

#' HCL-Based Binned Qualitative Color Scales for ggplot2
#'
#' Binned ggplot2 color scales using the color palettes generated by \code{\link{qualitative_hcl}}. These scales are provided
#' for completeness. It is not normally a good idea to color a continuous, binned variable using a qualitative scale.
#'
#' If both a valid palette name and palette parameters are provided then the provided palette parameters overwrite the parameters in the
#' named palette. This enables easy customization of named palettes.
#' 
#' @inheritParams scale_colour_discrete_qualitative
#' @param begin Number in the range of \code{[0, 1]} indicating to which point in the color scale the smallest data value should be mapped.
#' @param end Number in the range of \code{[0, 1]} indicating to which point in the color scale the largest data value should be mapped.
#' @param na.value Color to be used for missing data points.
#' @param guide Type of legend. Use \code{"coloursteps"} for color bar with discrete steps. 
#' @param n_interp Number of discrete colors that should be used to interpolate the binned color scale. 11 will work fine in most cases.
#' @param ... common binned scale parameters: `name`, `breaks`, `labels`, and `limits`. See
#'  \code{\link[ggplot2]{binned_scale}} for more details.
#' @examples
#' library("ggplot2")
#' 
#' # none of these examples are necessarily good ideas
#' gg <- ggplot(iris, aes(x = Species, y = Sepal.Width, color = Sepal.Length)) + 
#'   geom_jitter(width = 0.3) + theme_minimal()
#'   
#' gg + scale_color_binned_qualitative(palette = "Dynamic")
#' gg + scale_color_binned_qualitative(palette = "Dark3", l1 = 70)
#'
#' nx = 87
#' ny = 61
#' df <- data.frame(height = c(volcano), x = rep(1:nx, ny), y = rep(1:ny, each = nx))
#' ggplot(df, aes(x, y, fill=height)) + 
#'   geom_raster() + scale_fill_binned_qualitative(palette = "Dark 3") +
#'   coord_fixed(expand = FALSE)
#' @importFrom stats na.omit
#' @export
scale_colour_binned_qualitative <- function(palette = NULL, c1 = NULL, l1 = NULL, h1 = NULL, h2 = NULL,
                                            alpha = 1, rev = FALSE, begin = 0, end = 1, na.value = "grey50",
                                            guide = "coloursteps", aesthetics = "colour", n_interp = 11, ...)
{
  # arguments we want to hand off to function qualitative_hcl only if explicitly provided
  hcl_args <- c("palette", "c1", "l1", "h1", "h2")
  
  # match hcl_args to args provided
  args <- as.list(match.call())
  args[[1]] <- NULL # remove the function call
  args <- args[na.omit(match(hcl_args, names(args)))] # remove other args
  
  # set the remaining arguments and call qualitative_hcl
  args <- c(args, list(n = n_interp, alpha = alpha, rev = rev))
  colors <- do.call(qualitative_hcl, args, envir = parent.frame())
  
  ggplot2::binned_scale(
    aesthetics, "binned_qualitative",
    scales::gradient_n_pal(colors, values = NULL),
    na.value = na.value, guide = guide,
    rescaler = to_rescaler(begin, end),
    ...
  )
}

#' @rdname scale_colour_binned_qualitative
#' @export
scale_color_binned_qualitative <- scale_colour_binned_qualitative

#' @rdname scale_colour_binned_qualitative
#' @export
scale_fill_binned_qualitative <- function(..., aesthetics = "fill")
{
  args <- as.list(match.call())
  args[[1]] <- NULL # remove the function call
  if (is.null(args[["aesthetics"]])) args$aesthetics <- "fill"
  do.call(scale_colour_binned_qualitative, args, envir = parent.frame())
}