R/scales.R

In dtsonipmph/esquisse: Explore and Visualize Your Data Interactively

#' Automatically select appropriate color scale
#'
#' @param mapping Aesthetics used in \code{ggplot}.
#' @param palette Color palette
#' @param data An optional \code{data.frame} to choose the right type for variables.
#' @param fill_type Scale to use according to the variable used
#'  in \code{fill} : \code{"discrete"} or \code{"continuous"}.
#' @param color_type Scale to use according to the variable used
#'  in \code{color} : \code{"discrete"} or \code{"continuous"}.
#'
#' @return a \code{list}
#' @export
#' 
#' @importFrom ggplot2 scale_fill_hue scale_color_hue scale_fill_gradient scale_color_gradient
#'  scale_fill_brewer scale_color_brewer scale_fill_distiller scale_color_distiller
#'  scale_fill_viridis_c scale_color_viridis_c scale_fill_viridis_d scale_color_viridis_d
#'
#' @examples
#' library(ggplot2)
#' 
#' # Automatic guess according to data
#' which_pal_scale(
#'   mapping = aes(fill = Sepal.Length), 
#'   palette = "ggplot2", 
#'   data = iris
#' )
#' which_pal_scale(
#'   mapping = aes(fill = Species),
#'   palette = "ggplot2", 
#'   data = iris
#' )
#' 
#' 
#' # Explicitly specify type
#' which_pal_scale(
#'   mapping = aes(color = variable), 
#'   palette = "Blues", 
#'   color_type = "discrete"
#' )
#' 
#' 
#' # Both scales
#' which_pal_scale(
#'   mapping = aes(color = var1, fill = var2), 
#'   palette = "Blues", 
#'   color_type = "discrete",
#'   fill_type = "continuous"
#' )
which_pal_scale <- function(mapping, palette = "ggplot2", data = NULL,
                            fill_type = c("continuous", "discrete"), 
                            color_type = c("continuous", "discrete")) {
  palettes <- unlist(lapply(default_pals()$choices, names), recursive = TRUE, use.names = FALSE)
  palette <- match.arg(arg = palette, choices = palettes)
  args <- list()
  fill_type <- match.arg(fill_type)
  color_type <- match.arg(color_type)
  if (!is.null(data)) {
    data_mapped <- lapply(mapping, rlang::eval_tidy, data = data)
    if (inherits(x = data_mapped$fill, what = c("character", "factor"))) {
      fill_type <- "discrete"
    } else {
      fill_type <- "continuous"
    }
    if (inherits(x = data_mapped$colour, what = c("character", "factor"))) {
      color_type <- "discrete"
    } else {
      color_type <- "continuous"
    }
  }
  scale_pal_d <- function(pal, aesthetic) {
    if (pal == "ggplot2") {
      s_p <- "hue"
    } else if (pal %in% c("viridis", "plasma", "magma", "cividis", "inferno")) {
      s_p <- "viridis_d"
    } else if (identical(pal, "ipsum")) {
      s_p <- "ipsum"
    } else if (identical(pal, "ft")) {
      s_p <- "ft"
    } else {
      s_p <- "brewer"
    }
    scl <- paste("scale", aesthetic, s_p, sep = "_")
    if (palette %in% c("ipsum", "ft")) {
      scl <- paste0("hrbrthemes::", scl)
    }
    return(scl)
  }
  scale_pal_c <- function(pal, aesthetic) {
    if (pal == "ggplot2") {
      s_p <- "gradient"
    } else if (pal %in% c("viridis", "plasma", "magma", "cividis", "inferno")) {
      s_p <- "viridis_c"
    } else if (identical(pal, "ipsum")) {
      s_p <- "ipsum"
    } else if (identical(pal, "ft")) {
      s_p <- "ft"
    } else {
      s_p <- "distiller"
    }
    scl <- paste("scale", aesthetic, s_p, sep = "_")
    if (palette %in% c("ipsum", "ft")) {
      scl <- paste0("hrbrthemes::", scl)
    }
    return(scl)
  }
  if (!is.null(mapping$fill)) {
    fill_scale <- switch(
      fill_type,
      "discrete" = scale_pal_d(palette, "fill"),
      "continuous" = scale_pal_c(palette, "fill")
    )
    if (!identical(palette, "ggplot2")) {
      args[[fill_scale]] <- setNames(
        object = list(palette), 
        nm = ifelse(grepl("viridis", fill_scale), "option", "palette")
      )
      if (palette %in% c("ipsum", "ft")) {
        args[[fill_scale]] <- NULL
      }
    }
  } else {
    fill_scale <- NULL
  }
  if (!is.null(mapping$colour)) {
    color_scale <- switch(
      color_type,
      "discrete" = scale_pal_d(palette, "color"),
      "continuous" = scale_pal_c(palette, "color")
    )
    if (!identical(palette, "ggplot2")) {
      args[[color_scale]] <- setNames(
        object = list(palette), 
        nm = ifelse(grepl("viridis", color_scale), "option", "palette")
      )
      if (palette %in% c("ipsum", "ft")) {
        args[[color_scale]] <- NULL
      }
    }
  } else {
    color_scale <- NULL
  }
  list(
    scales = c(fill_scale, color_scale),
    args = args
  )
}