R/scale_sequential.R

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

#' HCL-Based Discrete Sequential Color Scales for ggplot2
#'
#' Discrete ggplot2 color scales using the color palettes generated by \code{\link{sequential_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.
#' 
#' Compared to \code{\link{sequential_hcl}} the ordering of the colors in the sequential ggplot2 scale
#' are reversed by default (i.e., \code{rev = TRUE}) to be more consistent with ggplot2's own scales such as
#' \code{\link[ggplot2]{scale_color_brewer}}. For most named palettes this leads to darker and more
#' colorful colors for larger values on the scale. This is typically the better default on light/white
#' backgrounds.
#'
#' @param c1 Beginning chroma value.
#' @param c2 Ending chroma value.
#' @param cmax Maximum chroma value.
#' @param l1 Beginning luminance value.
#' @param l2 Ending luminance value.
#' @param h1 Beginning hue value.
#' @param h2 Ending hue value. If set to \code{NA}, generates a single-hue scale.
#' @param p1 Control parameter determining how chroma should vary (1 = linear, 2 = quadratic, etc.).
#' @param p2 Control parameter determining how luminance should vary (1 = linear, 2 = quadratic, etc.).
#' @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} (default), reverses the order of the colors in the color scale (compared to \code{\link{sequential_hcl}}).
#' @param palette The name of the palette to be used. Run \code{hcl_palettes(type = "sequential")} 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() + scale_color_discrete_sequential() + theme_classic()
#' 
#' # customization of named palette  
#' ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
#'   geom_point() + scale_colour_discrete_sequential(palette = "Reds", nmax = 4, p2 = 1.5) +
#'   theme_classic()
#'  
#' # color scale "Terrain"
#' ggplot(iris, aes(Sepal.Length, fill = Species)) +
#'   geom_density(alpha = 0.7) + scale_fill_discrete_sequential(palette = "Terrain") + theme_minimal()
#' @importFrom stats na.omit
#' @export
scale_colour_discrete_sequential <- function(palette = NULL, c1 = NULL, c2 = NULL, cmax = NULL, l1 = NULL, l2 = NULL,
                                             h1 = NULL, h2 = NULL, p1 = NULL, p2 = NULL, alpha = 1, rev = TRUE,
                                             nmax = NULL, order = NULL, aesthetics = "colour", ...)
{
  # arguments we want to hand off to function sequential_hcl only if explicitly provided
  hcl_args <- c("palette", "c1", "c2", "cmax", "l1", "l2", "h1", "h2", "p1", "p2")
  
  # 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_sequential. ", 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(sequential_hcl, args, envir = parent.frame())[order]
  }
  ggplot2::discrete_scale(aesthetics, "manual", pal, ...)
}

#' @rdname scale_colour_discrete_sequential
#' @export
scale_color_discrete_sequential <- scale_colour_discrete_sequential

#' @rdname scale_colour_discrete_sequential
#' @export
scale_fill_discrete_sequential <- 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_sequential, args, envir = parent.frame())
}

#' HCL-Based Continuous Sequential Color Scales for ggplot2
#'
#' Continuous ggplot2 color scales using the color palettes generated by \code{\link{sequential_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.
#' 
#' Compared to \code{\link{sequential_hcl}} the ordering of the colors in the sequential ggplot2 scale
#' are reversed by default (i.e., \code{rev = TRUE}) to be more consistent with ggplot2's own scales such as
#' \code{\link[ggplot2]{scale_color_brewer}}. For most named palettes this leads to darker and more
#' colorful colors for larger values on the scale. This is typically the better default on light/white
#' backgrounds.
#'
#' @inheritParams scale_colour_discrete_sequential
#' @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")
#' 
#' # base plot
#' gg <- ggplot(iris, aes(x = Species, y = Sepal.Width, color = Sepal.Length)) + 
#'   geom_jitter(width = 0.3) + theme_minimal()
#' 
#' # default settings
#' gg + scale_color_continuous_sequential()
#' 
#' # switch palette and overwrite some default values
#' gg + scale_color_continuous_sequential(palette = "Reds", l1 = 20, c2 = 70, p1 = 1)
#' 
#' # select a range out of the entire palette
#' gg + scale_color_continuous_sequential(palette = "Heat", begin = 0.2, end = 0.8)
#' 
#' # volcano plot
#' df <- data.frame(height = c(volcano), x = c(row(volcano)), y = c(col(volcano)))
#' ggplot(df, aes(x, y, fill = height)) + 
#'   geom_raster() + scale_fill_continuous_sequential(palette = "Terrain", rev = FALSE) +
#'   coord_fixed(expand = FALSE)
#' @importFrom stats na.omit
#' @export
scale_colour_continuous_sequential <- function(palette = NULL, c1 = NULL, c2 = NULL, cmax = NULL, l1 = NULL, l2 = NULL,
                                               h1 = NULL, h2 = NULL, p1 = NULL, p2 = NULL, alpha = 1, rev = TRUE,
                                               begin = 0, end = 1, na.value = "grey50", guide = "colourbar",
                                               aesthetics = "colour", n_interp = 11, ...)
{
  # arguments we want to hand off to function sequential_hcl only if explicitly provided
  hcl_args <- c("palette", "c1", "c2", "cmax", "l1", "l2", "h1", "h2", "p1", "p2")
  
  # 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(sequential_hcl, args, envir = parent.frame())

  ggplot2::continuous_scale(aesthetics, "continuous_sequential",
                            scales::gradient_n_pal(colors, values = NULL),
                            na.value = na.value, guide = guide,
                            rescaler = to_rescaler(begin, end), ...)
}

#' @rdname scale_colour_continuous_sequential
#' @export
scale_color_continuous_sequential <- scale_colour_continuous_sequential

#' @rdname scale_colour_continuous_sequential
#' @export
scale_fill_continuous_sequential <- 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_sequential, args, envir = parent.frame())
}


#' HCL-Based Binned Sequential Color Scales for ggplot2
#'
#' Binned ggplot2 color scales using the color palettes generated by \code{\link{sequential_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.
#' 
#' Compared to \code{\link{sequential_hcl}} the ordering of the colors in the sequential ggplot2 scale
#' are reversed by default (i.e., \code{rev = TRUE}) to be more consistent with ggplot2's own scales such as
#' \code{\link[ggplot2]{scale_color_fermenter}}. For most named palettes this leads to darker and more
#' colorful colors for larger values on the scale. This is typically the better default on light/white
#' backgrounds.
#'
#' @inheritParams scale_colour_discrete_sequential
#' @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")
#' 
#' # volcano plot
#' df <- data.frame(height = c(volcano), x = c(row(volcano)), y = c(col(volcano)))
#' ggplot(df, aes(x, y, fill = height)) + 
#'   geom_raster() + scale_fill_binned_sequential(palette = "Terrain", rev = FALSE) +
#'   coord_fixed(expand = FALSE)
#' @importFrom stats na.omit
#' @export
scale_colour_binned_sequential <- function(palette = NULL, c1 = NULL, c2 = NULL, cmax = NULL, l1 = NULL, l2 = NULL,
                                           h1 = NULL, h2 = NULL, p1 = NULL, p2 = NULL, alpha = 1, rev = TRUE,
                                           begin = 0, end = 1, na.value = "grey50", guide = "coloursteps",
                                           aesthetics = "colour", n_interp = 11, ...)
{
  # arguments we want to hand off to function sequential_hcl only if explicitly provided
  hcl_args <- c("palette", "c1", "c2", "cmax", "l1", "l2", "h1", "h2", "p1", "p2")
  
  # 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(sequential_hcl, args, envir = parent.frame())
  
  ggplot2::binned_scale(
    aesthetics,
    "binned_sequential",
    scales::gradient_n_pal(colors, values = NULL),
    na.value = na.value,
    guide = guide,
    rescaler = to_rescaler(begin, end),
    ...
  )
  
}

#' @rdname scale_colour_binned_sequential
#' @export
scale_color_binned_sequential <- scale_colour_binned_sequential

#' @rdname scale_colour_binned_sequential
#' @export
scale_fill_binned_sequential <- 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_sequential, args, envir = parent.frame())
}