R/scale_smile.R

In ggChernoff: Chernoff Faces for 'ggplot2'

#' Scales for smiling and frowning
#'
#' \code{scale_smile} lets you customise how smiles are generated from your data.
#' It also lets you tweak the appearance of legends and so on.
#'
#' Use \code{range} to vary how happily/sadly your maximum/minimum values are represented.
#' Minima smaller than -1 and maxima greater than +1 are possible but might look odd!
#' You can use \code{midpoint} to set a specific 'zero' value in your data or to have smiles represented as relative to average.
#'
#' The function \code{scale_smile} is an alias of \code{scale_smile_continuous}.
#' At some point we might also want to design a \code{scale_smile_discrete}, \code{scale_smile_manual} and so on.
#'
#' Legends are a work in progress. In particular, \code{size} mappings might produce odd results.
#'
#' @param ... Other arguments passed onto \code{\link[ggplot2]{continuous_scale}} to control name, limits, breaks, labels and so forth.
#' @param range Output range of smiles. +1 corresponds to a full smile and -1 corresponds to a full frown.
#' @param midpoint A value or function of your data that will return a neutral/straight face, i.e. \code{:-|}
#'
#' @seealso \code{\link{geom_chernoff}}, \code{\link{scale_brow}}
#'
#' @importFrom scales rescale_mid
#'
#' @examples
#' library(ggplot2)
#' p <- ggplot(iris) +
#'     aes(Sepal.Width, Sepal.Length, fill = Species, smile = Sepal.Length) +
#'     geom_chernoff()
#' p
#' p + scale_smile_continuous(midpoint = min)
#' p + scale_smile_continuous(range = c(-.5, 2))
#'
#' @rdname scale_smile
#' 
#' @return
#' A \code{\link[ggplot2:ggplot2-ggproto]{Scale}} layer object for use with \code{ggplot2}.
#'
#' @export
scale_smile_continuous <- function(..., range = c(-1, 1), midpoint = mean) {
  if (is.numeric(midpoint)) {
    neutral <- function(...) return(midpoint)
  } else {
    neutral <- match.fun(midpoint)
  }
  continuous_scale('smile', 'smile_c',
                   function(x) scales::rescale_mid(x, to = range, mid = neutral(x, na.rm = TRUE)),
                   ..., na.value = 1)
}

#' @rdname scale_smile
#' @export
scale_smile <- scale_smile_continuous