Skip to content

Proposal: factory pattern for color scales #5471

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 5 commits into
base: main
Choose a base branch
from
Draft

Proposal: factory pattern for color scales #5471

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
13ea56b
combine color and fill scales into scale factories
steveharoz Oct 10, 2023
89f8903
dropped glue calls and converted other scales
steveharoz Oct 11, 2023
b364537
rearrange new functions so roxygen work
steveharoz Oct 11, 2023
680eedf
scale brewer
steveharoz Oct 11, 2023
f5230dc
scale docs
steveharoz Oct 11, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
106 changes: 47 additions & 59 deletions R/scale-brewer.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,43 @@
scale_colour_brewer_factory <- function(aesthetic) {
function(..., type = "seq", palette = 1, direction = 1, aesthetics = aesthetic) {
discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...)
}
}

scale_colour_distiller_factory <- function(aesthetic) {
function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = aesthetic) {
# warn about using a qualitative brewer palette to generate the gradient
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
"Using a discrete colour palette in a continuous scale",
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
continuous_scale(
aesthetics,
palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space),
na.value = na.value, guide = guide, ...
)
# NB: 6-7 colours per palette gives nice gradients; more results in more saturated colours which do not look as good
# For diverging scales, you need an odd number to make sure the mid-point is in the center
}
}

scale_colour_fermenter_factory <- function(aesthetic) {
function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = aesthetic) {
# warn about using a qualitative brewer palette to generate the gradient
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
"Using a discrete colour palette in a binned scale",
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...)
}
}

#' Sequential, diverging and qualitative colour scales from ColorBrewer
#'
#' @description
Expand All @@ -8,7 +48,7 @@
#'
#' @note
#' The `distiller` scales extend `brewer` scales by smoothly
#' interpolating 7 colours from any palette to a continuous scale.
#' interpolating 7 colours from any palette to a continuous scale.
#' The `distiller` scales have a default direction = -1. To reverse, use direction = 1.
#' The `fermenter` scales provide binned versions of the `brewer` scales.
#'
Expand Down Expand Up @@ -82,76 +122,24 @@
#' # or use blender variants to discretise continuous data
#' v + scale_fill_fermenter()
#'
scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") {
discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...)
}
scale_colour_brewer <- scale_colour_brewer_factory("colour")

#' @export
#' @rdname scale_brewer
scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "fill") {
discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...)
}
scale_fill_brewer <- scale_colour_brewer_factory("fill")

#' @export
#' @rdname scale_brewer
scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
# warn about using a qualitative brewer palette to generate the gradient
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
"Using a discrete colour palette in a continuous scale",
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
continuous_scale(
aesthetics,
palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space),
na.value = na.value, guide = guide, ...
)
# NB: 6-7 colours per palette gives nice gradients; more results in more saturated colours which do not look as good
# For diverging scales, you need an odd number to make sure the mid-point is in the center
}
scale_colour_distiller <- scale_colour_distiller_factory("colour")

#' @export
#' @rdname scale_brewer
scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
"Using a discrete colour palette in a continuous scale",
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
continuous_scale(
aesthetics,
palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space),
na.value = na.value, guide = guide, ...
)
}
scale_fill_distiller <- scale_colour_distiller_factory("fill")

#' @export
#' @rdname scale_brewer
scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") {
# warn about using a qualitative brewer palette to generate the gradient
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
"Using a discrete colour palette in a binned scale",
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...)
}
scale_colour_fermenter <- scale_colour_fermenter_factory("colour")

#' @export
#' @rdname scale_brewer
scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") {
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
"Using a discrete colour palette in a binned scale",
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...)
}
scale_fill_fermenter <- scale_colour_fermenter_factory("fill")
170 changes: 63 additions & 107 deletions R/scale-colour.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,60 @@
scale_colour_continuous_factory <- function(aesthetic) {
function(..., type = getOption("ggplot2.continuous.colour")) {
type <- type %||% "gradient"
args <- list2(...)
args$call <- args$call %||% current_call()

if (is.function(type)) {
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
args$call <- NULL
}
check_scale_type(exec(type, !!!args), "scale_colour_continuous", aesthetic)
} else if (identical(type, "gradient")) {
exec("scale_colour_gradient", !!!args, aesthetics = aesthetic)
} else if (identical(type, "viridis")) {
exec("scale_colour_viridis_c", !!!args, aesthetics = aesthetic)
} else {
cli::cli_abort(c(
"Unknown scale type: {.val {type}}",
"i" = "Use either {.val gradient} or {.val viridis}"
))
}
}
}

scale_colour_binned_factory <- function(aesthetic) {
function(..., type = getOption("ggplot2.binned.colour")) {
args <- list2(...)
args$call <- args$call %||% current_call()
if (is.function(type)) {
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
args$call <- NULL
}
check_scale_type(exec(type, !!!args), "scale_colour_binned", aesthetic)
} else {
type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient")
# don't use fallback from scale_colour_continuous() if it is
# a function, since that would change the type of the color
# scale from binned to continuous
if (is.function(type_fallback)) {
type_fallback <- "gradient"
}
type <- type %||% type_fallback

if (identical(type, "gradient")) {
exec("scale_colour_steps", !!!args, aesthetics = aesthetic)
} else if (identical(type, "viridis")) {
exec("scale_colour_viridis_b", !!!args, aesthetics = aesthetic)
} else {
cli::cli_abort(c(
"Unknown scale type: {.val {type}}",
"i" = "Use either {.val gradient} or {.val viridis}"
))
}
}
}
}

#' Continuous and binned colour scales
#'
#' The scales `scale_colour_continuous()` and `scale_fill_continuous()` are
Expand Down Expand Up @@ -38,7 +95,6 @@
#'
#' The documentation on [colour aesthetics][aes_colour_fill_alpha].
#' @family colour scales
#' @rdname scale_colour_continuous
#' @section Color Blindness:
#' Many color palettes derived from RGB combinations (like the "rainbow" color
#' palette) are not suitable to support all viewers, especially those with
Expand Down Expand Up @@ -75,121 +131,21 @@
#' v
#' options(ggplot2.continuous.fill = tmp) # restore previous setting
#' @export
scale_colour_continuous <- function(...,
type = getOption("ggplot2.continuous.colour")) {
type <- type %||% "gradient"
args <- list2(...)
args$call <- args$call %||% current_call()

if (is.function(type)) {
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
args$call <- NULL
}
check_scale_type(exec(type, !!!args), "scale_colour_continuous", "colour")
} else if (identical(type, "gradient")) {
exec(scale_colour_gradient, !!!args)
} else if (identical(type, "viridis")) {
exec(scale_colour_viridis_c, !!!args)
} else {
cli::cli_abort(c(
"Unknown scale type: {.val {type}}",
"i" = "Use either {.val gradient} or {.val viridis}"
))
}
}

#' @rdname scale_colour_continuous
#' @export
scale_fill_continuous <- function(...,
type = getOption("ggplot2.continuous.fill")) {
type <- type %||% "gradient"
args <- list2(...)
args$call <- args$call %||% current_call()

if (is.function(type)) {
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
args$call <- NULL
}
check_scale_type(exec(type, !!!args), "scale_fill_continuous", "fill")
} else if (identical(type, "gradient")) {
exec(scale_fill_gradient, !!!args)
} else if (identical(type, "viridis")) {
exec(scale_fill_viridis_c, !!!args)
} else {
cli::cli_abort(c(
"Unknown scale type: {.val {type}}",
"i" = "Use either {.val gradient} or {.val viridis}"
))
}
}
scale_colour_continuous <- scale_colour_continuous_factory("colour")

#' @export
#' @rdname scale_colour_continuous
scale_colour_binned <- function(...,
type = getOption("ggplot2.binned.colour")) {
args <- list2(...)
args$call <- args$call %||% current_call()
if (is.function(type)) {
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
args$call <- NULL
}
check_scale_type(exec(type, !!!args), "scale_colour_binned", "colour")
} else {
type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient")
# don't use fallback from scale_colour_continuous() if it is
# a function, since that would change the type of the color
# scale from binned to continuous
if (is.function(type_fallback)) {
type_fallback <- "gradient"
}
type <- type %||% type_fallback
scale_fill_continuous <- scale_colour_continuous_factory("fill")

if (identical(type, "gradient")) {
exec(scale_colour_steps, !!!args)
} else if (identical(type, "viridis")) {
exec(scale_colour_viridis_b, !!!args)
} else {
cli::cli_abort(c(
"Unknown scale type: {.val {type}}",
"i" = "Use either {.val gradient} or {.val viridis}"
))
}
}
}
#' @export
#' @rdname scale_colour_continuous
scale_colour_binned <- scale_colour_binned_factory("colour")

#' @export
#' @rdname scale_colour_continuous
scale_fill_binned <- function(...,
type = getOption("ggplot2.binned.fill")) {
args <- list2(...)
args$call <- args$call %||% current_call()
if (is.function(type)) {
if (!any(c("...", "call") %in% fn_fmls_names(type))) {
args$call <- NULL
}
check_scale_type(exec(type, !!!args), "scale_fill_binned", "fill")
} else {
type_fallback <- getOption("ggplot2.continuous.fill", default = "gradient")
# don't use fallback from scale_colour_continuous() if it is
# a function, since that would change the type of the color
# scale from binned to continuous
if (is.function(type_fallback)) {
type_fallback <- "gradient"
}
type <- type %||% type_fallback
scale_fill_binned <- scale_colour_binned_factory("fill")

if (identical(type, "gradient")) {
exec(scale_fill_steps, !!!args)
} else if (identical(type, "viridis")) {
exec(scale_fill_viridis_b, !!!args)
} else {
cli::cli_abort(c(
"Unknown scale type: {.val {type}}",
"i" = "Use either {.val gradient} or {.val viridis}"
))
}
}
}


# helper function to make sure that the provided scale is of the correct
Expand Down
22 changes: 12 additions & 10 deletions R/scale-grey.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,10 @@
scale_colour_grey_factory <- function(aesthetic) {
function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = aesthetic) {
discrete_scale(aesthetics, palette = grey_pal(start, end), na.value = na.value, ...)
}
}


#' Sequential grey colour scales
#'
#' Based on [gray.colors()]. This is black and white equivalent
Expand All @@ -9,8 +16,6 @@
#' @family colour scales
#' @seealso
#' The documentation on [colour aesthetics][aes_colour_fill_alpha].
#' @rdname scale_grey
#' @export
#' @examples
#' p <- ggplot(mtcars, aes(mpg, wt)) + geom_point(aes(colour = factor(cyl)))
#' p + scale_colour_grey()
Expand All @@ -27,14 +32,11 @@
#' ggplot(mtcars, aes(mpg, wt)) +
#' geom_point(aes(colour = miss)) +
#' scale_colour_grey(na.value = "green")
scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "colour") {
discrete_scale(aesthetics, palette = grey_pal(start, end),
na.value = na.value, ...)
}
#' @rdname scale_grey
#' @export
scale_colour_grey <- scale_colour_grey_factory("colour")

#' @rdname scale_grey
#' @export
scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "fill") {
discrete_scale(aesthetics, palette = grey_pal(start, end),
na.value = na.value, ...)
}
scale_fill_grey <- scale_colour_grey_factory("fill")

Loading