Create custom ggplot scales

colors.R

#' Function to extract Jupiter colors as hex codes
#'
#' @param ... Character names of colors
#'
#' @examples
#' jupiter_colors()
#' jupiter_colors("petrol")
#'
#' @export
jupiter_colors <- function(...) {
  jupiter_cols <- c(
    `positive`             = "#02af74",
    `positive_dark`        = "#008a5a",
    `positive_light`       = "#82b99b",
    `positive_desaturated` = "#5ca882",
    `positive_pale`        = "#c1dccd",
    `negative`             = "#ffa500",
    `negative_dark`        = "#c98102",
    `negative_light`       = "#e6efa0",
    `negative_desaturated` = "#ecab6d",
    `negative_pale`        = "#ffe3b1",
    `grey`                 = "#b1b1b1",
    `grey_dark`            = "#8b8b8b",
    `grey_light`           = "#c0c0c0",
    `grey_desaturated`     = "#b1b1b1",
    `grey_pale`            = "#f1f1f1"
  )

  cols <- c(...)

  if (is.null(cols))
    return (jupiter_cols)

  jupiter_cols[cols]
}


#' Return function to interpolate a continuous Jupiter color palette
#'
#' @param palette Character name of palette in jupiter_palettes
#' @param reverse Boolean indicating whether the palette should be reversed
#' @param ... Additional arguments to pass to colorRampPalette()
#'
#' @examples
#' jupiter_pal_c()(10)
#' jupiter_pal_c("cool", reverse = TRUE)(5)
#'
#' @export
jupiter_pal_c <- function(palette = "trends", reverse = FALSE, ...) {

  jupiter_palettes <- list(
    `trends`             = jupiter_colors("negative", "grey", "positive"),
    `trends_dark`        = jupiter_colors("negative_dark", "grey_dark", "positive_dark"),
    `trends_light`       = jupiter_colors("negative_light", "grey_light", "positive_light"),
    `trends_desaturated` = jupiter_colors("negative_desaturated", "grey_desaturated", "positive_desaturated"),
    `trends_pale`        = jupiter_colors("negative_pale", "grey_pale", "positive_pale")
  )

  pal <- jupiter_palettes[[palette]]

  if (reverse) pal <- rev(pal)

  grDevices::colorRampPalette(pal, ...)
}


#' Return function to interpolate a discrete Jupiter color palette
#'
#' @param palette Character name of palette in jupiter_palettes
#' @param reverse Boolean indicating whether the palette should be reversed
#' @param ... Additional arguments to pass to colorRampPalette()
#'
#' @examples
#' jupiter_pal_d()(2)
#' jupiter_pal_d("candles")
#'
#' @export
jupiter_pal_d <- function(palette = "trends", reverse = FALSE, ...) {

  jupiter_palettes <- list(
    `trends`             = jupiter_colors("negative", "positive"),
    `trends_dark`        = jupiter_colors("negative_dark", "positive_dark"),
    `trends_light`       = jupiter_colors("negative_light", "positive_light"),
    `trends_desaturated` = jupiter_colors("negative_desaturated", "positive_desaturated"),
    `trends_pale`        = jupiter_colors("negative_pale", "grey_pale", "positive_pale"),
    ## modified from cartocolor (without green and orange to avoid overlap)
    `smoothings`         = c("#4b2991",
                             "#872ca2",
                             "#c0369d",
                             "#ea4f88",
                             "#fa7876")
  )

  pal <- jupiter_palettes[[palette]]

  if (reverse) pal <- rev(pal)

  grDevices::colorRampPalette(pal, ...)
}


#' Color scale constructor for continuous Jupiter color palettes
#'
#' @param palette Character name of palette in jupiter_palettes
#' @param reverse Boolean indicating whether the palette should be reversed
#' @param ... Additional arguments passed to discrete_scale() or
#'            scale_color_gradientn(), used respectively when discrete is TRUE
#'            or FALSE
#' @examples
#' library(ggplot2)
#' ggplot(mpg, aes(hwy, cty, color = displ)) + geom_point(size = 4) +
#' scale_color_jupiter()
#' \dontrun{
#' ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Sepal.Width)) +
#'   geom_point(size = 4) + scale_color_jupiter("hot", reverse = TRUE) +
#'   theme_jupiter()
#' }
#' @export
scale_color_jupiter <- function(palette = "trends", reverse = FALSE, ...) {
  if (!palette %in% c("trends", "trends_dark", "trends_light", "trends_pale", "trends_desaturated")) stop('Palette should be one of "trends", "trends_dark", "trends_light", "trends_pale", or "trends_desaturated".')

  pal <- jupiter_pal_c(palette = palette, reverse = reverse)

  ggplot2::scale_color_gradientn(colours = pal(256), ...)
}


#' Color scale constructor for discrete Jupiter colors
#'
#' @param palette Character name of palette in jupiter_palettes
#' @param reverse Boolean indicating whether the palette should be reversed
#' @param ... Additional arguments passed to discrete_scale() or
#'            scale_color_gradientn(), used respectively when discrete is TRUE
#'            or FALSE
#'
#' @examples
#' library(ggplot2)
#' ggplot(mpg, aes(displ, cty, color = manufacturer)) +
#'   geom_point(size = 4) + scale_color_jupiter_d()
#' \dontrun{
#' ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) +
#'   geom_point(size = 4) + scale_color_jupiter_d("theme", reverse = TRUE) +
#'   theme_jupiter()
#' }
#' @export
scale_color_jupiter_d <- function(palette = "trends", reverse = FALSE, ...) {
  if (!palette %in% c("trends", "trends_dark", "trends_light", "trends_pale", "trends_desaturated", "smoothings")) stop('Palette should be one of "trends", "trends_dark", "trends_light", "trends_pale", "trends_desaturated", or "smoothings".')

  pal <- jupiter_pal_d(palette = palette, reverse = reverse)

  ggplot2::discrete_scale("colour", paste0("jupiter_", palette), palette = pal, ...)
}


#' Fill scale constructor for continuous eoto color palettes
#'
#' @param palette Character name of palette in jupiter_palettes
#' @param reverse Boolean indicating whether the palette should be reversed
#' @param ... Additional arguments passed to discrete_scale() or
#'            scale_fill_gradientn(), used respectively when discrete is TRUE
#'            or FALSE
#'
#' @examples
#' library(ggplot2)
#' ggplot(mpg, aes(hwy, cty, fill = displ)) +
#'   geom_point(size = 4, shape = 21) + scale_fill_jupiter()
#' \dontrun{
#' ggplot(iris, aes(Sepal.Width, Sepal.Length, fill = Sepal.Width)) +
#'   geom_point(size = 4, shape = 21) +
#'   scale_fill_jupiter("hot", reverse = TRUE) + theme_jupiter()
#' }
#' @export
scale_fill_jupiter <- function(palette = "trends", reverse = FALSE, ...) {
  if (!palette %in% c("trends", "trends_dark", "trends_light", "trends_pale", "trends_desaturated")) stop('Palette should be one of "trends", "trends_dark", "trends_light", "trends_pale", or "trends_desaturated".')

  pal <- jupiter_pal_c(palette = palette, reverse = reverse)

  ggplot2::scale_fill_gradientn(colours = pal(256), ...)
}


#' Fill scale constructor for continuous eoto color palettes
#'
#' @param palette Character name of palette in jupiter_palettes
#' @param reverse Boolean indicating whether the palette should be reversed
#' @param ... Additional arguments passed to discrete_scale() or
#'            scale_fill_gradientn(), used respectively when discrete is TRUE
#'            or FALSE
#'
#' @examples
#' library(ggplot2)
#' ggplot(mpg, aes(class, fill = class)) + geom_bar() + scale_fill_jupiter_d()
#' ggplot(mpg, aes(class, fill = class)) + geom_bar() +
#'   scale_fill_jupiter_d("theme", reverse = TRUE)
#'
#' @export
scale_fill_jupiter_d <- function(palette = "trends", reverse = FALSE, ...) {
  if (!palette %in% c("trends", "trends_dark", "trends_light", "trends_pale", "trends_desaturated", "smoothings")) stop('Palette should be one of "trends", "trends_dark", "trends_light", "trends_pale", "trends_desaturated", or "smoothing".')

  pal <- jupiter_pal_d(palette = palette, reverse = reverse)

  ggplot2::discrete_scale("fill", paste0("jupiter_", palette), palette = pal, ...)
}