R/style_multicolour.R

In teunbrand/elementalist: Extra elements for ggplot2

#' Multicolour lines
#'
#' Interpolates lines and colour vectors, creating a gradient-like line. The
#' functions are used in the following way: \describe{
#'   \item{\code{multicolour()}}{is a function factory that produces a function
#'   that is subsequently used in elements to make lines multicolour.}
#'   \item{\code{element_rect_multicolour()}, \code{element_line_multicolour}}{
#'   are convenience wrappers around \code{element_*_seq()} that pass down the
#'   function generated by \code{multicolour()}.}
#'   \item{\code{multicolour_geoms()}}{is a convenience theme setter for the
#'   \code{elementalist.geom_rect} and \code{elementalist.geom_line} elements.}
#' }
#'
#' @param colour A \code{character} vector with colour names or hexadecimal
#'   notation.
#' @inheritParams element_line_seq
#' @inheritParams element_rect_seq
#' @param fill Fill colour.
#' @param ... Arguments passed to \code{element_*_seq()}.
#'
#' @details The \code{multicolour} function is a function factory that produces
#' a function, that subsequently can be used to gradient-colour lines.
#'
#' For the \code{element_rect_multicolour()} the gradient is applied to each
#' side separately.
#'
#' @return For \code{multicolour()}, a \code{function}.
#' @return For \code{element_rect_multicolour()}, an \code{element_rect_seq}
#'   type list.
#' @return For \code{element_line_multicolour()}, an \code{element_line_seq}
#'   type list.
#' @return For \code{multicolour_geoms}, a partial \code{theme} object.
#' @export
#' @family theme styles
#'
#' @examples
#' barplot <- ggplot(mpg, aes(class)) +
#'   geom_bar_theme() +
#'   geom_line_theme(stat = "count", aes(group = -1))
#'
#' # Making multicolour geoms
#' barplot + multicolour_geoms(colour = c("#00E6FF",  "#2ABEFF",
#'                                        "#CF77F0", "#FD006A"))
#'
#' # Making only line geoms multicolour
#' barplot + theme(elementalist.geom_line =
#'                   element_line_multicolour(c("magenta", "yellow")))
#'
#' # Making only rect geoms multicolour
#' barplot + theme(elementalist.geom_rect = element_rect_multicolour(rainbow(50)))
#'
#' # Let other theme elements be multicolour
#' barplot + theme(
#'   panel.grid.major.x =
#'     element_line_multicolour(colour = c("white", "yellow", "white")),
#'   panel.background = element_rect_multicolour(colour = rainbow(50))
#' )
multicolour <- function() {
  function(x, y, colour, linewidth = NULL, id, n) {
    if (!is.null(colour)) {
      n <- n  + 1
    }
    nn <- n * (length(x) - 1)
    x <- seq_between(unclass(x), n)
    y <- seq_between(unclass(y), n)
    col <- c(col_interpol(colour, nn), NA)
    if (!is.null(linewidth)) {
      linewidth <- c(rep_len(linewidth, length(x) - 1), NA)
    }
    id <- rep(id[1], length(x))
    out <- list(
      x = x,
      y = y,
      col = col,
      lwd = linewidth,
      id = id
    )
    out[vapply(out, is.null, logical(1))] <- NULL
    return(out)
  }
}

#' @rdname multicolour
#' @export
#' @importFrom grDevices rainbow
element_line_multicolour <- function(colour = rainbow(10), ...) {
  element_line_seq(fun = multicolour(), color = colour, ...)
}

#' @export
#' @rdname multicolour
element_rect_multicolour <- function(colour = rainbow(10), ...) {
  element_rect_seq(fun = multicolour(), color = colour, ...)
}

#' @rdname multicolour
#' @export
multicolour_geoms <- function(
  fill = NULL,
  colour = rainbow(10), linewidth = NULL,
  linetype = NULL, color = NULL, lineend = NULL,
  sides = "tlbr",
  n = 50
) {
  if (!is.null(color)) {
    colour <- color
  }
  theme(
    elementalist.geom_rect = element_rect_multicolour(
      fill = fill, colour = colour, linewidth = linewidth,
      linetype = linetype, n = n, sides = sides
    ),
    elementalist.geom_line = element_line_multicolour(
      colour = colour, linewidth = linewidth,
      linetype = linetype, n = n, lineend = lineend
    )
  )
}