R/scale_color_pizza.R

In easystats/see: Model Visualisation Toolbox for 'easystats' and 'ggplot2'

# Scales -----------------------------------------------------------------

#' Pizza color palette
#'
#' The palette based on authentic neapolitan pizzas.
#' Use `scale_color_pizza_d()` for *discrete* categories and
#' `scale_color_pizza_c()` for a *continuous* scale.
#'
#' @inheritParams palette_pizza
#' @inheritParams scale_color_flat
#'
#' @examples
#' library(ggplot2)
#' library(see)
#'
#' ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) +
#'   geom_boxplot() +
#'   theme_modern() +
#'   scale_fill_pizza_d()
#'
#' ggplot(iris, aes(x = Petal.Length, y = Petal.Width, color = Sepal.Length)) +
#'   geom_point() +
#'   theme_modern() +
#'   scale_color_pizza_c()
#' @export
scale_color_pizza <- function(
  palette = "margherita",
  discrete = TRUE,
  reverse = FALSE,
  aesthetics = "color",
  ...
) {
  pal <- palette_pizza(palette = palette, reverse = reverse)

  if (discrete) {
    discrete_scale(aesthetics = aesthetics, palette = pal, ...)
  } else {
    scale_color_gradientn(colours = pal(256), aesthetics = aesthetics, ...)
  }
}


# Aliases -----------------------------------------------------------------

#' @rdname scale_color_pizza
#' @export
scale_color_pizza_d <- function(
  palette = "margherita",
  discrete = TRUE,
  reverse = FALSE,
  aesthetics = "color",
  ...
) {
  scale_color_pizza(
    palette = palette,
    discrete = discrete,
    reverse = reverse,
    aesthetics = aesthetics,
    ...
  )
}

#' @rdname scale_color_pizza
#' @export
scale_color_pizza_c <- function(
  palette = "margherita",
  discrete = FALSE,
  reverse = FALSE,
  aesthetics = "color",
  ...
) {
  scale_color_pizza(
    palette = palette,
    discrete = discrete,
    reverse = reverse,
    aesthetics = aesthetics,
    ...
  )
}

#' @rdname scale_color_pizza
#' @export
scale_colour_pizza <- scale_color_pizza

#' @rdname scale_color_pizza
#' @export
scale_colour_pizza_c <- scale_color_pizza_c

#' @rdname scale_color_pizza
#' @export
scale_colour_pizza_d <- scale_color_pizza_d


# Fill --------------------------------------------------------------------

#' @rdname scale_color_pizza
#' @export
scale_fill_pizza <- function(
  palette = "margherita",
  discrete = TRUE,
  reverse = FALSE,
  aesthetics = "fill",
  ...
) {
  pal <- palette_pizza(palette = palette, reverse = reverse)

  if (discrete) {
    discrete_scale(aesthetics = aesthetics, palette = pal, ...)
  } else {
    scale_fill_gradientn(colours = pal(256), aesthetics = aesthetics, ...)
  }
}


#' @rdname scale_color_pizza
#' @export
scale_fill_pizza_d <- function(
  palette = "margherita",
  discrete = TRUE,
  reverse = FALSE,
  aesthetics = "fill",
  ...
) {
  scale_fill_pizza(
    palette = palette,
    discrete = discrete,
    reverse = reverse,
    aesthetics = aesthetics,
    ...
  )
}

#' @rdname scale_color_pizza
#' @export
scale_fill_pizza_c <- function(
  palette = "margherita",
  discrete = FALSE,
  reverse = FALSE,
  aesthetics = "fill",
  ...
) {
  scale_fill_pizza(
    palette = palette,
    discrete = discrete,
    reverse = reverse,
    aesthetics = aesthetics,
    ...
  )
}


# Palette --------------------------------------------------------------------

# The palette based on this image:
# https://www.scattidigusto.it/wp-content/uploads/2018/03/pizza-margherita-originale-Scatti-di-Gusto.jpg
pizza_colors_list <- c(
  tomato = "#CE3722",
  mozzarella = "#EBE8E1",
  basil = "#768947",
  crust = "#E7CBA3",
  coal = "#302124",
  diavola = "#642118"
)


#' Extract pizza colors as hex codes
#'
#' @param ... Character names of pizza ingredients.
#'
#' @return A character vector with color-codes.
#'
#' @export
pizza_colors <- function(...) {
  cols <- c(...)

  if (is.null(cols)) {
    return(pizza_colors_list)
  }

  pizza_colors_list[cols]
}


pizza_palettes <- list(
  margherita = pizza_colors("tomato", "mozzarella", "basil"),
  `margherita crust` = pizza_colors(
    "crust",
    "tomato",
    "mozzarella",
    "basil",
    "coal"
  ),
  diavola = pizza_colors("tomato", "mozzarella", "basil", "diavola"),
  `diavola crust` = pizza_colors(
    "crust",
    "tomato",
    "mozzarella",
    "basil",
    "diavola",
    "coal"
  ),
  gradient = c("basil", "tomato")
)


#' Pizza color palette
#'
#' The palette based on authentic neapolitan pizzas.
#'
#' @param palette Pizza type. Can be `"margherita"` (default), `"margherita crust"`,
#' `"diavola"` or `"diavola crust"`.
#' @param reverse Boolean indicating whether the palette should be reversed.
#' @param ... Additional arguments to pass to [`colorRampPalette()`][colorRampPalette].
#'
#' @details This function is usually not called directly, but from within
#'   [`scale_color_pizza()`][scale_color_pizza].
#'
#' @export
palette_pizza <- function(palette = "margherita", reverse = FALSE, ...) {
  .retrieve_palette(palette, pizza_palettes, reverse = reverse, ...)
}