Skip to content

Instantly share code, notes, and snippets.

@z3tt
Created November 5, 2021 15:22
Show Gist options
  • Save z3tt/231122d2d160a597769a7a6f7ed3f200 to your computer and use it in GitHub Desktop.
Save z3tt/231122d2d160a597769a7a6f7ed3f200 to your computer and use it in GitHub Desktop.
Create custom ggplot scales
#' 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, ...)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment