R/style_wiggle.R

In teunbrand/elementalist: Extra elements for ggplot2

#' Wiggle style
#'
#' 'Wiggle' is a theme style that adds an amount of cumulative uniform noise to
#' interpolated lines, making them wiggle a bit. The functions are used in the
#' following way: \describe{
#'   \item{\code{wiggle()}}{is a function factory that produces a function that
#'   is subsequently used in elements to make lines wiggle}
#'   \item{\code{element_rect_wiggle()}, \code{element_line_wiggle}}{are
#'   convenience wrappers around \code{element_*_seq()} that pass down the
#'   function generated by \code{wiggle()}.}
#'   \item{\code{wiggling_geoms()}}{is a convenience theme setter for the
#'   \code{elementalist.geom_rect} and \code{elementalist.geom_line} elements.}
#' }
#'
#' @param amount A \code{numeric} of length 1 setting the amount of wiggling to
#'   occur.
#' @param seed An \code{integer} to set the seed for reproducible wiggling.
#' @inheritParams element_line_seq
#' @inheritParams element_rect_seq
#' @param fill Fill colour.
#' @param ... Arguments passed to \code{element_*_seq()}.
#'
#' @details The amount of wiggle added to lines and rectangles is absolute. This
#' makes it easier to make more uniform wiggles, but causes relative distortion
#' when resizing the plot window or device.
#'
#' @return For \code{wiggle()}, a \code{function}.
#' @return For \code{element_rect_wiggle()}, an \code{element_rect_seq} type
#'   list.
#' @return For \code{element_line_wiggle()}, an \code{element_line_seq} type
#'   list.
#' @return For \code{wiggling_geoms}, a partial \code{theme} object.
#' @export
#' @family theme styles
#'
#' @examples
#' barplot <- ggplot(mpg, aes(class)) +
#'   geom_bar_theme(aes(colour = class)) +
#'   geom_line_theme(stat = "count", aes(group = -1))
#'
#' # Making geoms wiggle
#' barplot + wiggling_geoms()
#'
#' # Making only line geoms wiggle
#' barplot + theme(elementalist.geom_line = element_line_wiggle(10))
#'
#' # Making only rect geoms wiggle
#' barplot + theme(elementalist.geom_rect = element_rect_wiggle(5))
#'
#' # Let other theme elements wiggle
#' barplot + theme(
#'   axis.line.x = element_line_wiggle(),
#'   axis.line.y = element_line_wiggle(),
#'   legend.background = element_rect_wiggle(colour = "grey20")
#' )
wiggle <- function(amount = 3, seed = NULL) {
  seed <- force(seed)
  amount <- amount / 2
  function(x, y, colour, linewidth = NULL, id, n) {
    nn <- n * (length(x) - 1) + 1
    id <- rep(id[1], nn)
    if (!is.null(seed)) {
      set.seed(seed)
      on.exit(set.seed(NULL)) # Reset on exit
    }
    z <- cumsum(runif(nn, -amount, amount))
    xy <- fit_along(unclass(x), unclass(y), z)
    x <- seq_between(unclass(x), n)
    y <- seq_between(unclass(y), n)
    col <- c(col_interpol(colour, nn - 1), NA)
    if (!is.null(linewidth)) {
      linewidth <- c(rep_len(linewidth, length(x) - 1), NA)
    }

    out <- list(
      x = x,
      y = y,
      dx = unclass(xy$x) - x,
      dy = unclass(xy$y) - y,
      col = col,
      lwd = linewidth,
      id = id
    )
    out[vapply(out, is.null, logical(1))] <- NULL
    out
  }
}

#' @rdname wiggle
#' @export
element_line_wiggle <- function(amount = 3, seed = NULL, ...) {
  element_line_seq(fun = wiggle(amount, seed), ...)
}

#' @rdname wiggle
#' @export
element_rect_wiggle <- function(amount = 3, seed = NULL, ...) {
  element_rect_seq(fun = wiggle(amount, seed), ...)
}

#' @rdname wiggle
#' @export
wiggling_geoms <- function(
  amount = 5, fill = NULL,
  colour = NULL, linewidth = NULL,
  linetype = NULL, color = NULL, lineend = NULL,
  sides = "tlbr", seed = NULL,
  n = 50
) {
  theme(
    elementalist.geom_rect = element_rect_wiggle(
      amount = amount, fill = fill, colour = colour, linewidth = linewidth,
      linetype = linetype, color = color, n = n, sides = sides,
      seed = seed
    ),
    elementalist.geom_line = element_line_wiggle(
      amount = amount, colour = colour, linewidth = linewidth,
      linetype = linetype, color = color, n = n, lineend = lineend,
      seed = seed
    )
  )
}